1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108 | ------------------------------------------------------------------------------
-- XML/Ada - An XML suite for Ada95 --
-- --
-- Copyright (C) 2016, Nicolas Boulenguez --
-- Copyright (C) 2016-2022, AdaCore --
-- --
-- This library is free software; you can redistribute it and/or modify it --
-- under terms of the GNU General Public License as published by the Free --
-- Software Foundation; either version 3, or (at your option) any later --
-- version. This library is distributed in the hope that it will be useful, --
-- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN- --
-- TABILITY or FITNESS FOR A PARTICULAR PURPOSE. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are granted --
-- additional permissions described in the GCC Runtime Library Exception, --
-- version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
------------------------------------------------------------------------------
pragma Ada_2012;
with Ada.Strings.Maps.Constants;
with Ada.Text_IO;
package body Translators.Alias is
function Default_Translation
(Translator : An_Alias_Translator; Original : String)
return String
is
pragma Unreferenced (Translator);
Result : String (1 .. Original'Length);
Result_Last : Integer := 0;
Word_Start : Boolean := True;
begin
pragma Assert (Original'Length /= 0);
if Original (Original'First) not in 'A' .. 'Z'
or Original (Original'Last) not in 'A' .. 'Z' | '0' .. '9'
then
Ada.Text_IO.Put_Line ("Unused alias: """ & Original & '"');
return "";
end if;
for I in Original'Range loop
case Original (I) is
when 'A' .. 'Z' =>
Result_Last := Result_Last + 1;
if Word_Start then
Result (Result_Last) := Original (I);
Word_Start := False;
else
Result (Result_Last) := Ada.Strings.Maps.Value
(Ada.Strings.Maps.Constants.Lower_Case_Map, Original (I));
end if;
when '0' .. '9' =>
Result_Last := Result_Last + 1;
Result (Result_Last) := Original (I);
Word_Start := False;
when ' ' | '-' =>
-- Ignore dash after or before a letter.
if not ((Original (I - 1) in 'A' .. 'Z'
and Original (I .. I + 1) = "- ")
or (Original (I + 1) in 'A' .. 'Z'
and Original (I - 1 .. I) = " -"))
then
pragma Assert (not Word_Start);
Result_Last := Result_Last + 1;
Result (Result_Last) := '_';
Word_Start := True;
end if;
when others =>
Ada.Text_IO.Put_Line ("Unused alias: """ & Original & '"');
return "";
end case;
end loop;
return Result (1 .. Result_Last);
exception
when others =>
Ada.Text_IO.Put_Line ("Cannot translate point """ & Original & '"');
raise;
end Default_Translation;
procedure Set_Exceptions (Translator : in out An_Alias_Translator) is
procedure Add (Key, Value : String) with inline;
procedure Add (Key, Value : String) is
begin
Translator.Exceptions.Insert (Key, (Value'Length, Value, 0));
end Add;
begin
-- Would be handled correctly, but trigger a noisy log line.
Add ("<control>", "");
-- Ada keywords
Add ("XOR", "Unicode_Xor"); -- 22BB
Add ("PACKAGE", "Unicode_Package"); -- 1F4E6
Add ("NULL", "Unicode_Null");
-- Uniquify names only differing only by a dash.
Add ("TIBETAN LETTER -A", "Tibetan_Letter_Dash_A");
Add ("TIBETAN SUBJOINED LETTER -A", "Tibetan_Subjoined_Letter_Dash_A");
Add ("MARCHEN LETTER -A", "Marchen_Letter_Dash_A");
end Set_Exceptions;
end Translators.Alias;
|