From 2ea2abe331e495514be641994f4c90b714753a61 Mon Sep 17 00:00:00 2001 From: Takuji Tanaka Date: Sat, 3 Dec 2022 12:53:58 +0000 Subject: uptex: Merge change files for pTeX tools into upTeX tools git-svn-id: svn://tug.org/texlive/trunk@65177 c570f23f-e606-0410-a88d-b1316a301751 --- Build/source/texk/web2c/Makefile.in | 23 +- Build/source/texk/web2c/ptexdir/nissya.test | 1 + Build/source/texk/web2c/ptexdir/pbibtex.test | 1 + Build/source/texk/web2c/ptexdir/pdvitype.test | 1 + Build/source/texk/web2c/ptexdir/skipjfmp.test | 1 + Build/source/texk/web2c/ptexdir/yokotate.test | 1 + Build/source/texk/web2c/uptexdir/am/uptex.am | 26 +- Build/source/texk/web2c/uptexdir/nissya.test | 1 + Build/source/texk/web2c/uptexdir/sample.test | 1 + Build/source/texk/web2c/uptexdir/skipjfmp.test | 1 + Build/source/texk/web2c/uptexdir/upbibtex-mem.test | 1 + Build/source/texk/web2c/uptexdir/upbibtex.ch | 669 +++++++++++++++---- Build/source/texk/web2c/uptexdir/updvitype.ch | 472 +++++++++++++- Build/source/texk/web2c/uptexdir/updvitype.test | 1 + Build/source/texk/web2c/uptexdir/uppltotf.ch | 723 +++++++++++++++++++-- Build/source/texk/web2c/uptexdir/uptftopl.ch | 544 ++++++++++++++-- Build/source/texk/web2c/uptexdir/yokotate.test | 1 + 17 files changed, 2193 insertions(+), 275 deletions(-) (limited to 'Build/source/texk') diff --git a/Build/source/texk/web2c/Makefile.in b/Build/source/texk/web2c/Makefile.in index 3c6d9b5d0a0..c4c7e19f2d1 100644 --- a/Build/source/texk/web2c/Makefile.in +++ b/Build/source/texk/web2c/Makefile.in @@ -3303,9 +3303,8 @@ EXTRA_DIST = PROJECTS cftests cpascal.h help.h w2c/config.h \ eptexdir/pdfprimitive.test \ eptexdir/tests/pdfprimitive-test.tex \ eptexdir/tests/pdfprimitive-eptex.log $(uptex_web_srcs) \ - $(uptex_ch_srcs) uptexdir/uptex.defines ptexdir/pbibtex.ch \ - uptexdir/upbibtex.ch ptexdir/pdvitype.ch uptexdir/updvitype.ch \ - ptexdir/ppltotf.ch uptexdir/uppltotf.ch ptexdir/ptftopl.ch \ + $(uptex_ch_srcs) uptexdir/uptex.defines uptexdir/upbibtex.ch \ + uptexdir/updvitype.ch uptexdir/uppltotf.ch \ uptexdir/uptftopl.ch uptexdir/COPYRIGHT uptexdir/COPYRIGHT.jis \ uptexdir/ChangeLog $(uptex_tests) $(upweb_tests) \ tests/enc-u.bbl tests/enc-eu.bbl tests/enc-su.bbl \ @@ -22270,32 +22269,32 @@ upbibtex-web2c: upbibtex.p $(web2c_depend) uptexdir/uptex.defines web2c/cvtbib.s @$(web2c) upbibtex upbibtex.p: tangle$(EXEEXT) upbibtex.web uptexdir/upbibtex.ch $(up_tangle) upbibtex upbibtex -upbibtex.web: tie$(EXEEXT) bibtex.web bibtex.ch ptexdir/pbibtex.ch - $(tie_m) bibtex.web bibtex.ch ptexdir/pbibtex.ch +upbibtex.web: tie$(EXEEXT) bibtex.web bibtex.ch + $(tie_m) bibtex.web bibtex.ch updvitype.c updvitype.h: updvitype-web2c @$(web2c) updvitype updvitype-web2c: updvitype.p $(web2c_depend) uptexdir/uptex.defines @$(web2c) updvitype updvitype.p: tangle$(EXEEXT) updvitype.web uptexdir/updvitype.ch $(up_tangle) updvitype updvitype -updvitype.web: tie$(EXEEXT) dvitype.web dvitype.ch ptexdir/pdvitype.ch - $(tie_m) dvitype.web dvitype.ch ptexdir/pdvitype.ch +updvitype.web: tie$(EXEEXT) dvitype.web dvitype.ch + $(tie_m) dvitype.web dvitype.ch uppltotf.c uppltotf.h: uppltotf-web2c @$(web2c) uppltotf uppltotf-web2c: uppltotf.p $(web2c_depend) uptexdir/uptex.defines @$(web2c) uppltotf uppltotf.p: tangle$(EXEEXT) uppltotf.web uptexdir/uppltotf.ch $(up_tangle) uppltotf uppltotf -uppltotf.web: tie$(EXEEXT) pltotf.web pltotf.ch ptexdir/ppltotf.ch - $(tie_m) pltotf.web pltotf.ch ptexdir/ppltotf.ch +uppltotf.web: tie$(EXEEXT) pltotf.web pltotf.ch + $(tie_m) pltotf.web pltotf.ch uptftopl.c uptftopl.h: uptftopl-web2c @$(web2c) uptftopl uptftopl-web2c: uptftopl.p $(web2c_depend) uptexdir/uptex.defines @$(web2c) uptftopl uptftopl.p: tangle$(EXEEXT) uptftopl.web uptexdir/uptftopl.ch $(up_tangle) uptftopl uptftopl -uptftopl.web: tie$(EXEEXT) tftopl.web tftopl.ch ptexdir/ptftopl.ch - $(tie_m) tftopl.web tftopl.ch ptexdir/ptftopl.ch +uptftopl.web: tie$(EXEEXT) tftopl.web tftopl.ch + $(tie_m) tftopl.web tftopl.ch uptexdir/uptriptest.log: uptex$(EXEEXT) dvitype$(EXEEXT) pltotf$(EXEEXT) tftopl$(EXEEXT) uptexdir/upver.log uptexdir/upkcat.log: uptex$(EXEEXT) uptexdir/upbibtex.log: upbibtex$(EXEEXT) @@ -22304,7 +22303,7 @@ uptexdir/uppltotf.log: uppltotf$(EXEEXT) uptexdir/uptftopl.log: uptftopl$(EXEEXT) uptexdir/upbibtex-openout-test.log uptexdir/upbibtex-longline-test.log \ uptexdir/upbibtex-mem.log uptexdir/nissya.log: upbibtex$(EXEEXT) -uptexdir/sample.log: pdvitype$(EXEEXT) +uptexdir/sample.log: updvitype$(EXEEXT) uptexdir/yokotate.log uptexdir/skipjfmp.log \ uptexdir/newjfm.log uptexdir/uparse.log uptexdir/gkhuge.log: uppltotf$(EXEEXT) uptftopl$(EXEEXT) uptrip.diffs: uptex$(EXEEXT) dvitype$(EXEEXT) pltotf$(EXEEXT) tftopl$(EXEEXT) diff --git a/Build/source/texk/web2c/ptexdir/nissya.test b/Build/source/texk/web2c/ptexdir/nissya.test index 9c36af75528..cfef230ee18 100755 --- a/Build/source/texk/web2c/ptexdir/nissya.test +++ b/Build/source/texk/web2c/ptexdir/nissya.test @@ -1,5 +1,6 @@ #! /bin/sh -vx # $Id$ +# Copyright 2022 Japanese TeX Development Community # Copyright 2017 Karl Berry # Copyright 2010-2013 Peter Breitenlohner # You may freely use, modify and/or distribute this file. diff --git a/Build/source/texk/web2c/ptexdir/pbibtex.test b/Build/source/texk/web2c/ptexdir/pbibtex.test index 2df3d8aa5f2..322b021a6d2 100755 --- a/Build/source/texk/web2c/ptexdir/pbibtex.test +++ b/Build/source/texk/web2c/ptexdir/pbibtex.test @@ -1,5 +1,6 @@ #! /bin/sh -vx # $Id$ +# Copyright 2022 Japanese TeX Development Community # Copyright 2017 Karl Berry # Copyright 2010-2013 Peter Breitenlohner # You may freely use, modify and/or distribute this file. diff --git a/Build/source/texk/web2c/ptexdir/pdvitype.test b/Build/source/texk/web2c/ptexdir/pdvitype.test index 341a290e919..a3a57ac066e 100755 --- a/Build/source/texk/web2c/ptexdir/pdvitype.test +++ b/Build/source/texk/web2c/ptexdir/pdvitype.test @@ -1,5 +1,6 @@ #! /bin/sh -vx # $Id$ +# Copyright 2022 Japanese TeX Development Community # Copyright 2017 Karl Berry # Copyright 2010-2013 Peter Breitenlohner # You may freely use, modify and/or distribute this file. diff --git a/Build/source/texk/web2c/ptexdir/skipjfmp.test b/Build/source/texk/web2c/ptexdir/skipjfmp.test index 3b2e3ec7e0b..dee7c206db0 100755 --- a/Build/source/texk/web2c/ptexdir/skipjfmp.test +++ b/Build/source/texk/web2c/ptexdir/skipjfmp.test @@ -1,5 +1,6 @@ #! /bin/sh -vx # $Id$ +# Copyright 2018-2022 Japanese TeX Development Community # Copyright 2018 Karl Berry # You may freely use, modify and/or distribute this file. diff --git a/Build/source/texk/web2c/ptexdir/yokotate.test b/Build/source/texk/web2c/ptexdir/yokotate.test index 4257d076fa0..81fcc415759 100755 --- a/Build/source/texk/web2c/ptexdir/yokotate.test +++ b/Build/source/texk/web2c/ptexdir/yokotate.test @@ -1,5 +1,6 @@ #! /bin/sh -vx # $Id$ +# Copyright 2022 Japanese TeX Development Community # Copyright 2017 Karl Berry # Copyright 2010-2013 Peter Breitenlohner # You may freely use, modify and/or distribute this file. diff --git a/Build/source/texk/web2c/uptexdir/am/uptex.am b/Build/source/texk/web2c/uptexdir/am/uptex.am index 2d6d0f5bc39..6e5966de44d 100644 --- a/Build/source/texk/web2c/uptexdir/am/uptex.am +++ b/Build/source/texk/web2c/uptexdir/am/uptex.am @@ -99,9 +99,9 @@ upbibtex-web2c: upbibtex.p $(web2c_depend) uptexdir/uptex.defines web2c/cvtbib.s @$(web2c) upbibtex upbibtex.p: tangle$(EXEEXT) upbibtex.web uptexdir/upbibtex.ch $(up_tangle) upbibtex upbibtex -upbibtex.web: tie$(EXEEXT) bibtex.web bibtex.ch ptexdir/pbibtex.ch - $(tie_m) bibtex.web bibtex.ch ptexdir/pbibtex.ch -EXTRA_DIST += ptexdir/pbibtex.ch uptexdir/upbibtex.ch +upbibtex.web: tie$(EXEEXT) bibtex.web bibtex.ch + $(tie_m) bibtex.web bibtex.ch +EXTRA_DIST += uptexdir/upbibtex.ch ## upDVItype ## @@ -116,9 +116,9 @@ updvitype-web2c: updvitype.p $(web2c_depend) uptexdir/uptex.defines @$(web2c) updvitype updvitype.p: tangle$(EXEEXT) updvitype.web uptexdir/updvitype.ch $(up_tangle) updvitype updvitype -updvitype.web: tie$(EXEEXT) dvitype.web dvitype.ch ptexdir/pdvitype.ch - $(tie_m) dvitype.web dvitype.ch ptexdir/pdvitype.ch -EXTRA_DIST += ptexdir/pdvitype.ch uptexdir/updvitype.ch +updvitype.web: tie$(EXEEXT) dvitype.web dvitype.ch + $(tie_m) dvitype.web dvitype.ch +EXTRA_DIST += uptexdir/updvitype.ch ## upPLtoTF ## @@ -133,9 +133,9 @@ uppltotf-web2c: uppltotf.p $(web2c_depend) uptexdir/uptex.defines @$(web2c) uppltotf uppltotf.p: tangle$(EXEEXT) uppltotf.web uptexdir/uppltotf.ch $(up_tangle) uppltotf uppltotf -uppltotf.web: tie$(EXEEXT) pltotf.web pltotf.ch ptexdir/ppltotf.ch - $(tie_m) pltotf.web pltotf.ch ptexdir/ppltotf.ch -EXTRA_DIST += ptexdir/ppltotf.ch uptexdir/uppltotf.ch +uppltotf.web: tie$(EXEEXT) pltotf.web pltotf.ch + $(tie_m) pltotf.web pltotf.ch +EXTRA_DIST += uptexdir/uppltotf.ch ## upTFtoPL ## @@ -150,9 +150,9 @@ uptftopl-web2c: uptftopl.p $(web2c_depend) uptexdir/uptex.defines @$(web2c) uptftopl uptftopl.p: tangle$(EXEEXT) uptftopl.web uptexdir/uptftopl.ch $(up_tangle) uptftopl uptftopl -uptftopl.web: tie$(EXEEXT) tftopl.web tftopl.ch ptexdir/ptftopl.ch - $(tie_m) tftopl.web tftopl.ch ptexdir/ptftopl.ch -EXTRA_DIST += ptexdir/ptftopl.ch uptexdir/uptftopl.ch +uptftopl.web: tie$(EXEEXT) tftopl.web tftopl.ch + $(tie_m) tftopl.web tftopl.ch +EXTRA_DIST += uptexdir/uptftopl.ch ## EXTRA_DIST += \ @@ -186,7 +186,7 @@ uptexdir/uppltotf.log: uppltotf$(EXEEXT) uptexdir/uptftopl.log: uptftopl$(EXEEXT) uptexdir/upbibtex-openout-test.log uptexdir/upbibtex-longline-test.log \ uptexdir/upbibtex-mem.log uptexdir/nissya.log: upbibtex$(EXEEXT) -uptexdir/sample.log: pdvitype$(EXEEXT) +uptexdir/sample.log: updvitype$(EXEEXT) uptexdir/yokotate.log uptexdir/skipjfmp.log \ uptexdir/newjfm.log uptexdir/uparse.log uptexdir/gkhuge.log: uppltotf$(EXEEXT) uptftopl$(EXEEXT) diff --git a/Build/source/texk/web2c/uptexdir/nissya.test b/Build/source/texk/web2c/uptexdir/nissya.test index 749450276b3..3c52edcc5ae 100755 --- a/Build/source/texk/web2c/uptexdir/nissya.test +++ b/Build/source/texk/web2c/uptexdir/nissya.test @@ -1,5 +1,6 @@ #! /bin/sh -vx # $Id$ +# Copyright 2022 Japanese TeX Development Community # Copyright 2017 Karl Berry # Copyright 2010-2013 Peter Breitenlohner # You may freely use, modify and/or distribute this file. diff --git a/Build/source/texk/web2c/uptexdir/sample.test b/Build/source/texk/web2c/uptexdir/sample.test index 295ef8302b4..24db4cc946d 100755 --- a/Build/source/texk/web2c/uptexdir/sample.test +++ b/Build/source/texk/web2c/uptexdir/sample.test @@ -1,5 +1,6 @@ #! /bin/sh -vx # $Id$ +# Copyright 2022 Japanese TeX Development Community # Copyright 2017-2020 Karl Berry # Copyright 2010-2013 Peter Breitenlohner # You may freely use, modify and/or distribute this file. diff --git a/Build/source/texk/web2c/uptexdir/skipjfmp.test b/Build/source/texk/web2c/uptexdir/skipjfmp.test index 42b11e70aab..11c927c332c 100755 --- a/Build/source/texk/web2c/uptexdir/skipjfmp.test +++ b/Build/source/texk/web2c/uptexdir/skipjfmp.test @@ -1,5 +1,6 @@ #! /bin/sh -vx # $Id$ +# Copyright 2018-2022 Japanese TeX Development Community # Copyright 2018 Karl Berry # You may freely use, modify and/or distribute this file. diff --git a/Build/source/texk/web2c/uptexdir/upbibtex-mem.test b/Build/source/texk/web2c/uptexdir/upbibtex-mem.test index 70473cd59c9..2aae3431231 100755 --- a/Build/source/texk/web2c/uptexdir/upbibtex-mem.test +++ b/Build/source/texk/web2c/uptexdir/upbibtex-mem.test @@ -1,5 +1,6 @@ #! /bin/sh -vx # $Id$ +# Copyright 2022 Japanese TeX Development Community # Copyright 2017 Karl Berry # Copyright 2010-2013 Peter Breitenlohner # You may freely use, modify and/or distribute this file. diff --git a/Build/source/texk/web2c/uptexdir/upbibtex.ch b/Build/source/texk/web2c/uptexdir/upbibtex.ch index 40a12c90d04..e244606e6eb 100644 --- a/Build/source/texk/web2c/uptexdir/upbibtex.ch +++ b/Build/source/texk/web2c/uptexdir/upbibtex.ch @@ -1,35 +1,103 @@ +% Change file for BibTeX in C, originally by Howard Trickey. +% +% 05/28/84 Initial implementation, version 0.41 of BibTeX +% 07/01/84 Version 0.41a of BibTeX. +% 12/17/84 Version 0.97c of BibTeX. +% 02/12/85 Version 0.98c of BibTeX. +% 02/25/85 Newer version 0.98c of BibTeX. +% 03/25/85 Version 0.98f of BibTeX +% 05/23/85 Version 0.98i of BibTeX +% 02/11/88 Version 0.99b of BibTeX +% 04/04/88 Version 0.99c; converted for use with web2c (ETM). +% 11/30/89 Use FILENAMESIZE instead of 1024 (KB). +% 03/09/90 `int' is a bad variable name for C. +% (more recent changes in the ChangeLog) +% +% 5/ 2/89 Version 0.20 of JBiBTeX by Shouichi Matsui +% 12/25/90 Version 0.30 of JBibTeX by Shouichi Matsui +% 1/ 1/91 last update for JBibTeX 0.30 by Shouichi Matsui +% 10/30/92 last update for JBibTeX 0.31 for bug fix by Shouichi Matsui +% 11/02/94 Version 0.32 for use with web2c 6.1, by Takafumi Sakurai +% +% 2002 Version 0.33 add kanji option by ASCII Corporation +% +% 2009 pTeXenc, pbibtex N. Tsuchimura +% 2010 Version 0.99d of BibTeX for TeX Live +% +% 2022-02-08 Version 0.34 by H. Yamashita +% * Avoid breaking BBL lines at white space after a Japanese character, to +% preserve spacing within BIB entry for subsequent pTeX line-end operations. +% 2022-02-20 Still version 0.34 by H. Yamashita (-> TL'22 version) +% * Improve substring$ to truncate at least one character when trying to +% start counting from the middle byte of the first or last Japanese character. +% 2022-05-15 Version 0.35 by Takuji Tanaka +% * Accept multibyte characters by int.to.chr$ and chr.to.int$. +% 2022-12-03 Version 0.36 by Takuji Tanaka (-> TL'23 version) +% * Merge pBibTeX source/binary into upBibTeX. + +@x [0] only print chnages +\def\title{\BibTeX\ } +@y +\let\maybe=\iffalse +\def\title{J\BibTeX\ 0.36 Changes for C Version \BibTeX\ } +@z + +@x + \def\titlepage{F} + \centerline{\:\titlefont The {\:\ttitlefont \BibTeX} preprocessor} + \vskip 15pt \centerline{(Version 0.99d---\today)} \vfill} +@y + \def\titlepage{F} + \centerline{\:\titlefont The {\:\ttitlefont J\BibTeX} preprocessor} + \vskip 15pt \centerline{(Version 0.99d-j0.36---\today)} \vfill} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [1] banner +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @x -@d my_name=='pbibtex' -@d banner=='This is pBibTeX, Version 0.99d-j0.35' +@d my_name=='bibtex' +@d banner=='This is BibTeX, Version 0.99d' {printed when the program starts} @y @d my_name=='upbibtex' -@d banner=='This is upBibTeX, Version 0.99d-j0.35-u1.29' +@d banner=='This is upBibTeX, Version 0.99d-j0.36-u1.29' + {printed when the program starts} @z @x -for i:=@'200 to @'237 do xchr[i]:=chr(i-@'200); -for i:=@'240 to 255 do xchr[i]:=chr(i); + print (banner); @y + print (banner); + print (' (', conststringcast(get_enc_string), ')'); +@z + +@x Changes for JBibTeX by Shouichi Matsui [27] +for i:=0 to @'37 do xchr[i]:=chr(i); +for i:=@'177 to @'377 do xchr[i]:=chr(i); +@y +for i:=1 to @'37 do xchr[i]:=' '; +xchr[tab]:=chr(tab); for i:=@'200 to 255 do xchr[i]:=chr(i); +xchr[@'33]:=chr(@'33); {escape char} @z -@x -for i:=@'200 to @'237 do xord[i]:= i-@'200; -for i:=@'240 to 255 do xord[i]:=i; +@x Changes for JBibTeX by Shouichi Matsui [28] +for i:=first_text_char to last_text_char do xord[xchr[i]]:=i; @y +for i:=first_text_char to last_text_char do xord[i]:=invalid_code; +for i:=1 to @'176 do xord[i]:= i; for i:=@'200 to 255 do xord[i]:=i; @z -@x -@d zen_pun_first = 161 {Zenkaku punctuation first byte; in EUC} -@d zen_space = 161 {Zenkaku space first, second byte; in EUC} -@d zen_kuten = 162 {Zenkaku kuten second byte; in EUC} -@d zen_ten = 163 {Zenkaku ten second byte; in EUC} -@d zen_comma = 164 {Zenkaku comman second byte; in EUC} -@d zen_period = 165 {Zenkaku period second byte; in EUC} -@d zen_question = 169 {Zenkaku question mark second byte; in EUC} -@d zen_exclamation = 170 {Zenkaku exclamation mark second byte; in EUC} + +@x Changes for JBibTeX by Shouichi Matsui for ver. 0.30 +@d period = "." {these are three} +@d question_mark = "?" {string-ending characters} +@d exclamation_mark = "!" {of interest in \.{add.period\$}} @y +@d period = "." {these are three} +@d question_mark = "?" {string-ending characters} +@d exclamation_mark = "!" {of interest in \.{add.period\$}} @d e_ss3 = @"8F {single shift three in EUC} @d e_pun_first = @"A1 {Zenkaku punctuation first byte; in EUC} @d e_space = @"A1A1 {Zenkaku space; in EUC} @@ -55,21 +123,114 @@ for i:=@'200 to 255 do xord[i]:=i; @d u_exclam_question = @"2049 {Zenkaku exclamation question mark; in UCS} @z -@x -for i:=@'200 to @'237 do lex_class[i] := illegal; -for i:=@'240 to 255 do lex_class[i] := alpha; -lex_class[@'33]:=alpha; +% [32] Make RET a `white_space' character, so we won't choke on DOS +% files, which use CR/LF for line endings. +@x Changes for JBibTeX by Shouichi Matsui [32] +@= +for i:=0 to @'177 do lex_class[i] := other_lex; +for i:=@'200 to @'377 do lex_class[i] := alpha; +for i:=0 to @'37 do lex_class[i] := illegal; +lex_class[invalid_code] := illegal; +lex_class[tab] := white_space; +lex_class[13] := white_space; +lex_class[space] := white_space; +lex_class[tie] := sep_char; +lex_class[hyphen] := sep_char; +for i:=@'60 to @'71 do lex_class[i] := numeric; +for i:=@'101 to @'132 do lex_class[i] := alpha; +for i:=@'141 to @'172 do lex_class[i] := alpha; @y +@= +for i:=0 to @'377 do lex_class[i] := other_lex; +for i:=0 to @'37 do lex_class[i] := illegal; +lex_class[invalid_code] := illegal; +lex_class[tab] := white_space; +lex_class[13] := white_space; +lex_class[space] := white_space; +lex_class[tie] := sep_char; +lex_class[hyphen] := sep_char; +for i:=@'60 to @'71 do lex_class[i] := numeric; +for i:=@'101 to @'132 do lex_class[i] := alpha; +for i:=@'141 to @'172 do lex_class[i] := alpha; @z -@x -for i:=@'200 to @'237 do id_class[i] := illegal_id_char; +@x Changes for JBibTeX by Shouichi Matsui [33] +@= +for i:=0 to @'377 do id_class[i] := legal_id_char; +for i:=0 to @'37 do id_class[i] := illegal_id_char; +id_class[space] := illegal_id_char; +id_class[tab] := illegal_id_char; +id_class[double_quote] := illegal_id_char; +id_class[number_sign] := illegal_id_char; +id_class[comment] := illegal_id_char; +id_class[single_quote] := illegal_id_char; +id_class[left_paren] := illegal_id_char; +id_class[right_paren] := illegal_id_char; +id_class[comma] := illegal_id_char; +id_class[equals_sign] := illegal_id_char; +id_class[left_brace] := illegal_id_char; +id_class[right_brace] := illegal_id_char; @y +@= +for i:=0 to @'377 do id_class[i] := legal_id_char; +for i:=0 to @'37 do id_class[i] := illegal_id_char; +id_class[@'33] := legal_id_char; +id_class[space] := illegal_id_char; +id_class[tab] := illegal_id_char; +id_class[double_quote] := illegal_id_char; +id_class[number_sign] := illegal_id_char; +id_class[comment] := illegal_id_char; +id_class[single_quote] := illegal_id_char; +id_class[left_paren] := illegal_id_char; +id_class[right_paren] := illegal_id_char; +id_class[comma] := illegal_id_char; +id_class[equals_sign] := illegal_id_char; +id_class[left_brace] := illegal_id_char; +id_class[right_brace] := illegal_id_char; @z -@x -for i:=@'240 to 254 do char_width[i]:=514; +@x Changes for JBibTeX by Shouichi Matsui [35] +char_width[@'167] := 722; +char_width[@'170] := 528; +char_width[@'171] := 528; +char_width[@'172] := 444; +char_width[@'173] := 500; +char_width[@'174] :=1000; +char_width[@'175] := 500; +char_width[@'176] := 500; @y +char_width[@'167] := 722; +char_width[@'170] := 528; +char_width[@'171] := 528; +char_width[@'172] := 444; +char_width[@'173] := 500; +char_width[@'174] :=1000; +char_width[@'175] := 500; +char_width[@'176] := 500; +@z + +@x [48] JBibTeX and dynamic buf_size. +label loop_exit; +@y +label loop_exit; +var i:c_int_type; +@z +@x [still 48] JBibTeX and dynamic buf_size. + while (not eoln(f)) do + begin + if (last >= buf_size) then + buffer_overflow; + buffer[last] := xord[getc (f)]; + incr (last); + end; + vgetc (f); {skip the eol} +@y + last := input_line2(f,ustringcast(buffer),last,buf_size,address_of(i)); + while (not eof(f)) and (last > 0) and (i <> 10) and (i <> 13) do + begin + buffer_overflow; + last := input_line2(f,ustringcast(buffer),last,buf_size,address_of(i)); + end; @z @x procedure lower_case @@ -196,11 +357,14 @@ if (len > 0) then end @z -@x procedure get_the_top_level_aux_file_name +@x +@= +procedure get_the_top_level_aux_file_name; label aux_found,@!aux_not_found; begin - if (not set_enc_string (nil,'EUC')) then uexit(1); @y +@= +procedure get_the_top_level_aux_file_name; label aux_found,@!aux_not_found; var i:0..last_text_char; {this is the first one declared} begin @@ -208,17 +372,96 @@ begin @z @x - zen_ten, - zen_period, - zen_question, - zen_exclamation: - if( str_pool[sp_ptr-1] = zen_pun_first ) then - repush_string - else - @; +parse_arguments; +@y +init_kanji; +parse_arguments; +@z + +% pBibTeX: do not break at |white_space| after Japanese characters (2022-02-08 j0.34) +@x "Break that line" +while ((lex_class[out_buf[out_buf_ptr]] <> white_space) and + (out_buf_ptr >= min_print_line)) do + decr(out_buf_ptr); +@y +while (((lex_class[out_buf[out_buf_ptr]] <> white_space) or + (out_buf[out_buf_ptr-1] > 127)) and (out_buf_ptr >= min_print_line)) do + decr(out_buf_ptr); +@z +@x "Break that unbreakably long line" + if (lex_class[out_buf[out_buf_ptr]] <> white_space) then + incr(out_buf_ptr) +@y + if (lex_class[out_buf[out_buf_ptr]] <> white_space) or + (out_buf[out_buf_ptr-1] > 127) then + incr(out_buf_ptr) +@z + +@x Changes for JBibTeX by Shouichi Matsui [332] +@!b_write : hash_loc; {\.{write\$}} +@!b_default : hash_loc; {either \.{skip\$} or \.{default.type}} +@y +@!b_write : hash_loc; {\.{write\$}} +@!b_is_kanji_str : hash_loc; {\.{is.kanji.str\$}} +@!b_default : hash_loc; {either \.{skip\$} or \.{default.type}} +@z + +@x Changes for JBibTeX by Shouichi Matsui [334] +@d n_write = 36 {\.{write\$}} + +@= +@!num_blt_in_fns = 37; {one more than the previous number} +@y +@d n_write = 36 {\.{write\$}} +@d n_is_kanji_str = 37 {\.{is.kanji.str\$}} + +@= +@!num_blt_in_fns = 38; {one more than the previous number} +@z + +@x Changes for JBibTeX by Shouichi Matsui [335] +build_in('write$ ',6,b_write,n_write); +@y +build_in('write$ ',6,b_write,n_write); +build_in('is.kanji.str$',13,b_is_kanji_str,n_is_kanji_str); +@z + +@x Changes for JBibTeX by Shouichi Matsui [342] + n_write : x_write; + othercases confusion ('Unknown built-in function') +endcases; +end +@y + n_write : x_write; + n_is_kanji_str: x_is_kanji_str; + othercases confusion ('Unknown built-in function') +endcases; +end +@z + +@x Changes for JBibTeX by Shouichi Matsui [343] +@<|execute_fn|({\.{write\$}})@>@; +@<|execute_fn| itself@> +@y +@<|execute_fn|({\.{write\$}})@>@; +@<|execute_fn|({\.{is.kanji.str\$}})@>@; +@<|execute_fn| itself@> +@z + +@x Changes for JBibTeX by Shouichi Matsui --- add.period$ for ver. 0.30 +case (str_pool[sp_ptr]) of + period, + question_mark, + exclamation_mark : + repush_string; othercases @ @y +case (str_pool[sp_ptr]) of + period, + question_mark, + exclamation_mark : + repush_string; othercases begin if (is_internalEUC) then @@ -257,18 +500,41 @@ begin @z @x x_chr_to_int - push_lit_stk(toDVI(fromBUFF(str_pool, str_start[pop_lit1]+2, str_start[pop_lit1])),stk_int) - { a KANJI char is 2byte long } +else if (length(pop_lit1) <> 1) then + begin + print ('"'); + print_pool_str (pop_lit1); + bst_ex_warn ('" isn''t a single character'); + push_lit_stk (0, stk_int); + end +else + push_lit_stk (str_pool[str_start[pop_lit1]], stk_int); + {push the (|ASCII_code|) integer} @y +else if (length(pop_lit1) = multibytelen(str_pool[str_start[pop_lit1]])) then + begin + if (length(pop_lit1) = 1) then + push_lit_stk(str_pool[str_start[pop_lit1]],stk_int) + {push the (|ASCII_code|) integer} + else push_lit_stk(toDVI(fromBUFF(str_pool, str_start[pop_lit1]+length(pop_lit1), str_start[pop_lit1])),stk_int) { a KANJI char is |2..4|byte long } + end +else + begin + print ('"'); + print_pool_str (pop_lit1); + bst_ex_warn ('" isn''t a single character'); + push_lit_stk (0, stk_int); + end @z -@x - if( (ex_buf[ex_buf_ptr-1]=zen_comma) or (ex_buf[ex_buf_ptr-1]=zen_kuten) ) - then ex_buf_ptr := ex_buf_ptr - 2 - else ex_buf_ptr := ex_buf_ptr - 4; +@x by Shouichi Matsui for Zenkaku comma +if (ex_buf_ptr < ex_buf_length) then {remove the ``and''} + ex_buf_ptr := ex_buf_ptr - 4; @y +if (ex_buf_ptr < ex_buf_length) then {remove the ``and'', or Zenkau comma} + begin if (is_internalEUC) then if((fromBUFF(ex_buf, ex_buf_length, ex_buf_ptr-2) = e_comma) or (fromBUFF(ex_buf, ex_buf_length, ex_buf_ptr-2) = e_toten)) @@ -279,28 +545,41 @@ begin (fromBUFF(ex_buf, ex_buf_length, ex_buf_ptr-3) = u_toten)) then ex_buf_ptr := ex_buf_ptr - 3 else ex_buf_ptr := ex_buf_ptr - 4; + end; @z -@x - zen_pun_first: +@x Changes for JBibTeX by Shouichi Matsui for Zenkaku comma + "a", "A" : begin - if((ex_buf[ex_buf_ptr+1]=zen_comma) or - (ex_buf[ex_buf_ptr+1]=zen_kuten) ) then + incr(ex_buf_ptr); + if (preceding_white) then + @; {if so, |and_found := true|} + preceding_white := false; + end; @y + "a", "A" : + begin + incr(ex_buf_ptr); + if (preceding_white) then + @; {if so, |and_found := true|} + preceding_white := false; + end; e_pun_first: if (is_internalEUC) then begin if ((fromBUFF(ex_buf, ex_buf_length, ex_buf_ptr) = e_comma) or (fromBUFF(ex_buf, ex_buf_length, ex_buf_ptr) = e_toten)) then -@z -@x - else if(ex_buf[ex_buf_ptr+1]=zen_space) then -@y + begin + preceding_white := false; + and_found := true + end else if (fromBUFF(ex_buf,ex_buf_length,ex_buf_ptr) = e_space) then -@z -@x - end; -@y + begin + ex_buf[ex_buf_ptr] := space; + ex_buf[ex_buf_ptr+1] := space; + preceding_white := true; + end; + ex_buf_ptr := ex_buf_ptr + 2; end else begin ex_buf_ptr := ex_buf_ptr + multibytelen(ex_buf[ex_buf_ptr]); preceding_white := false; @@ -329,24 +608,48 @@ begin end; @z -@x - if( ex_buf[ex_buf_ptr] > 127 ) then - ex_buf_ptr := ex_buf_ptr +2 - else - incr(ex_buf_ptr); +@x Changes for JBibTeX by Shouichi Matsui for Zenkaku comma[385] + othercases + if (lex_class[ex_buf[ex_buf_ptr]] = white_space) then + begin + incr(ex_buf_ptr); + preceding_white := true; + end + else + begin + incr(ex_buf_ptr); + preceding_white := false; + end + endcases; +check_brace_level (pop_lit_var); +end; @y + othercases + if (lex_class[ex_buf[ex_buf_ptr]] = white_space) then + begin + incr(ex_buf_ptr); + preceding_white := true; + end + else + begin ex_buf_ptr := ex_buf_ptr + multibytelen(ex_buf[ex_buf_ptr]); + preceding_white := false; + end + endcases; +check_brace_level (pop_lit_var); +end; @z -@x - if name_buf[name_bf_ptr]>127 then begin - append_ex_buf_char_and_check (name_buf[name_bf_ptr]); - incr(name_bf_ptr); - append_ex_buf_char_and_check (name_buf[name_bf_ptr]); - end - else - append_ex_buf_char_and_check (name_buf[name_bf_ptr]); +@x Changes for JBibTeX by Shouichi Matsui [415] + if (lex_class[name_buf[name_bf_ptr]] = alpha) then + begin + append_ex_buf_char_and_check (name_buf[name_bf_ptr]); + goto loop_exit; + end + else if ((name_buf[name_bf_ptr] = left_brace) and @y + if (lex_class[name_buf[name_bf_ptr]] = alpha) then + begin append_ex_buf_char_and_check (name_buf[name_bf_ptr]); if multibytelen(name_buf[name_bf_ptr]) > 1 then append_ex_buf_char_and_check (name_buf[name_bf_ptr+1]); @@ -355,19 +658,52 @@ begin if multibytelen(name_buf[name_bf_ptr]) > 3 then append_ex_buf_char_and_check (name_buf[name_bf_ptr+3]); name_bf_ptr := name_bf_ptr + multibytelen(name_buf[name_bf_ptr])-1; + goto loop_exit; + end + else if ((name_buf[name_bf_ptr] = left_brace) and @z @x x_int_to_chr - str_room(2); - if (pop_lit1>127) then begin - append_char (Hi(k)); - append_char (Lo(k)); +procedure x_int_to_chr; +begin +pop_lit_stk (pop_lit1,pop_typ1); +if (pop_typ1 <> stk_int) then + begin + print_wrong_stk_lit (pop_lit1,pop_typ1,stk_int); + push_lit_stk (s_null, stk_str); end - else - append_char (pop_lit1); +else if ((pop_lit1 < 0) or (pop_lit1 > 127)) then + begin + bst_ex_warn (pop_lit1:0,' isn''t valid ASCII'); + push_lit_stk (s_null, stk_str); + end +else + begin + str_room(1); + append_char (pop_lit1); push_lit_stk (make_string, stk_str); end; +end; @y +procedure x_int_to_chr; +var k:integer; +begin +pop_lit_stk (pop_lit1,pop_typ1); +if (pop_typ1 <> stk_int) then + begin + print_wrong_stk_lit (pop_lit1,pop_typ1,stk_int); + push_lit_stk (s_null, stk_str); + end +else begin +k:=pop_lit1; +if (pop_lit1 > 127) then k:=fromDVI(pop_lit1); +if ((pop_lit1 < 0) or ((pop_lit1 > 127) and (k = 0))) then + begin + bst_ex_warn (pop_lit1:0,' isn''t valid character code'); + push_lit_stk (s_null, stk_str); + end +else + begin str_room(4); k:=toBUFF(k); if (BYTE1(k)>0) then @@ -380,40 +716,40 @@ begin append_char (BYTE4(k)); push_lit_stk (make_string, stk_str); end; +end; +end; @z -@x -@!pop_lit2_saved: integer; +@x Changes for JBibTeX by Shouichi Matsui [437] +@<|execute_fn|({\.{substring\$}})@>= +procedure x_substring; +label exit; +begin @y +@<|execute_fn|({\.{substring\$}})@>= +procedure x_substring; +label exit; +var tps,tpe:pool_pointer; {temporary pointer} @!pop_lit2_saved,@!mbl_tpe: integer; +begin @z @x -{ 2 bytes Kanji code break check } -tps:=str_start[pop_lit3]; -tpe:=tps; -while tpe < str_start[pop_lit3+1] do begin - if str_pool[tpe] > 127 then begin - if str_start[pop_lit3+1] < tpe+2 then - break; - tpe := tpe + 2; - end - else begin - if str_start[pop_lit3+1] < tpe+1 then - break; - tpe := tpe + 1; - end; - if tpe<=sp_ptr then - tps := tpe; - if sp_end<=tpe then break; -end; -if (pop_lit2_saved > 1) and (tps = str_start[pop_lit3]) - then tps := tps + 2; {truncate at least one} -if (pop_lit2_saved < -1) and (tpe = str_start[pop_lit3+1]) - then tpe := tpe - 2; {truncate at least one} -if tps > tpe then tpe := tps; -sp_ptr := tps; -sp_end := tpe; +@
= +begin +@y +@= +begin +pop_lit2_saved := pop_lit2; {save before negate} +@z + +@x Changes for JBibTeX by Shouichi Matsui [438] + fix (2022-02-20 j0.34) +str_room(sp_end - sp_ptr); +while (sp_ptr < sp_end) do {shift the substring} + begin + append_char (str_pool[sp_ptr]); + incr(sp_ptr); + end; @y { |2..4| bytes Kanji code break check } tps:=str_start[pop_lit3]; @@ -437,36 +773,48 @@ if (pop_lit2_saved < -1) and (tpe = str_start[pop_lit3+1]) then if tps > tpe then tpe := tps; sp_ptr := tps; sp_end := tpe; -@z -@x - if str_pool[sp_ptr] >127 then begin - append_char (str_pool[sp_ptr]); incr(sp_ptr); - append_char (str_pool[sp_ptr]); incr(sp_ptr); - end - else begin - append_char (str_pool[sp_ptr]); incr(sp_ptr); - end; -@y +str_room(sp_end - sp_ptr); +while (sp_ptr < sp_end) do {shift the substring} + begin append_char (str_pool[sp_ptr]); incr(sp_ptr); + end; @z -@x - incr(sp_xptr1); num_text_chars:=num_text_chars+2; +@x Changes for JBibTeX by Shouichi Matsui [445] + else if (str_pool[sp_xptr1-1] = right_brace) then + begin + if (sp_brace_level > 0) then + decr(sp_brace_level); + end + else + incr(num_text_chars); + end; @y + else if (str_pool[sp_xptr1-1] = right_brace) then + begin + if (sp_brace_level > 0) then + decr(sp_brace_level); + end + else if (str_pool[sp_xptr1-1]>127) then + begin {kanji char} num_text_chars := num_text_chars + multibytelen(str_pool[sp_xptr1-1]); sp_xptr1 := sp_xptr1-1 + multibytelen(str_pool[sp_xptr1-1]); + end + else + incr(num_text_chars); + end; @z @x -const n_options = 8; {Pascal won't count array lengths for us.} +const n_options = 4; {Pascal won't count array lengths for us.} @y const n_options = 9; {Pascal won't count array lengths for us.} @z @x - usage_help (PBIBTEX_HELP, 'issue@@texjp.org'); + usage_help (BIBTEX_HELP, nil); @y usage_help (UPBIBTEX_HELP, 'issue@@texjp.org'); @z @@ -474,6 +822,16 @@ const n_options = 9; {Pascal won't count array lengths for us.} @x end; {Else it was a flag; |getopt| has already done the assignment.} @y + end else if argument_is ('kanji') then begin + if (not set_enc_string(optarg, nil)) then + write_ln('Bad kanji encoding "', stringcast(optarg), '".'); + + end else if argument_is ('guess-input-enc') then begin + enable_guess_file_enc; + + end else if argument_is ('no-guess-input-enc') then begin + disable_guess_file_enc; + end else if argument_is ('kanji-internal') then begin if (not (set_enc_string(nil,optarg) and (is_internalEUC or is_internalUPTEX))) then @@ -482,6 +840,40 @@ const n_options = 9; {Pascal won't count array lengths for us.} end; {Else it was a flag; |getopt| has already done the assignment.} @z +@x +long_options[current_option].name := 'version'; +long_options[current_option].has_arg := 0; +long_options[current_option].flag := 0; +long_options[current_option].val := 0; +incr (current_option); +@y +long_options[current_option].name := 'version'; +long_options[current_option].has_arg := 0; +long_options[current_option].flag := 0; +long_options[current_option].val := 0; +incr (current_option); + +@ Kanji option. +@.-kanji@> + +@ = +long_options[current_option].name := 'kanji'; +long_options[current_option].has_arg := 1; +long_options[current_option].flag := 0; +long_options[current_option].val := 0; +incr(current_option); +long_options[current_option].name := 'guess-input-enc'; +long_options[current_option].has_arg := 0; +long_options[current_option].flag := 0; +long_options[current_option].val := 0; +incr(current_option); +long_options[current_option].name := 'no-guess-input-enc'; +long_options[current_option].has_arg := 0; +long_options[current_option].flag := 0; +long_options[current_option].val := 0; +incr(current_option); +@z + @x @ An element with all zeros always ends the list. @y @@ -499,30 +891,41 @@ incr(current_option); @z @x -begin kpse_set_program_name (argv[0], 'pbibtex'); +begin kpse_set_program_name (argv[0], 'bibtex'); @y begin kpse_set_program_name (argv[0], 'upbibtex'); @z -@x procedure x_is_kanji_str -procedure x_is_kanji_str; -label exit; +@x + until j_prime; + incr (k); + hash_prime := j; + primes[k] := hash_prime; + end; +end; + @y + until j_prime; + incr (k); + hash_prime := j; + primes[k] := hash_prime; + end; +end; + +@ modules for JBibTeX + +@<|execute_fn|({\.{is.kanji.str\$}})@>= procedure x_is_kanji_str; label exit; var ctmp,clen:integer; -@z - -@x procedure x_is_kanji_str (cont.) - while sp_ptr127 then begin - push_lit_stk(1,stk_int); - return; - end else begin - incr(sp_ptr); - end; - end; -@y +begin + pop_lit_stk(pop_lit1, pop_typ1); + if pop_typ1<> stk_str then + begin print_wrong_stk_lit(pop_lit1,pop_typ1,stk_str); + push_lit_stk(0,stk_int); + end else begin + sp_ptr := str_start[pop_lit1]; + sp_end := str_start[pop_lit1+1]; while sp_ptr= @@ -605,4 +1005,3 @@ else char_width[e_ss3]:=0; end; @z - diff --git a/Build/source/texk/web2c/uptexdir/updvitype.ch b/Build/source/texk/web2c/uptexdir/updvitype.ch index de973426e8a..1e5224eb941 100644 --- a/Build/source/texk/web2c/uptexdir/updvitype.ch +++ b/Build/source/texk/web2c/uptexdir/updvitype.ch @@ -1,15 +1,25 @@ +% This is a change file for DVItype. +% +% 09/27/95 (KA) Supporting ASCII pTeX +% 2020-08-24 (HY) Support \dtou +% 2022-12-03 (TTK) Merge pDVItype source/binary into upDVItype +% @x -@d my_name=='pdvitype' -@d banner=='This is pDVItype, Version 3.6-p0.5' +@d my_name=='dvitype' +@d banner=='This is DVItype, Version 3.6' {printed when the program starts} @y @d my_name=='updvitype' -@d banner=='This is upDVItype, Version 3.6-p0.5-u1.29' +@d banner=='This is upDVItype, Version 3.6-p221203' + {printed when the program starts} @z @x procedure initialize + parse_arguments; print (banner); print_ln (version_string); @y + init_kanji; + parse_arguments; print (banner); print (' ('); print (conststringcast(get_enc_string)); @@ -17,23 +27,467 @@ print_ln (version_string); @z -@x procedure out_kanji - if text_ptr>=line_length-3 then flush_text; - c:=toBUFF(fromDVI(c)); - incr(text_ptr); text_buf[text_ptr]:= Hi(c); - incr(text_ptr); text_buf[text_ptr]:= Lo(c); +@x +for i:=@'177 to 255 do xchr[i]:='?'; @y +for i:=@'177 to 255 do xchr[i]:=i; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% pTeX +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@d undefined_commands==250,251,252,253,254,255 +@y +@d dir=255 {pTeX direction} +@d undefined_commands==250,251,252,253,254 +@z + +@x +@d id_byte=2 {identifies the kind of \.{DVI} files described here} +@y +@d id_byte=2 {identifies the kind of \.{DVI} files described here} +@d ptex_id_byte=3 {identifies the kind of pTeX \.{DVI} files described here} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% JFM and pTeX +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@!width_ptr:0..max_widths; {the number of known character widths} +@y +@!width_ptr:0..max_widths; {the number of known character widths} +@!fnt_jfm_p:array [0..max_fonts] of boolean; +@!jfm_char_code:array [0..max_widths] of integer; +@!jfm_char_type:array [0..max_widths] of integer; +@!jfm_char_font:array [0..max_widths] of integer; +@!jfm_char_type_count:integer; +@!cur_jfm_char_type:integer; + +@ @d jfm_hash_size=347 + +@ @= +@!jfm_char_type_hash_value=0..jfm_hash_size-1; + +@ @= +@!jfm_char_type_hash_table:array[jfm_char_type_hash_value] of integer; + { first pointer to character information. 0 means null pointer. } +@!jfm_char_type_hash_link:array[0..max_widths] of integer; + { next pointer to character information. 0 means null pointer. } + +@ @= +for i:=0 to jfm_hash_size-1 do + jfm_char_type_hash_table[i] := 0; +jfm_char_type[0]:=0; +jfm_char_type_count:=1; + +@ Refer char_type table. + +@p function get_jfm_char_type(@!fntn:integer;@!jfmc:integer):integer; + var p:integer; ct:integer; +begin + p:=jfm_char_type_hash_table[(jfmc+fntn) mod jfm_hash_size]; + ct:=0; { default char_type is 0 } + while p <> 0 do + if (jfm_char_code[p] = jfmc) and (jfm_char_font[p] = fntn) then + begin ct:=jfm_char_type[p]; p:=0; end + else + p:=jfm_char_type_hash_link[p]; + get_jfm_char_type:=ct; +end; + +@ @= +@!ptex_p:boolean; +@!dd:eight_bits; +@!ddstack:array [0..stack_size] of eight_bits; +@z + +@x +@!lh:integer; {length of the header data, in four-byte words} +@y +@!lh:integer; {length of the header data, in four-byte words} +@!nt:integer; +@!jfm_h:integer; +@z + +@x [35] JFM by K.A. +read_tfm_word; lh:=b2*256+b3; +@y +read_tfm_word; lh:=b0*256+b1; +if (lh = 11) or (lh = 9) then + begin + print(' (JFM'); + fnt_jfm_p[nf] := true; + if lh = 9 then print(' tate'); + print(')'); + nt:=b2*256+b3; + read_tfm_word; + end +else + begin + nt:=0; + fnt_jfm_p[nf] := false; + end; +lh:=b2*256+b3; +@z + +@x [35] JFM by K.A. + tfm_design_size:=round(tfm_conv*(((b0*256+b1)*256+b2)*256+b3)) + else goto 9997; + end; +@y + tfm_design_size:=round(tfm_conv*(((b0*256+b1)*256+b2)*256+b3)) + else goto 9997; + end; +for k:=1 to nt do + begin + read_tfm_word; + jfm_char_code[jfm_char_type_count]:=b0*256+b1+b2*65536; + jfm_char_type[jfm_char_type_count]:=b3; + jfm_char_font[jfm_char_type_count]:=nf; + jfm_h:= { hash value } + (jfm_char_code[jfm_char_type_count]+nf) mod jfm_hash_size; + jfm_char_type_hash_link[jfm_char_type_count]:= + jfm_char_type_hash_table[jfm_h]; + jfm_char_type_hash_table[jfm_h]:=jfm_char_type_count; + jfm_char_type_count := jfm_char_type_count + 1 + end; +@z + +@x +@p procedure out_text(c:ASCII_code); +begin if text_ptr=line_length-2 then flush_text; +incr(text_ptr); text_buf[text_ptr]:=c; +end; +@y +@p procedure out_text(c:ASCII_code); +begin if text_ptr=line_length-2 then flush_text; +incr(text_ptr); +if c>=177 then text_buf[text_ptr]:=@'77 else text_buf[text_ptr]:=c; +end; + +@ @p procedure out_kanji(c:integer); +begin if text_ptr>=line_length-5 then flush_text; c:=toBUFF(fromDVI(c)); if BYTE1(c)<>0 then begin incr(text_ptr); text_buf[text_ptr]:=BYTE1(c); end; if BYTE2(c)<>0 then begin incr(text_ptr); text_buf[text_ptr]:=BYTE2(c); end; if BYTE3(c)<>0 then begin incr(text_ptr); text_buf[text_ptr]:=BYTE3(c); end; incr(text_ptr); text_buf[text_ptr]:=BYTE4(c); +end; + +@ output hexdecimal / octal character code. + +@d print_hex_digit(#)==if # <= 9 then print((#):1) + else case # of + 10: print(xchr['A']); + 11: print(xchr['B']); + 12: print(xchr['C']); + 13: print(xchr['D']); + 14: print(xchr['E']); + 15: print(xchr['F']); { no more cases } + end + +@p +ifdef('HEX_CHAR_CODE') +procedure print_hex_number(c:integer); +var n:integer; + b:array[1..8] of integer; +begin + n:=1; + while (n<8) and (c<>0) do + begin b[n]:=c mod 16; c:=c div 16; n:=n+1 end; + print('"'); + if n=1 then print(xchr['0']) + else + begin + n:=n-1; + while n>0 do + begin print_hex_digit(b[n]); n:=n-1 end + end +end; +endif('HEX_CHAR_CODE') +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% pTeX +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +z0: first_par:=z; +@y +z0: first_par:=z; +dir: first_par:=get_byte; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% pTeX +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@!hhh:integer; {|h|, rounded to the nearest pixel} +@y +@!hhh,@!vvv:integer; {|h|,|v| rounded to the nearest pixel} +@z + +@x +s:=0; h:=0; v:=0; w:=0; x:=0; y:=0; z:=0; hh:=0; vv:=0; +@y +s:=0; h:=0; v:=0; w:=0; x:=0; y:=0; z:=0; hh:=0; vv:=0; dd:=0; +@z + +@x +move_right: @; +@y +move_right: + if dd=0 then begin + @; + end else begin + if dd=1 then p:=q else {if dd=3 then} p:=-q; + @; + end; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% pTeX +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x + four_cases(set1): begin major('set',o-set1+1:1,' ',p:1); goto fin_set; + end; + four_cases(put1): begin major('put',o-put1+1:1,' ',p:1); goto fin_set; +@y + four_cases(set1),four_cases(put1): + begin + if fnt_jfm_p[cur_font]=true then + begin + cur_jfm_char_type:=get_jfm_char_type(cur_font,p); + out_kanji(p); + if o@@; +@y + dir: begin + if not ptex_p and (out_mode=the_works) then + bad_dvi('dir command within normal dvi file'); + major('dir ',p:1); dd:=p; goto done; + end; + @t\4@>@@; @z @x - usage_help (PDVITYPE_HELP, 'issue@@texjp.org'); +@!vvv:integer; {|v|, rounded to the nearest pixel} +@y +@!vvv,hhh:integer; {|v|,|h| rounded to the nearest pixel} +@z + +@x +move_down: @; +@y +move_down: + if dd=0 then begin + @; + end else begin + if dd=1 then q:=-p else {if dd=3 then} q:=p; + @; + end; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% pTeX +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x + hstack[s]:=h; vstack[s]:=v; wstack[s]:=w; +@y + ddstack[s]:=dd; + hstack[s]:=h; vstack[s]:=v; wstack[s]:=w; +@z + +@x + h:=hstack[s]; v:=vstack[s]; w:=wstack[s]; +@y + dd:=ddstack[s]; + h:=hstack[s]; v:=vstack[s]; w:=wstack[s]; +@z + +@x +@d out_space(#)==if (p>=font_space[cur_font])or(p<=-4*font_space[cur_font]) then + begin out_text(" "); hh:=pixel_round(h+p); + end + else hh:=hh+pixel_round(p); +@y +@d out_space(#)==if (p>=font_space[cur_font])or(p<=-4*font_space[cur_font]) then + begin out_text(" "); + if dd=0 then hh:=pixel_round(h+p) + else if dd=1 then vv:=pixel_round(v+p) + else {if dd=3 then} vv:=pixel_round(v-p); + end + else if dd=0 then hh:=hh+pixel_round(p) + else if dd=1 then vv:=vv+pixel_round(p) + else {if dd=3 then} vv:=vv-pixel_round(p); +@z + +@x +@d out_vmove(#)==if abs(p)>=5*font_space[cur_font] then vv:=pixel_round(v+p) + else vv:=vv+pixel_round(p); +@y +@d out_vmove(#)==if abs(p)>=5*font_space[cur_font] then + begin if dd=0 then vv:=pixel_round(v+p) + else if dd=1 then hh:=pixel_round(h-p) + else {if dd=3 then} hh:=pixel_round(h+p); + end + else if dd=0 then vv:=vv+pixel_round(p) + else if dd=1 then hh:=hh-pixel_round(p) + else {if dd=3 then} hh:=hh+pixel_round(p); +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% Hexadecimal code +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@ @= +begin if (o>" ")and(o<="~") then + begin out_text(p); minor('setchar',p:1); + end +else major('setchar',p:1); +@y +@ @= +begin if (o>" ")and(o<="~") then + begin out_text(p); minor('setchar',p:1); + end +else major('setchar',p:1); +ifdef('HEX_CHAR_CODE') + print(' ('); + print_hex_number(p); + print(')'); +endif('HEX_CHAR_CODE') +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% pTeX +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +else hh:=hh+char_pixel_width(cur_font)(p); +@y +else if dd=0 then hh:=hh+char_pixel_width(cur_font)(p) + else if dd=1 then vv:=vv+char_pixel_width(cur_font)(p) + else {if dd=3 then} vv:=vv-char_pixel_width(cur_font)(p); +@z + +@x +hh:=hh+rule_pixels(q); goto move_right +@y +if dd=0 then hh:=hh+rule_pixels(q) +else if dd=1 then vv:=vv+rule_pixels(q) +else {if dd=3 then} vv:=vv-rule_pixels(q); +goto move_right +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% pTeX +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x + print('level ',ss:1,':(h=',h:1,',v=',v:1, + ',w=',w:1,',x=',x:1,',y=',y:1,',z=',z:1, + ',hh=',hh:1,',vv=',vv:1,')'); +@y + begin + print('level ',ss:1,':(h=',h:1,',v=',v:1, + ',w=',w:1,',x=',x:1,',y=',y:1,',z=',z:1); + if ptex_p then print(',d=',dd:1); + print(',hh=',hh:1,',vv=',vv:1,')'); + end; +@z + +@x +if k<>id_byte then bad_dvi('ID byte is ',k:1); +@y +ptex_p:=(k=ptex_id_byte); +if (k<>id_byte) and (not ptex_p) then bad_dvi('ID byte is ',k:1); +@z + +@x +print_ln(', maxstackdepth=',max_s:1,', totalpages=',total_pages:1); +@y +print_ln(', maxstackdepth=',max_s:1,', totalpages=',total_pages:1); +if ptex_p then print_ln('pTeX DVI (id=',ptex_id_byte:1,')'); +@z + +@x +if m<>id_byte then print_ln('identification in byte ',cur_loc-1:1, +@.identification...should be n@> + ' should be ',id_byte:1,'!'); +@y +if (m<>id_byte) and (m<>ptex_id_byte) then + print_ln('identification in byte ',cur_loc-1:1, +@.identification...should be n@> + ' should be ',id_byte:1,' or ',ptex_id_byte:1,'!'); +@z + +@x +const n_options = 8; {Pascal won't count array lengths for us.} +@y +const n_options = 10; {Pascal won't count array lengths for us.} +@z + +@x + usage_help (DVITYPE_HELP, nil); @y usage_help (UPDVITYPE_HELP, 'issue@@texjp.org'); @z +@x + end; {Else it was a flag; |getopt| has already done the assignment.} +@y + end else if argument_is ('kanji') then begin + set_prior_file_enc; + if (not set_enc_string(optarg,optarg)) then begin + write_ln('Bad kanji encoding "', stringcast(optarg), '".'); + end; + + end; {Else it was a flag; |getopt| has already done the assignment.} +@z + +@x +@ An element with all zeros always ends the list. +@y +@ Decide kanji encode +@.-kanji@> + +@ = +long_options[current_option].name := 'kanji'; +long_options[current_option].has_arg := 1; +long_options[current_option].flag := 0; +long_options[current_option].val := 0; +incr (current_option); + +@ An element with all zeros always ends the list. +@z diff --git a/Build/source/texk/web2c/uptexdir/updvitype.test b/Build/source/texk/web2c/uptexdir/updvitype.test index 2db8ef4c7e3..515f50f373d 100755 --- a/Build/source/texk/web2c/uptexdir/updvitype.test +++ b/Build/source/texk/web2c/uptexdir/updvitype.test @@ -1,5 +1,6 @@ #! /bin/sh -vx # $Id$ +# Copyright 2022 Japanese TeX Development Community # Copyright 2017 Karl Berry # Copyright 2011-2013 Peter Breitenlohner # You may freely use, modify and/or distribute this file. diff --git a/Build/source/texk/web2c/uptexdir/uppltotf.ch b/Build/source/texk/web2c/uptexdir/uppltotf.ch index 738b0141bdf..06960c591f1 100644 --- a/Build/source/texk/web2c/uptexdir/uppltotf.ch +++ b/Build/source/texk/web2c/uptexdir/uppltotf.ch @@ -1,38 +1,632 @@ -@x -@d my_name=='ppltotf' -@d banner=='This is pPLtoTF, Version 3.6-p2.0' +% This is a change file for PLtoTF +% +% (2022-12-03) TTK Merge pPLtoTF source/binary into upPLtoTF +% (2018-01-27) HY pPLtoTF p2.0 - new JFM spec by texjporg +% (07/18/2006) ST PLtoTF p1.8 (3.5, Web2c 7.2) +% (11/13/2000) KN PLtoTF p1.4 (3.5, Web2c 7.2) +% (03/27/1998) KN PLtoTF p1.3 (3.5, Web2c 7.2) +% +@x [0] l.52 - pTeX: +\def\title{PL$\,$\lowercase{to}$\,$TF changes for C} +@y +\def\title{PL$\,$\lowercase{to}$\,$TF changes for C, and for KANJI} +@z + +@x [2] l.69 - pTeX: +@d my_name=='pltotf' +@d banner=='This is PLtoTF, Version 3.6' {printed when the program starts} @y @d my_name=='uppltotf' -@d banner=='This is upPLtoTF, Version 3.6-p2.0-u1.29' +@d banner=='This is upPLtoTF, Version 3.6-p221203' + {printed when the program starts} +@z + +@x + parse_arguments; +@y + init_kanji; + parse_arguments; +@z + +@x [6] l.140 - pTeX: + print_ln (version_string); +@y + print_ln (version_string); + print_ln ('process kanji code is ', conststringcast(get_enc_string), '.'); +@z + +@x [18] l.495 - pTeX: +@!xord:array[char] of ASCII_code; {conversion table} +@y +@!xord:array[char] of ASCII_code; {conversion table} +@!xchr:array[char] of byte; {specifiles conversion of output character} +@z + +@x [19] l.506 - pTeX: +for k:=first_ord to last_ord do xord[chr(k)]:=invalid_code; +@y +for k:=0 to @'37 do xchr[k]:='?'; +for k:=@'40 to 255 do xchr[k]:=k; +for k:=first_ord to last_ord do xord[chr(k)]:=invalid_code; +@z + +@x [28] l.619 - pTeX: +else begin while (limitcharacter_code then + flush_error('This property name doesn''t belong on the outer level') +@.This property name doesn't belong...@> +@y +if cur_code=comment_code then skip_to_end_of_item +else if (cur_code>dir_code)or + ((file_format=tfm_format)and(cur_code>character_code)) then + flush_error('This property name doesn''t belong on the outer level') +@.This property name doesn't belong...@> +@z + +@x [85] l.1565 - pTeX: Added some property codes. +character_code: read_char_info; +@y +character_code: read_char_info; +type_code: read_kanji_info; +glue_kern_code: read_glue_kern; +chars_in_type_code: read_chars_in_type; +dir_code: read_direction; +@z + +@x [110] l.1915 - pTeX: there are no charlists in kanji format files. +for c:=0 to 255 do + @; +@y +if file_format=tfm_format then + for c:=0 to 255 do + @; +@z + +@x [120] l.2037 - pTeX: when checking glue_kern prog check glues as well + begin if lig_exam<>bchar then + check_existence(lig_exam)('LIG character examined by'); +@.LIG character examined...@> + check_existence(lig_gen)('LIG character generated by'); +@.LIG character generated...@> + if lig_gen>=128 then if(c<128)or(c=256) then + if(lig_exam<128)or(lig_exam=bchar) then seven_unsafe:=true; + end +@y + begin if file_format=tfm_format then + begin if lig_exam<>bchar then + check_existence(lig_exam)('LIG character examined by'); +@.LIG character examined...@> + check_existence(lig_gen)('LIG character generated by'); +@.LIG character generated...@> + if lig_gen>=128 then if(c<128)or(c=256) then + if(lig_exam<128)or(lig_exam=bchar) then seven_unsafe:=true; + end + else check_existence(lig_exam)('GLUE character generated by'); + end +@z + +@x [126] l.2178 - pTeX: Fix up output of bytes. +@= +if nl>0 then for lig_ptr:=0 to nl-1 do + if lig_kern[lig_ptr].b2= +@z + +@x [128] l.2207 - pTeX: Decide the |file_format|. +@= +@y +@= +case file_format of +tfm_format: do_nothing; +undefined,jfm_or_vfm: begin file_format:=jfm_format; + print_ln('Input file is in kanji YOKO-kumi format.'); + end; +jfm_format: print_ln('Input file is in kanji YOKO-kumi format.'); +vfm_format: print_ln('Input file is in kanji TATE-kumi format.'); +end; +@z + +@x [128] l.2211 - pTeX: Output kanji character +@; +@y +if file_format<>tfm_format then @; +@; +@z + +@x [128] l.2213 - pTeX: Output glue/kern programs +@; +@y +@; +if (file_format<>tfm_format)and(ng>0) then + for krn_ptr:=0 to ng-1 do + begin out_scaled(glue[3*krn_ptr+0]); + out_scaled(glue[3*krn_ptr+1]); + out_scaled(glue[3*krn_ptr+2]); + end; +@z + +@x [130] l.2238 - pTeX: +not_found:=true; bc:=0; +while not_found do + if (char_wd[bc]>0)or(bc=255) then not_found:=false + else incr(bc); +not_found:=true; ec:=255; +while not_found do + if (char_wd[ec]>0)or(ec=0) then not_found:=false + else decr(ec); +if bc>ec then bc:=1; +@y +if file_format<>tfm_format then + begin bc:=0; ec:=0; nt:=1; + for kanji_type_index:=0 to max_kanji do + begin if kanji_type[kanji_type_index]>0 then incr(nt); + if kanji_type[kanji_type_index]>ec then ec:=kanji_type[kanji_type_index]; + end; + end +else begin not_found:=true; bc:=0; + while not_found do + if (char_wd[bc]>0)or(bc=255) then not_found:=false + else incr(bc); + not_found:=true; ec:=255; + while not_found do + if (char_wd[ec]>0)or(ec=0) then not_found:=false + else decr(ec); + if bc>ec then bc:=1; + end; +@z + +@x [130] l.2250 - pTeX: +lf:=6+lh+(ec-bc+1)+memory[width]+memory[height]+memory[depth]+ +memory[italic]+nl+lk_offset+nk+ne+np; +@y +if file_format<>tfm_format then + lf:=7+nt+lh+(ec-bc+1)+memory[width]+memory[height]+memory[depth]+ + memory[italic]+nl+lk_offset+nk+3*ng+np +else + lf:=6+lh+(ec-bc+1)+memory[width]+memory[height]+memory[depth]+ + memory[italic]+nl+lk_offset+nk+ne+np; +@z + +@x [131] pTeX: +@ @d out_size(#)==out((#) div 256); out((#) mod 256) +@y +@ @d out_size(#)==out((#) div 256); out((#) mod 256) +@d out_kanji_code(#)==out_size((#) mod 65536); out((#) div 65536) +@z + +@x [131] l.2256 - pTeX: +out_size(lf); out_size(lh); out_size(bc); out_size(ec); +out_size(memory[width]); out_size(memory[height]); +out_size(memory[depth]); out_size(memory[italic]); +out_size(nl+lk_offset); out_size(nk); out_size(ne); out_size(np); +@y +if file_format=jfm_format then + begin out_size(yoko_id_number); out_size(nt); + end +else if file_format=vfm_format then + begin out_size(tate_id_number); out_size(nt); + end; +out_size(lf); out_size(lh); out_size(bc); out_size(ec); +out_size(memory[width]); out_size(memory[height]); +out_size(memory[depth]); out_size(memory[italic]); +out_size(nl+lk_offset); out_size(nk); +if file_format<>tfm_format then begin out_size(ng*3) + end +else begin out_size(ne); + end; +out_size(np); +@z + +@x [146] l.2476 - pTeX: +@p procedure param_enter; +@y +@p +@@/ +procedure param_enter; +@z + +@x [146] l.2488 - pTeX: LIGTABLE command can not be used in JPL. +begin @; +end; +@y +begin @; +@; +end; +@z + +@x [146] l.2493 - pTeX: CHARACTER command can not be used in JPL. +begin @; +end; +@y +begin @; +@; +end; +@z + +@x [146] l.2506 - pTeX: +begin @ +end; +@y +begin @ +end; +@# +procedure read_kanji_info; {TYPE command} +var @!c:byte; {the char} +begin @; +@; +end; +@# +procedure read_glue_kern; {GLUEKERN command} +var krn_ptr:0..max_kerns; {an index into |kern|} +@!c:byte; {runs through all character codes} +begin @; +@; +end; +@# +procedure read_chars_in_type; {CHARSINTYPE command} +var @!type_num:byte; {kanji character type number} +@!jis_code:integer; {sixteen bits Kanji character code} +begin @; +@; +end; +@# +procedure read_direction; {DIRECTION command} +begin @; +@; +end; +@z + +@x +const n_options = 3; {Pascal won't count array lengths for us.} +@y +const n_options = 5; {Pascal won't count array lengths for us.} @z @x - usage_help (PPLTOTF_HELP, 'issue@@texjp.org'); + usage_help (PLTOTF_HELP, nil); @y usage_help (UPPLTOTF_HELP, 'issue@@texjp.org'); @z @x -max_kanji=7237; { maximum number of 2byte characters } -max_kanji_code=@"7E7E; { maximum jis code } + end; {Else it was a flag; |getopt| has already done the assignment.} @y -max_kanji=1114111; { maximam number of 2byte characters } -max_kanji_code=@"10FFFF; { maximum ucs code } + end else if argument_is ('kanji') then begin + if (not set_enc_string(optarg,optarg)) then + print_ln('Bad kanji encoding "', stringcast(optarg), '".'); + + end; {Else it was a flag; |getopt| has already done the assignment.} @z -@x function get_next_raw -if multistrlen(ustringcast(buffer),loc+2,loc)=2 then cur_char:=" " +@x +@ An element with all zeros always ends the list. @y -if multistrlen(ustringcast(buffer),loc+3,loc)>1 then cur_char:=" " +@ Kanji option. +@.-kanji@> + +@ = +long_options[current_option].name := 'kanji'; +long_options[current_option].has_arg := 1; +long_options[current_option].flag := 0; +long_options[current_option].val := 0; +incr(current_option); + +@ An element with all zeros always ends the list. @z -@x procedure print_jis_hex -var dig:array[0..3] of byte; {holds jis hex codes} -i:byte; {index of array} -begin dig[0]:=Hi(jis_code) div 16; dig[1]:=Hi(jis_code) mod 16; -dig[2]:=Lo(jis_code) div 16; dig[3]:=Lo(jis_code) mod 16; -for i:=0 to 3 do +@x [148] l.2620 - pTeX: +@* Index. @y +@* For Japanese Font Metric routines. +We need to include some routines for handling kanji characters. + +@= +max_kanji=1114111; { maximam number of 2byte characters } +max_kanji_code=@"10FFFF; { maximum ucs code } +yoko_id_number=11; { is identifier for YOKO-kumi font} +tate_id_number=9; { is identifier for TATE-kumi font} + +@ @= +file_format:undefined..vfm_format; {the format of the input file} +kanji_type:array[0..max_kanji] of -1..256; {the type of every kanji char } +kanji_type_index:0..max_kanji; { index into above } +nt:integer; {number of entries in character type table} +glue:array[0..768] of fix_word; {the distinct glue amounts} +ng:integer; {number of 3-word entries in glue table} + +@ @= +file_format:=undefined; +for kanji_type_index:=0 to max_kanji do kanji_type[kanji_type_index]:=-1; +ng:=0; + +@ @= +if file_format>tfm_format then + err_print('This is an illegal command for kanji format files.') +else if file_format=undefined then file_format:=tfm_format + +@ @= +if file_format=tfm_format then + err_print('You can use this command only for kanji format files.') +else if file_format=undefined then file_format:=jfm_or_vfm + +@ These are extended propaties for \.{JFM}. + +@= +load4("T")("Y")("P")("E")(type_code);@/ +load8("G")("L")("U")("E")("K")("E")("R")("N")(glue_kern_code);@/ +load11("C")("H")("A")("R")("S")("I")("N")("T")("Y")("P")("E") + (chars_in_type_code);@/ +load9("D")("I")("R")("E")("C")("T")("I")("O")("N")(dir_code);@/ +load4("G")("L")("U")("E")(glue_code);@/ + +@ @= +load10("E")("X")("T")("R")("A")("S")("P")("A")("C")("E")(parameter_code+7);@/ +load12("E")("X")("T")("R")("A")("S")("T")("R")("E")("T")("C")("H") + (parameter_code+8);@/ +load11("E")("X")("T")("R")("A")("S")("H")("R")("I")("N")("K") + (parameter_code+9);@/ + + +@ Here, we declare kanji related routines and package gluekern stuff. +There routines a bit similar reading ligature/kern programs. + +@= +begin while level=1 do + begin while cur_char=" " do get_next; + if cur_char="(" then @ + else if cur_char=")" then skip_to_end_of_item + else junk_error; + end; +finish_inner_property_list; +end; + +@ @= +begin get_name; +if cur_code=comment_code then skip_to_end_of_item +else begin case cur_code of + label_code:@; + stop_code:@; + skip_code:@; + krn_code:@; + glue_code:@; + others: + flush_error('This property name doesn''t belong in a GLUEKERN list'); +@.This property name doesn't belong...@> + end; + finish_the_property; + end; +end + +@ When a character is about to be tagged, we use the following +so that an error message is given in case of multiple tags. + +@= +begin c:=get_byte; +case char_tag[c] of + no_tag: do_nothing; + lig_tag: err_print('This character already appeared in a GLUEKERN LABEL'); + @.This character already...@> + list_tag: err_print('Impossible: a list tag in a kanji format file?'); + ext_tag: err_print('Impossible: an extensible tag in a kanji format file?'); +end; +if nl>max_lig_steps then + err_print('GLUEKERN with more than ',max_lig_steps,' commands cannot have further labels') +@.GLUEKERN with more than...@> +else begin char_tag[c]:=lig_tag; char_remainder[c]:=nl; + lk_step_ended:=false; + end; +end + +@ @= +begin lig_kern[nl].b0:=0; lig_kern[nl].b1:=get_byte;@/ +lig_kern[nl].b2:=kern_flag; kern[nk]:=get_fix; krn_ptr:=0; +while kern[krn_ptr]<>kern[nk] do incr(krn_ptr); +if krn_ptr=nk then + begin if nk + krn_ptr:=max_kerns-1; + end; + end; +lig_kern[nl].b3:=krn_ptr; +if nl=max_lig_steps then + err_print('GLUEKERN table should never exceed ',max_lig_steps,' LIG/KRN commands') +@.GLUEKERN table should never...@> +else incr(nl); +lk_step_ended:=true; +end + +@ @= +begin lig_kern[nl].b0:=0; lig_kern[nl].b1:=get_byte; lig_kern[nl].b2:=0;@/ +glue[3*ng+0]:=get_fix; glue[3*ng+1]:=get_fix; glue[3*ng+2]:=get_fix; +krn_ptr:=0; +while (glue[3*krn_ptr+0]<>glue[3*ng+0])or + (glue[3*krn_ptr+1]<>glue[3*ng+1])or + (glue[3*krn_ptr+2]<>glue[3*ng+2]) do incr(krn_ptr); +if krn_ptr=ng then + begin if ng<256 then incr(ng) + else begin err_print('At most 256 different glues are allowed'); + krn_ptr:=255; + end; + end; +lig_kern[nl].b3:=krn_ptr; +if nl=max_lig_steps then + err_print('GLUEKERN table should never exceed ',max_lig_steps,' GLUE/KRN commands') +@.GLUEKERN table should never...@> +else incr(nl); +lk_step_ended:=true; +end + +@ The |TYPE| command like |CHARACTER| command, but |TYPE| only use +|CHARWD|, |CHARHT|, |CHARDP| and |CHARIT| + +@= +begin c:=get_byte; {read the character type that is begin specified} +if verbose then @; +while level=1 do + begin while cur_char=" " do get_next; + if cur_char="(" then @ + else if cur_char=")" then skip_to_end_of_item + else junk_error; + end; +if char_wd[c]=0 then char_wd[c]:=sort_in(width,0); {legitimatize c} +finish_inner_property_list; +end; + +@ @= +begin get_name; +if cur_code=comment_code then skip_to_end_of_item +else if (cur_codechar_ic_code) then + flush_error('This property name doesn''t belong in a TYPE list') +else begin case cur_code of + char_wd_code: char_wd[c]:=sort_in(width,get_fix); + char_ht_code: char_ht[c]:=sort_in(height,get_fix); + char_dp_code: char_dp[c]:=sort_in(depth,get_fix); + char_ic_code: char_ic[c]:=sort_in(italic,get_fix); + end;@/ + finish_the_property; + end; +end + +@ Next codes used to get KANJI codes from \.{JPL} file. + +@= +begin type_num:=get_byte; +if type_num=0 then + skip_error('You cannot list the chars in type 0. It is the default type') +else begin repeat jis_code:=get_kanji; + if jis_code<0 then + err_print('Illegal characters. I was expecting a jis code or character') + else if jis_code=0 then { 0 signals |end_of_list| } + do_nothing + else if kanji_type[jis_to_index(jis_code)]>=0 then + err_print('jis code ', jis_code:1, ' is already in type ', + kanji_type[jis_to_index(jis_code)]) + else + kanji_type[jis_to_index(jis_code)]:=type_num; + until jis_code=0; + skip_to_paren; + end +end + +@ Next codes read and check direction. We can not decide |file_format| of +metric file whether for yoko-kumi or tate-kumi, until have scan |DIRECTION| +property (|dir_code| command). + +@= +begin while cur_char=" " do get_next; +if cur_char="T" then + begin if verbose then print_ln('This is tatekumi format'); + file_format:=vfm_format; + end +else if cur_char="Y" then + begin if verbose then print_ln('This is yokokumi format'); + file_format:=jfm_format; + end +else err_print('The dir value should be "TATE" or "YOKO"'); +skip_to_paren; +end + +@ Next codes used to write |kanji_type| to \.{JFM}. +In the original JFM spec by ASCII Corporation, |jis_code| and |char_type| +were packed into upper (2~bytes) and lower (2~bytes) halfword respectively. +However, |char_type| is allowed only 0..255, +so the upper byte of lower halfword was always 0. + +In the new JFM spec by texjporg, |jis_code| ``XXyyzz'' is packed into +first 3~bytes in the form ``yy zz XX'', and |char_type| is packed into +remaining 1~byte. The new spec is effectively upper compatible with +the original, and it allows |jis_code| larger than 0x10000 (not really +useful for me \.{pPLtoTF} but necessary for \.{upPLtoTF}). + +@= +begin out_size(0); out_size(0); { the default } +for kanji_type_index:=0 to max_kanji do + begin if kanji_type[kanji_type_index]>0 then + begin out_kanji_code(index_to_jis(kanji_type_index)); + out(kanji_type[kanji_type_index]); + if verbose then begin + print('char index = ', kanji_type_index); + print(' (jis '); + print_jis_hex(index_to_jis(kanji_type_index)); + print(') is type '); + print_octal(kanji_type[kanji_type_index]); + write_ln(''); + end; + end; + end; +end; + +@ We also need to define some routines which handling 2bytes characters. +These routine is called from only |read_chars_in_type| command. + +The kanji jis code is taken from the |char_ext| and |char_code| values +set by the user. The index into the |kanji_type| array is based on the +kuten codes, with all unused codes removed and beginning at 0, not 0101. +The |jis_to_index| is called from |chars_in_type| command. + +@= +function get_next_raw:byte; {get next rawdata in buffer} +begin while loc=limit do fill_buffer; +incr(loc); get_next_raw:=buffer[loc]; +if multistrlen(ustringcast(buffer),loc+3,loc)>1 then cur_char:=" " +else cur_char:=xord[buffer[loc]]; +end; +@# +function todig(@!ch:byte):byte; {convert character to number} +begin if (ch>="A")and(ch<="F") then todig:=ch-"A"+10 +else if (ch>="0")and(ch<="9") then todig:=ch-"0" +else begin skip_error('This expression is out of JIS-code encoding.'); + todig:=0; + end; +end; +@# +procedure print_jis_hex(jis_code:integer); {prints jiscode as four digits} var dig:array[0..5] of byte; {holds jis hex codes} i:byte; {index of array} begin dig[0]:=(jis_code div 65536) div 16; dig[1]:=(jis_code div 65536) mod 16; @@ -47,51 +641,45 @@ for i:=0 to 1 do end; end; for i:=2 to 5 do -@z - -@x function valid_jis_code -var @!first_byte,@!second_byte:integer; { jis code bytes } -begin valid_jis_code:=true; -first_byte:=cx div @'400; second_byte:=cx mod @'400; -if (first_byte<@"21) - or((first_byte>@"28)and(first_byte<@"30)) - or(first_byte>@"74) then valid_jis_code:=false; -if (second_byte<@"21)or(second_byte>@"7E) then valid_jis_code:=false; -@y + if dig[i]<10 then print(dig[i]) else + case dig[i] of + 10: print('A'); 11: print('B'); 12: print('C'); + 13: print('D'); 14: print('E'); 15: print('F'); + end; +end; +@# +function valid_jis_code(cx:integer):boolean; begin valid_jis_code:=true; if (cx>@"10FFFF)or(not is_char_kanji(fromDVI(cx))) or(toDVI(fromDVI(cx))<>cx) then valid_jis_code:=false; -@z - -@x function jis_to_index -var @!first_byte,@!second_byte:integer; { jis code bytes } -begin -first_byte:=jis div @'400 -@"21; -second_byte:=jis mod @'400 -@"21; -if first_byte<8 then - jis_to_index:=first_byte*94+second_byte -else { next |first_byte| start 16 } - jis_to_index:=(first_byte-7)*94+second_byte; -@y +end; +@# +function jis_to_index(jis:integer):integer; begin jis_to_index:=jis; -@z - -@x function index_to_jis -begin if ix<=8*94-1 then - index_to_jis:=(ix div 94 +@"21)*@'400+(ix mod 94 +@"21) -else - index_to_jis:=((ix+7*94) div 94 +@"21)*@'400+((ix+7*94) mod 94 +@"21); -@y +end; +@# +function index_to_jis(ix:integer):integer; begin index_to_jis:=ix; -@z - -@x function get_kanji -else if multistrlen(ustringcast(buffer), loc+2, loc)=2 then - begin jis_code:=toDVI(fromBUFF(ustringcast(buffer), loc+2, loc)); - incr(loc); cur_char:=" "; -@y +end; +@# +function get_kanji:integer; {get kanji character code} +var @!ch:byte; +@!cx,@!jis_code:integer; {sixteen bits kanji character code} +begin repeat ch:=get_next_raw; {|ch| is rawdata in buffer} +until ch<>' '; {skip the blanks before the kanji code} +if ch=')' then + begin decr(loc); jis_code:=0; + end +else if (ch='J')or(ch='j') then + begin repeat ch:=get_next_raw; + until ch<>' '; {skip the blanks after the type code} + @; + jis_code:=toDVI(fromJIS(cx)); cur_char:=ch; + if not valid_jis_code(jis_code) then + err_print('jis code ', jis_code:1, ' is invalid'); + end else if (ch='U')or(ch='u') then begin repeat ch:=get_next_raw; until ch<>' '; {skip the blanks after the type code} @@ -104,5 +692,26 @@ else if multistrlen(ustringcast(buffer), loc+4, loc)>1 then begin cur_char:=" "; jis_code:=toDVI(fromBUFF(ustringcast(buffer), loc+4, loc)); loc:=loc+multistrlen(ustringcast(buffer), loc+4, loc)-1; -@z + if not valid_jis_code(jis_code) then + err_print('jis code ', jis_code:1, ' is invalid'); + end +else jis_code:=-1; +get_kanji:=jis_code; +end; +@ @= +begin cx:=todig(xord[ch]); + incr(loc); ch:=xord[buffer[loc]]; + while ((ch>="0")and(ch<="9"))or((ch>="A")and(ch<="F")) do + begin cx:=cx*16+todig(ch); {overflow might happen, but rare...} + incr(loc); ch:=xord[buffer[loc]]; + end; + decr(loc); ch:=xord[buffer[loc]]; + if cx>max_kanji_code then + begin skip_error('This value shouldn''t exceed jis code'); + cx:=0; ch:=" "; + end; +end + +@* Index. +@z diff --git a/Build/source/texk/web2c/uptexdir/uptftopl.ch b/Build/source/texk/web2c/uptexdir/uptftopl.ch index 7d406735ca5..5046263cc95 100644 --- a/Build/source/texk/web2c/uptexdir/uptftopl.ch +++ b/Build/source/texk/web2c/uptexdir/uptftopl.ch @@ -1,34 +1,492 @@ -@x -@d my_name=='ptftopl' -@d banner=='This is pTFtoPL, Version 3.3-p2.0' +% This is a change file for TFtoPL +% +% (2022-12-03) TTK Merge pTFtoPL source/binary into upTFtoPL +% (2018-01-27) HY pTFtoPL p2.0 - new JFM spec by texjporg +% (07/18/2006) ST TFtoPL p1.7 (3.1, Web2c 7.2) +% (03/27/1998) KN TFtoPL p1.4 (3.1, Web2c 7.2) +% +@x [0] l.45 - pTeX: +\def\title{TF\lowercase{to}PL changes for C} +@y +\def\title{TF\lowercase{to}PL changes for C, and for KANJI} +@z + +@x [2] l.64 - pTeX: +@d my_name=='tftopl' +@d banner=='This is TFtoPL, Version 3.3' {printed when the program starts} @y @d my_name=='uptftopl' -@d banner=='This is upTFtoPL, Version 3.3-p2.0-u1.29' +@d banner=='This is upTFtoPL, Version 3.3-p221203' + {printed when the program starts} +@z + +@x [2] l.91 - pTeX: +procedure initialize; {this procedure gets things started properly} +@y +procedure initialize; {this procedure gets things started properly} +var @!k:integer; {all-purpose initiallization index} +@z + +@x [2] l.97 - pTeX: + tfm_file_array := xmalloc_array (byte, 1002); +@y + tfm_file_array := xmalloc_array (byte, 1002 + 4); @z @x - usage_help (PTFTOPL_HELP, 'issue@@texjp.org'); + parse_arguments; @y - usage_help (UPTFTOPL_HELP, 'issue@@texjp.org'); + init_kanji; + parse_arguments; +@z + +@x [7] l.149 - pTeX: + print_ln (version_string); +@y + print_ln (version_string); + print_ln ('process kanji code is ', conststringcast(get_enc_string), '.'); +@z + +@x [18.20] l.438 - pTeX: +@d index == index_type +@y +@d index == index_type +@d yoko_id_byte = 11 {id byte for YOKO-kumi kanji tfm files} +@d tate_id_byte = 9 {id byte for TATE-kumi kanji tfm files} +@d tfm_format = 1 {normal tfm formated metric files} +@d jfm_format = 2 {jfm formated metric files for YOKO-kumi kanji} +@d vfm_format = 3 {vfm formated metric files for TATE-kumi kanji} +@z + +@x [18.20] l.448 - pTeX: +@!tfm_file_array: ^byte; {the input data all goes here} +@y +@!tfm_file_array: ^byte; {the input data all goes here} +@!file_format:tfm_format..vfm_format; {format of tfm file} +@!nt:0..@'77777; {number of words in the character type table} +@!ng:0..@'77777; {number of words in the glue table} +@z + +@x [20] l.434 - pTeX: Read JFM header +read(tfm_file,tfm[1]); lf:=tfm[0]*@'400+tfm[1]; +@y +read(tfm_file,tfm[1]); lf:=tfm[0]*@'400+tfm[1]; +if lf=yoko_id_byte then + begin file_format:=jfm_format; + print_ln('Input file is in YOKO-kumi kanji tfm format.'); + write_ln(pl_file,'(COMMENT THIS IS A KANJI FORMAT FILE)'); + end +else if lf=tate_id_byte then + begin file_format:=vfm_format; + print_ln('Input file is in TATE-kumi kanji tfm format.'); + write_ln(pl_file,'(COMMENT THIS IS A KANJI FORMAT FILE)'); + write_ln(pl_file,'(DIRECTION TATE)'); + end +else file_format:=tfm_format; +if file_format=tfm_format then + begin nt:=0; tmp_ptr:=2; + end +else + begin if eof(tfm_file) then abort('The input file is only two bytes long!'); + read(tfm_file,tfm[2]); + if eof(tfm_file) then abort('The input file is only three bytes long!'); + read(tfm_file,tfm[3]); nt:=tfm[2]*@'400+tfm[3]; + if eof(tfm_file) then abort('The input file is only four bytes long!'); + read(tfm_file,tfm[4]); + if eof(tfm_file) then abort('The input file is only five bytes long!'); + if tfm[4]>127 then abort('The fifth byte of the input file exceeds 127!'); + read(tfm_file,tfm[5]); lf:=tfm[4]*@'400+tfm[5]; + tmp_ptr:=6; + end; +@z + +@x [20] l.445 - pTeX: put the rest of the file into tfm[6] and after +for tfm_ptr:=2 to 4*lf-1 do +@y +for tfm_ptr:=tmp_ptr to 4*lf-1 do +@z + +@x [21] l.468 - pTeX: the location of subfile sizes is different +begin tfm_ptr:=2;@/ +@y +begin +if file_format<>tfm_format then + begin tfm_ptr:=6; check_sum_value:=28; + end +else + begin tfm_ptr:=2; check_sum_value:=24; + end; +@z + +@x [21] l.485 - pTeX: ng has to be treated specially +if (bc>ec+1)or(ec>255) then abort('The character code range ', +@.The character code range...@> + bc:1,'..',ec:1,' is illegal!'); +if (nw=0)or(nh=0)or(nd=0)or(ni=0) then + abort('Incomplete subfiles for character dimensions!'); +@.Incomplete subfiles...@> +if ne>256 then abort('There are ',ne:1,' extensible recipes!'); +@.There are ... recipes@> +if lf<>6+lh+(ec-bc+1)+nw+nh+nd+ni+nl+nk+ne+np then + abort('Subfile sizes don''t add up to the stated total!'); +@.Subfile sizes don't add up...@> +@y +case file_format of +tfm_format: begin + if (bc>ec+1)or(ec>255) then abort('The character code range ', +@.The character code range...@> + bc:1,'..',ec:1,' is illegal!'); + if (nw=0)or(nh=0)or(nd=0)or(ni=0) then + abort('Incomplete subfiles for character dimensions!'); +@.Incomplete subfiles...@> + if ne>256 then abort('There are ',ne:1,' extensible recipes!'); +@.There are ... recipes@> + if lf<>6+lh+(ec-bc+1)+nw+nh+nd+ni+nl+nk+ne+np then + abort('Subfile sizes don''t add up to the stated total!'); +@.Subfile sizes don't add up...@> + end; +jfm_format,vfm_format: begin ng:=ne; + if (bc>ec+1)or(ec>255)or(bc<>0) then abort('The character code range ', +@.The character code range...@> + bc:1,'..',ec:1,' is illegal!'); + if (nw=0)or(nh=0)or(nd=0)or(ni=0) then + abort('Incomplete subfiles for character dimensions!'); +@.Incomplete subfiles...@> + if lf<>7+nt+lh+(ec-bc+1)+nw+nh+nd+ni+nl+nk+ng+np then + abort('Sum of subfile sizes (', + 7+nt+lh+(ec-bc+1)+nw+nh+nd+ni+nl+nk+ng+np:1, + ') is not equal to the stated total ', lf:1); +@.Subfile sizes don't add up...@> + end; +end; +@z + +@x [23] l.506 - pTeX: declare type_base. +@!char_base,@!width_base,@!height_base,@!depth_base,@!italic_base, +@!lig_kern_base,@!kern_base,@!exten_base,@!param_base:integer; + {base addresses for the subfiles} +@y +@!char_base,@!width_base,@!height_base,@!depth_base,@!italic_base, +@!lig_kern_base,@!kern_base,@!exten_base,@!param_base:integer; +@!type_base,@!glue_base:integer; {base addresses for the subfiles} +@!check_sum_value:integer; {either 24 (normal case) or 28 (kanji case)} +@z + +@x [24] l.510 - pTeX: define type_base +@ @= +begin char_base:=6+lh-bc; +@y +@ @= +begin +if file_format<>tfm_format then + begin type_base:=7+lh; + char_base:=type_base+nt-bc; { bc should be zero ...} + end +else char_base:=6+lh-bc; +@z + +@x [24] l.517 - pTeX: define glue_base +kern_base:=lig_kern_base+nl; +exten_base:=kern_base+nk; +param_base:=exten_base+ne-1; +@y +kern_base:=lig_kern_base+nl; +exten_base:=kern_base+nk; +glue_base:=exten_base; +param_base:=exten_base+ne-1; +@z + +@x [25] l.529 - pTeX: must change check_sum from macro (=24) to variable +@d check_sum=24 +@d design_size=check_sum+4 +@d scheme=design_size+4 +@d family=scheme+40 +@d random_word=family+20 +@y +@d check_sum==check_sum_value +@d design_size==check_sum+4 +@d scheme==design_size+4 +@d family==scheme+40 +@d random_word==family+20 +@z + +@x [25] l.549 - pTeX: add definition of glue macro +@d kern(#)==4*(kern_base+#) {here \#\ is an index, not a character} +@y +@d kern(#)==4*(kern_base+#) {here \#\ is an index, not a character} +@d glue(#)==4*(glue_base+#) {likewise} +@z + +@x [57] l.982 - pTeX: SEVENBITSAFEFLAG +if (lh>17) and (tfm[random_word]>127) then +@y +if (lh>17) and (tfm[random_word]>127) and (file_format=tfm_format) then +@z + +@x [63] l.1003 - pTeX: Name of parameter for kanji-font +else if (i<=13)and(font_type=mathex) then + if i=8 then out('DEFAULTRULETHICKNESS') + else out('BIGOPSPACING',i-8:1) +else out('PARAMETER D ',i:1) +@y +else if (i<=13)and(font_type=mathex) then + if i=8 then out('DEFAULTRULETHICKNESS') + else out('BIGOPSPACING',i-8:1) +else if (i<=9)and(file_format<>tfm_format) then + if i=8 then out('EXTRASTRETCH') + else out('EXTRASHRINK') +else out('PARAMETER D ',i:1) +@z + +@x [64] l.1027 - pTeX: Add printing of newline at end of program +if nk>0 then for i:=0 to nk-1 do check_fix(kern(i))('Kern'); +@.Kern n is too big@> +@y +if nk>0 then for i:=0 to nk-1 do check_fix(kern(i))('Kern'); +@.Kern n is too big@> +if file_format<>tfm_format then + begin if ng>0 then for i:=0 to ng-1 do check_fix(glue(i))('Glue'); +@.Glue n is too big@> + end; +@z + +@x [68] l.1068 - pTeX: we print GLUEKERN instead of LIGTABLE + begin left; out('LIGTABLE'); out_ln;@/ +@y + begin left; + if file_format<>tfm_format then out('GLUEKERN') else out('LIGTABLE'); + out_ln;@/ +@z + +@x [69] l.1090 - pTeX: we print Glue/kern instead of Ligature/kern + print('Ligature/kern starting index for character '); print_octal(c); + print_ln(' is too large;'); print_ln('so I removed it.'); reset_tag(c); +@.Ligature/kern starting index...@> +@y + case file_format of + tfm_format: print('Ligature/kern '); +@.Ligature/kern starting index...@> + jfm_format,vfm_format: print('Glue/kern '); +@.Glue/kern starting index...@> + end; + print('starting index for character '); print_octal(c); + print_ln(' is too large;'); print_ln('so I removed it.'); reset_tag(c); +@z + +@x [76] l.1179 - pTeX: if kanji format, output a glue step not a ligature step +else @; +@y +else if file_format<>tfm_format then @ +else @; +@z + +@x [78] l.1238 - pTeX: +for c:=bc to ec do if width_index(c)>0 then +@y +for c:=bc to ec do +if width_index(c)=0 then + begin if file_format<>tfm_format then + bad('width index of type ',c:1,' is zero!!') + end +else if width_index(c)>0 then +@z + +@x [78] l.1246 - pTeX: the 'character' table is really the 'type' table + left; out('CHARACTER'); out_char(c); out_ln; +@y + left; + if file_format<>tfm_format then + begin out('TYPE'); tfm[0]:=c; out_octal(0,1); + end + else + begin out('CHARACTER'); out_char(c); + end; + out_ln; +@z + +@x [78] l.1251 - pTeX: types can only have tags equal to 0 or 1 + case tag(c) of + no_tag: do_nothing; + lig_tag: @; + list_tag: @; + ext_tag: @; + end; {there are no other cases} + right; + end +@y + case tag(c) of + no_tag: do_nothing; + lig_tag: @; + list_tag: if file_format<>tfm_format then + bad('the tag of type ',c:1,' must be 0 or 1') + else @; + ext_tag: if file_format<>tfm_format then + bad('the tag of type ',c:1,' must be 0 or 1') + else @; + end; {there are no other cases} + right; + end +@z + +@x [96] l.1539 - pTeX: +var tfm_ptr:index; {an index into |tfm|} +@y +var tfm_ptr,tmp_ptr:index; {an index into |tfm|} +@z + +@x [98] l.1566 - pTeX: declare kanji conversion subroutines and externals +@p begin initialize;@/ +@y +@p +@; +begin initialize;@/ +@z + +@x [99] l.1570 - pTeX: don't check extensible recipes and list the char_type table +@; +@y +if file_format<>tfm_format then + begin @; + end +else + begin @; + end; @z @x -@d max_kanji=7237 {number of the kanji characters - 1} +const n_options = 4; {Pascal won't count array lengths for us.} @y -@d max_kanji=1114111 {number of the kanji characters - 1} +const n_options = 6; {Pascal won't count array lengths for us.} @z -@x procedure out_kanji -i:0..3; {index of array} +@x + usage_help (TFTOPL_HELP, nil); @y -i:0..5; {index of array} + usage_help (UPTFTOPL_HELP, 'issue@@texjp.org'); @z + @x - begin cx:=jis_code; out('J '); {specify jiscode format} - dig[0]:=Hi(cx) div 16; dig[1]:=Hi(cx) mod 16; - dig[2]:=Lo(cx) div 16; dig[3]:=Lo(cx) mod 16; - for i:=0 to 3 do + end; {Else it was a flag; |getopt| has already done the assignment.} @y + end else if argument_is ('kanji') then begin + if (not set_enc_string(optarg,optarg)) then + print_ln('Bad kanji encoding "', stringcast(optarg), '".'); + + end; {Else it was a flag; |getopt| has already done the assignment.} +@z + +@x +@ An element with all zeros always ends the list. +@y +@ Kanji option. +@.-kanji@> + +@ = +long_options[current_option].name := 'kanji'; +long_options[current_option].has_arg := 1; +long_options[current_option].flag := 0; +long_options[current_option].val := 0; +incr(current_option); + +@ An element with all zeros always ends the list. +@z + +@x [99] l.1751 - pTeX: +@* Index. +@y +@* For Japanese Font Metric routines. % pTeX: +We need to include some routines for handling kanji character. + +@d max_kanji=1114111 {number of the kanji characters - 1} + +@= +@!this_code:integer; {to hold jis code of the current kanji character} +@!this_type:integer; {to hold |char_type| of the current kanji character} +@!type_index:integer; {index into |char_type| table} +@!type_num:integer; {index into |char_info| table} +@!type_count:integer; {number of chars with the same type} +@!kanji_index:integer; {index into |kanji_type| array} +@!kanji_type:array[0..max_kanji] of -1..255; {kanji type index} + +@ @= +begin if nonexistent(tfm[k+1]) then + correct_bad_char('Glue step for')(k+1) +@.Glue step for nonexistent...@> +else + begin left; out('GLUE'); out_char(tfm[k+1]); + if 3*tfm[k+3]>=ng then + begin bad('Glue index too large.'); +@.Glue index too large@> + out(' R 0.0 R 0.0 R 0.0'); + end + else begin out_fix(glue(3*tfm[k+3])); + out_fix(glue(3*tfm[k+3]+1)); + out_fix(glue(3*tfm[k+3]+2)); + end; + right; + end; +end + +@ list the |char_type| table in a similar way to the type table. +The code is based on the new JFM spec by texjporg. + +@d char_type(#)==4*(type_base+#) {here \#\ is an index, not a character} +@d JIS_code(#)==tfm[char_type(#)+0]*@'400+tfm[char_type(#)+1]+tfm[char_type(#)+2]*@'400*@'400 {JIS code from |char_type| table} +@d JIS_type(#)==tfm[char_type(#)+3] {JIS type from |char_type| table} + +@= +this_code:=JIS_code(0); +this_type:=JIS_type(0); +if (this_code<>0)or(this_type<>0) then + begin bad('the first entry in char_type is not zero. I''ll zero it.'); + print_ln('JIS code is ', this_code:1, '. Type is ', this_type:1, '.'); + end; +for kanji_index:=0 to max_kanji do kanji_type[kanji_index]:=-1; +for type_index:=1 to nt-1 do + begin this_code:=JIS_code(type_index); + this_type:=JIS_type(type_index); + if not valid_jis_code(this_code) then + bad('jis code ', this_code:1, + ' in char_type table entry ', type_index:1, + ' is not valid. Ignoring it.') + else if (this_type <= 0) or (this_type > ec) then + bad('type ', this_type:1, ' of jis code ', this_code:1, + ' in char_type table is not valid. Ignoring character.') + else + kanji_type[jis_to_index(this_code)] := this_type; + end; +@# +for type_num:=1 to ec do + begin left; out('CHARSINTYPE'); + tfm[0]:=type_num; out_octal(0,1); + type_count:=0; + for kanji_index:=0 to max_kanji do + if kanji_type[kanji_index]=type_num then + begin if (type_count mod 10)=0 then out_ln else out(' '); + incr(type_count); + out_kanji(index_to_jis(kanji_index)); + end; + if type_count=0 then bad('type ', type_num:1, ' has no characters in it!'); + out_ln; right; + end; + +@ Some subroutines to handle kanji codes and i/o + +@= +@!xchr:array[char] of byte; {specifiles conversion of output charcter} + +@ @= +for k:=@'0 to @'37 do xchr[k]:='?'; +for k:=@'40 to 255 do xchr[k]:=k; + +@ @= +procedure out_kanji(jis_code:integer); { prints a kanji character } +var @!cx:integer; {KANJI code} +i:0..5; {index of array} +begin@/ +if (charcode_format=charcode_octal)or(jis_code<128) then begin cx:=jis_code; if (isinternalUPTEX) then out('U ') else out('J '); {specify jiscode format} @@ -44,51 +502,39 @@ i:0..5; {index of array} end; end; for i:=2 to 5 do -@z - -@x - out(xchr[Hi(cx)]); out(xchr[Lo(cx)]); -@y + if dig[i]<10 then out(dig[i]) else + case dig[i] of + 10: out('A'); 11: out('B'); 12: out('C'); + 13: out('D'); 14: out('E'); 15: out('F'); + end; + end +else begin + cx:=toBUFF(fromDVI(jis_code)); if BYTE1(cx)<>0 then out(xchr[BYTE1(cx)]); if BYTE2(cx)<>0 then out(xchr[BYTE2(cx)]); if BYTE3(cx)<>0 then out(xchr[BYTE3(cx)]); out(xchr[BYTE4(cx)]); -@z + end; +end; -@x function valid_jis_code -var first_byte, second_byte:integer; { jis code bytes } -begin valid_jis_code:=true; -first_byte:=cx div @'400; second_byte:=cx mod @'400; -if (first_byte<@"21) - or((first_byte>@"28)and(first_byte<@"30)) - or(first_byte>@"74) then valid_jis_code:=false; -if (second_byte<@"21)or(second_byte>@"7E) then valid_jis_code:=false; -@y +@ @= +function valid_jis_code(cx:integer):boolean; begin valid_jis_code:=true; if (cx>@"10FFFF)or(not is_char_kanji(fromDVI(cx))) or(toDVI(fromDVI(cx))<>cx) then valid_jis_code:=false; -@z +end; -@x function index_to_jis -if ix<=8*94-1 then - index_to_jis:=(ix div 94 + @"21) * @'400 + (ix mod 94 + @"21) -else - index_to_jis:=((ix+7 * 94) div 94 + @"21) * @'400 + ((ix+7*94) mod 94 + @"21); -@y +@ @= +function index_to_jis(ix:integer):integer; +begin index_to_jis:=ix; -@z +end; -@x function jis_to_index -var first_byte,second_byte:integer; { jis code bytes } -begin -first_byte:=cx div @'400 - @"21; -second_byte:=cx mod @'400 - @"21; -if first_byte<8 then - jis_to_index:=first_byte*94+second_byte -else - jis_to_index:=(first_byte-7)*94+second_byte; -@y +@ @= +function jis_to_index(cx:integer):integer; begin jis_to_index:=cx; -@z +end +@* Index. +@z diff --git a/Build/source/texk/web2c/uptexdir/yokotate.test b/Build/source/texk/web2c/uptexdir/yokotate.test index d90ecc1dd88..bb987f0d607 100755 --- a/Build/source/texk/web2c/uptexdir/yokotate.test +++ b/Build/source/texk/web2c/uptexdir/yokotate.test @@ -1,5 +1,6 @@ #! /bin/sh -vx # $Id$ +# Copyright 2022 Japanese TeX Development Community # Copyright 2017 Karl Berry # Copyright 2013 Peter Breitenlohner # You may freely use, modify and/or distribute this file. -- cgit v1.2.3