Commit | Line | Data |
---|---|---|
61dad979 KW |
1 | use v5.16.0; |
2 | use strict; | |
3 | use warnings; | |
4 | require 'regen/regen_lib.pl'; | |
5 | use charnames qw(:loose); | |
6 | ||
1b0f46bf | 7 | my $out_fh = open_new('unicode_constants.h', '>', |
61dad979 KW |
8 | {style => '*', by => $0, |
9 | from => "Unicode data"}); | |
10 | ||
11 | print $out_fh <<END; | |
d10c72f2 | 12 | |
1b0f46bf KW |
13 | #ifndef H_UNICODE_CONSTANTS /* Guard against nested #includes */ |
14 | #define H_UNICODE_CONSTANTS 1 | |
d10c72f2 | 15 | |
61dad979 | 16 | /* This file contains #defines for various Unicode code points. The values |
525b6419 KW |
17 | * the macros expand to are the native Unicode code point, or all or portions |
18 | * of the UTF-8 encoding for the code point. In the former case, the macro | |
19 | * name has the suffix "_NATIVE"; otherwise, the suffix "_UTF8". | |
61dad979 | 20 | * |
525b6419 KW |
21 | * The macros that have the suffix "_UTF8" may have further suffixes, as |
22 | * follows: | |
23 | * "_FIRST_BYTE" if the value is just the first byte of the UTF-8 | |
24 | * representation; the value will be a numeric constant. | |
25 | * "_TAIL" if instead it represents all but the first byte. This, and | |
26 | * with no additional suffix are both string constants */ | |
61dad979 KW |
27 | |
28 | END | |
29 | ||
76837d21 KW |
30 | # The data are at the end of this file. A blank line is output as-is. |
31 | # Otherwise, each line represents one #define, and begins with either a | |
32 | # Unicode character name with the blanks in it squeezed out or replaced by | |
33 | # underscores; or it may be a hexadecimal Unicode code point. In the latter | |
34 | # case, the name will be looked-up to use as the name of the macro. In either | |
35 | # case, the macro name will have suffixes as listed above, and all blanks will | |
36 | # be replaced by underscores. | |
61dad979 KW |
37 | # |
38 | # Each line may optionally have one of the following flags on it, separated by | |
39 | # white space from the initial token. | |
5f1720e9 | 40 | # string indicates that the output is to be of the string form |
61dad979 | 41 | # described in the comments above that are placed in the file. |
5f1720e9 | 42 | # first indicates that the output is to be of the FIRST_BYTE form. |
61dad979 | 43 | # tail indicates that the output is of the _TAIL form. |
525b6419 KW |
44 | # native indicates that the output is the code point, converted to the |
45 | # platform's native character set if applicable | |
61dad979 | 46 | # |
765ec46c KW |
47 | # If the code point has no official name, the desired name may be appended |
48 | # after the flag, which will be ignored if there is an official name. | |
49 | # | |
61dad979 KW |
50 | # This program is used to make it convenient to create compile time constants |
51 | # of UTF-8, and to generate proper EBCDIC as well as ASCII without manually | |
52 | # having to figure things out. | |
53 | ||
54 | while ( <DATA> ) { | |
76837d21 KW |
55 | if ($_ !~ /\S/) { |
56 | print $out_fh "\n"; | |
57 | next; | |
58 | } | |
59 | ||
61dad979 KW |
60 | chomp; |
61 | unless ($_ =~ m/ ^ ( [^\ ]* ) # Name or code point token | |
765ec46c KW |
62 | (?: [\ ]+ ( [^ ]* ) )? # optional flag |
63 | (?: [\ ]+ ( .* ) )? # name if unnamed; flag is required | |
61dad979 KW |
64 | /x) |
65 | { | |
66 | die "Unexpected syntax at line $.: $_\n"; | |
67 | } | |
68 | ||
69 | my $name_or_cp = $1; | |
70 | my $flag = $2; | |
765ec46c | 71 | my $desired_name = $3; |
61dad979 KW |
72 | |
73 | my $name; | |
74 | my $cp; | |
75 | ||
76 | if ($name_or_cp =~ /[^[:xdigit:]]/) { | |
77 | ||
78 | # Anything that isn't a hex value must be a name. | |
79 | $name = $name_or_cp; | |
80 | $cp = charnames::vianame($name =~ s/_/ /gr); | |
81 | die "Unknown name '$name' at line $.: $_\n" unless defined $name; | |
82 | } | |
83 | else { | |
84 | $cp = $name_or_cp; | |
765ec46c KW |
85 | $name = charnames::viacode("0$cp") // ""; # viacode requires a leading |
86 | # zero to be sure that the | |
87 | # argument is hex | |
61dad979 KW |
88 | die "Unknown code point '$cp' at line $.: $_\n" unless defined $cp; |
89 | } | |
90 | ||
765ec46c | 91 | $name = $desired_name if $name eq ""; |
61dad979 KW |
92 | $name =~ s/ /_/g; # The macro name can have no blanks in it |
93 | ||
94 | my $str = join "", map { sprintf "\\x%02X", $_ } | |
95 | unpack("U0C*", pack("U", hex $cp)); | |
96 | ||
97 | my $suffix = '_UTF8'; | |
5f1720e9 | 98 | if (! defined $flag || $flag eq 'string') { |
61dad979 KW |
99 | $str = "\"$str\""; # Will be a string constant |
100 | } elsif ($flag eq 'tail') { | |
101 | $str =~ s/\\x..//; # Remove the first byte | |
102 | $suffix .= '_TAIL'; | |
103 | $str = "\"$str\""; # Will be a string constant | |
104 | } | |
105 | elsif ($flag eq 'first') { | |
106 | $str =~ s/ \\x ( .. ) .* /$1/x; # Get the two nibbles of the 1st byte | |
107 | $suffix .= '_FIRST_BYTE'; | |
108 | $str = "0x$str"; # Is a numeric constant | |
109 | } | |
525b6419 KW |
110 | elsif ($flag eq 'native') { |
111 | die "Are you sure you want to run this on an above-Latin1 code point?" if hex $cp > 0xff; | |
112 | $suffix = '_NATIVE'; | |
113 | $str = utf8::unicode_to_native(hex $cp); | |
114 | $str = "0x$cp"; # Is a numeric constant | |
115 | } | |
61dad979 KW |
116 | else { |
117 | die "Unknown flag at line $.: $_\n"; | |
118 | } | |
119 | print $out_fh "#define ${name}$suffix $str /* U+$cp */\n"; | |
120 | } | |
121 | ||
1b0f46bf | 122 | print $out_fh "\n#endif /* H_UNICODE_CONSTANTS */\n"; |
d10c72f2 | 123 | |
61dad979 KW |
124 | read_only_bottom_close_and_rename($out_fh); |
125 | ||
126 | __DATA__ | |
5f1720e9 KW |
127 | 0300 string |
128 | 0301 string | |
129 | 0308 string | |
76837d21 | 130 | |
0a982f06 | 131 | 03B9 string |
76837d21 | 132 | |
0a982f06 | 133 | 03C5 string |
76837d21 | 134 | |
5f1720e9 | 135 | 2010 string |
765ec46c | 136 | D800 first FIRST_SURROGATE |
525b6419 KW |
137 | |
138 | 007F native | |
139 | 00DF native | |
140 | 00E5 native | |
141 | 00C5 native | |
142 | 00FF native | |
143 | 00B5 native | |
144 | 0085 native |