upbibtex: support Latin-{1,Ext-A}, Greek & Cyrillic on change.case$

git-svn-id: svn://tug.org/texlive/trunk@63246 c570f23f-e606-0410-a88d-b1316a301751

3 files changed, 135 insertions, 2 deletions

diff --git a/Build/source/texk/bibtex-x/ChangeLog b/Build/source/texk/bibtex-x/ChangeLog
index 71b30434e8a..1faaddf7efc 100644
--- a/Build/source/texk/bibtex-x/ChangeLog
+++ b/Build/source/texk/bibtex-x/ChangeLog
@@ -6,7 +6,7 @@
 	Accept max_print_line variable in kpathsea.
 	We can define max_print_line.bibtex8 or max_print_line.bibtexu
 	in texmf.cnf.
-	* tests/bibtex[8u]-char.test, tests/name[au].,bbl:
+	* tests/bibtex[8u]-char.test, tests/name[au].bbl:
 	Update tests.
 
 2022-04-29  TANAKA Takuji  <ttk@t-lab.opal.ne.jp>
diff --git a/Build/source/texk/web2c/uptexdir/ChangeLog b/Build/source/texk/web2c/uptexdir/ChangeLog
index 86b43c5918d..6957eab5094 100644
--- a/Build/source/texk/web2c/uptexdir/ChangeLog
+++ b/Build/source/texk/web2c/uptexdir/ChangeLog
@@ -1,3 +1,10 @@
+2022-05-07  TANAKA Takuji  <ttk@t-lab.opal.ne.jp>
+
+	* upbibtex.ch:
+	Support Latin-1, Latin Extended-A, Greek and Cyrillic on change.case$.
+	Ignore add.period$ after Interrobang ‽.
+	Make is.kanji.str$ false for Ideographic Description Characters.
+
 2022-05-06  TANAKA Takuji  <ttk@t-lab.opal.ne.jp>
 
 	* upbibtex.ch: Fix bug on kpse_set_progname.
diff --git a/Build/source/texk/web2c/uptexdir/upbibtex.ch b/Build/source/texk/web2c/uptexdir/upbibtex.ch
index 11f47487084..dcecabde131 100644
--- a/Build/source/texk/web2c/uptexdir/upbibtex.ch
+++ b/Build/source/texk/web2c/uptexdir/upbibtex.ch
@@ -50,6 +50,7 @@ for i:=@'200 to 255 do xord[i]:=i;
 @d u_exclamation = @"FF01       {Zenkaku exclamation mark; in UCS}
 @d u_double_question = @"2047   {Zenkaku double question mark; in UCS}
 @d u_double_exclam   = @"203C   {Zenkaku double exclamation mark; in UCS}
+@d u_interrobang     = @"203D   {Zenkaku interrobang; in UCS}
 @d u_question_exclam = @"2048   {Zenkaku question exclamation mark; in UCS}
 @d u_exclam_question = @"2049   {Zenkaku exclamation question mark; in UCS}
 @z
@@ -71,6 +72,130 @@ for i:=@'240 to 254 do char_width[i]:=514;
 @y
 @z
 
+@x procedure lower_case
+procedure lower_case (var buf:buf_type; @!bf_ptr,@!len:buf_pointer);
+var i:buf_pointer;
+begin
+if (len > 0) then
+  for i := bf_ptr to bf_ptr+len-1 do
+    if ((buf[i]>="A") and (buf[i]<="Z")) then
+        buf[i] := buf[i] + case_difference;
+@y
+procedure lower_case (var buf:buf_type; @!bf_ptr,@!len:buf_pointer);
+var i:buf_pointer;
+    @!ch:integer;
+begin
+if (len > 0) then
+  for i := bf_ptr to bf_ptr+len-1 do
+    if ((buf[i]>="A") and (buf[i]<="Z")) then begin
+        buf[i] := buf[i] + case_difference;
+    end
+    else if ((is_internalUPTEX) and (buf[i]>=@"C3) and (buf[i]<=@"D4)) then begin
+        ch := fromBUFF(buf,i+2,i);
+        if (((ch>=@"C0) and (ch<=@"DE) and (ch<>@"D7)) or
+            ((ch>=@"391) and (ch<=@"3AA) and (ch<>@"3A2)) or
+            ((ch>=@"410) and (ch<=@"42F))) then begin
+            ch := toBUFF(ch + case_difference);
+            buf[i]   := BYTE3(ch);
+            buf[i+1] := BYTE4(ch);
+        end
+        else if (((ch>=@"100) and (ch<=@"137) and ((ch mod 2)=0)) or
+                 ((ch>=@"139) and (ch<=@"148) and ((ch mod 2)=1)) or
+                 ((ch>=@"14A) and (ch<=@"177) and ((ch mod 2)=0)) or
+                 ((ch>=@"179) and (ch<=@"17E) and ((ch mod 2)=1)) or
+                 ((ch>=@"370) and (ch<=@"373) and ((ch mod 2)=0)) or
+                 ( ch=@"376 ) or
+                 ((ch>=@"3D8) and (ch<=@"3EF) and ((ch mod 2)=0)) or
+                 ( ch=@"3F7 ) or  ( ch=@"3FA ) or
+                 ((ch>=@"460) and (ch<=@"481) and ((ch mod 2)=0)) or
+                 ((ch>=@"48A) and (ch<=@"4BF) and ((ch mod 2)=0)) or
+                 ((ch>=@"4C1) and (ch<=@"4CE) and ((ch mod 2)=1)) or
+                 ((ch>=@"4D0) and (ch<=@"52F) and ((ch mod 2)=0))) then begin
+            ch := toBUFF(ch + 1);
+            buf[i]   := BYTE3(ch);
+            buf[i+1] := BYTE4(ch);
+        end
+        else if (ch=@"178) then begin
+            ch := toBUFF(@"FF);
+            buf[i]   := BYTE3(ch);
+            buf[i+1] := BYTE4(ch);
+        end
+        else if ((ch>=@"400) and (ch<=@"40F)) then begin
+            ch := toBUFF(ch + @"50);
+            buf[i]   := BYTE3(ch);
+            buf[i+1] := BYTE4(ch);
+        end
+        else if (ch=@"4C0) then begin
+            ch := toBUFF(@"4CF);
+            buf[i]   := BYTE3(ch);
+            buf[i+1] := BYTE4(ch);
+        end
+    end
+@z
+
+@x procedure upper_case
+var i:buf_pointer;
+begin
+if (len > 0) then
+  for i := bf_ptr to bf_ptr+len-1 do
+    if ((buf[i]>="a") and (buf[i]<="z")) then
+        buf[i] := buf[i] - case_difference;
+@y
+var i:buf_pointer;
+    @!ch:integer;
+begin
+if (len > 0) then
+  for i := bf_ptr to bf_ptr+len-1 do
+    if ((buf[i]>="a") and (buf[i]<="z")) then begin
+        buf[i] := buf[i] - case_difference;
+    end
+    else if ((is_internalUPTEX) and (buf[i]>=@"C3) and (buf[i]<=@"D4)) then begin
+        ch := fromBUFF(buf,i+2,i);
+        if (((ch>=@"E0) and (ch<=@"FE) and (ch<>@"F7)) or
+            ((ch>=@"3B1) and (ch<=@"3CA) and (ch<>@"3C2)) or
+            ((ch>=@"430) and (ch<=@"44F))) then begin
+            ch := toBUFF(ch - case_difference);
+            buf[i]   := BYTE3(ch);
+            buf[i+1] := BYTE4(ch);
+        end
+        else if (((ch>=@"100) and (ch<=@"137) and ((ch mod 2)=1)) or
+                 ((ch>=@"139) and (ch<=@"148) and ((ch mod 2)=0)) or
+                 ((ch>=@"14A) and (ch<=@"177) and ((ch mod 2)=1)) or
+                 ((ch>=@"179) and (ch<=@"17E) and ((ch mod 2)=0)) or
+                 ((ch>=@"370) and (ch<=@"373) and ((ch mod 2)=1)) or
+                 ( ch=@"377 ) or
+                 ((ch>=@"3D8) and (ch<=@"3EF) and ((ch mod 2)=1)) or
+                 ( ch=@"3F8 ) or  ( ch=@"3FB ) or
+                 ((ch>=@"460) and (ch<=@"481) and ((ch mod 2)=1)) or
+                 ((ch>=@"48A) and (ch<=@"4BF) and ((ch mod 2)=1)) or
+                 ((ch>=@"4C1) and (ch<=@"4CE) and ((ch mod 2)=0)) or
+                 ((ch>=@"4D0) and (ch<=@"52F) and ((ch mod 2)=1))) then begin
+            ch := toBUFF(ch - 1);
+            buf[i]   := BYTE3(ch);
+            buf[i+1] := BYTE4(ch);
+        end
+        else if (ch=@"DF) then begin { Latin Small Letter Sharp S }
+            buf[i]   := "S";
+            buf[i+1] := "S";
+        end
+        else if (ch=@"FF) then begin
+            ch := toBUFF(@"178);
+            buf[i]   := BYTE3(ch);
+            buf[i+1] := BYTE4(ch);
+        end
+        else if ((ch>=@"450) and (ch<=@"45F)) then begin
+            ch := toBUFF(ch - @"50);
+            buf[i]   := BYTE3(ch);
+            buf[i+1] := BYTE4(ch);
+        end
+        else if (ch=@"4CF) then begin
+            ch := toBUFF(@"4C0);
+            buf[i]   := BYTE3(ch);
+            buf[i+1] := BYTE4(ch);
+        end
+    end
+@z
+
 @x procedure get_the_top_level_aux_file_name
 label aux_found,@!aux_not_found;
 @y
@@ -122,6 +247,7 @@ var i:0..last_text_char;    {this is the first one declared}
                 u_exclamation,
                 u_double_question,
                 u_double_exclam,
+                u_interrobang,
                 u_question_exclam,
                 u_exclam_question:
                     repush_string;
@@ -405,7 +531,7 @@ begin
   if (is_internalUPTEX) then begin { should be in sync with |kcat_code| of uptex-m.ch }
     k := kcatcodekey(c);
     if k=@"25 then return { Hangul Jamo }
-    else if (k>=@"68)and(k<=@"6A) then return { CJK Radicals Supplement .. Ideographic Description Characters }
+    else if (k>=@"68)and(k<=@"69) then return { CJK Radicals Supplement, Kangxi Radicals }
     else if (k>=@"6C)and(k<=@"6D) then return { Hiragana, Katakana }
     else if k=@"6E then return { Bopomofo }
     else if k=@"6F then return { Hangul Compatibility Jamo }