1------------------------------------------------------------------------------
2--                                                                          --
3--                            GNAT2XML COMPONENTS                           --
4--                                                                          --
5--                               S T R I N G S                              --
6--                                                                          --
7--                                 S p e c                                  --
8--                                                                          --
9--                     Copyright (C) 2012-2015, AdaCore                     --
10--                                                                          --
11-- Gnat2xml is free software; you can redistribute it and/or modify it      --
12-- under terms of the  GNU General Public License  as published by the Free --
13-- Software Foundation;  either version 2,  or  (at your option)  any later --
14-- version. Gnat2xml is distributed  in the hope  that it will be useful,   --
15-- but WITHOUT ANY WARRANTY; without even the implied warranty of MER-      --
16-- CHANTABILITY or  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General  --
17-- Public License for more details. You should have received a copy of the  --
18-- GNU General Public License distributed with GNAT; see file COPYING. If   --
19-- not, write to the Free Software Foundation, 59 Temple Place Suite 330,   --
20-- Boston, MA 02111-1307, USA.                                              --
21-- The gnat2xml tool was derived from the Avatox sources.                   --
22------------------------------------------------------------------------------
23
24pragma Ada_2012;
25
26with Unchecked_Deallocation;
27with Ada.Containers.Indefinite_Vectors;
28with Ada.Strings.UTF_Encoding.Wide_Strings;
29with Ada.Strings.Wide_Fixed;
30
31with Namet;
32with GNAT.OS_Lib; use GNAT.OS_Lib;
33
34package ASIS_UL.String_Utilities is
35
36   --  String-related utilities
37
38   subtype W_Char is Wide_Character;
39   subtype W_Str is Wide_String;
40   type W_Str_Access is access all W_Str;
41   procedure Free is new Unchecked_Deallocation (W_Str, W_Str_Access);
42
43   W_NUL : constant W_Char := W_Char'Val (Character'Pos (ASCII.NUL));
44   W_LF  : constant W_Char := W_Char'Val (Character'Pos (ASCII.LF));
45   W_CR  : constant W_Char := W_Char'Val (Character'Pos (ASCII.CR));
46   W_FF  : constant W_Char := W_Char'Val (Character'Pos (ASCII.FF));
47
48   W_HT : constant W_Char := W_Char'Val (Character'Pos (ASCII.HT));
49   W_VT : constant W_Char := W_Char'Val (Character'Pos (ASCII.VT));
50
51   NL : constant W_Char := W_LF;
52   --  Character used to represent new-line in output.
53
54   function Image (X : Integer) return String;
55   --  Return X'Img without the annoying blank.
56
57   type Modular is mod 2**32;
58   function Image (X : Modular) return String;
59
60   function Capitalize (S : String) return String;
61   function Capitalize (S : W_Str) return W_Str;
62   procedure Capitalize (S : in out String);
63   procedure Capitalize (S : in out W_Str);
64   --  Capitalizes the first letter, and all letters following a
65   --  non-letter-or-digit. Converts all others to lower case.
66
67   procedure To_Lower (S : in out String);
68   procedure To_Lower (S : in out W_Str);
69   --  Same as the ones in Ada.[Wide_]Characters.Handling, except we use a
70   --  procedure to avoid inefficient secondary stack usage.
71
72   function Escape_String_Literal (S : String) return String;
73   --  Double all the double quotes
74
75   function Slide (X : String) return String;
76   function Slide (X : W_Str) return W_Str;
77   --  Return X with X'First = 1
78
79   function Find
80     (Source : Wide_String;
81      Pattern : Wide_String) return Natural is
82      (Ada.Strings.Wide_Fixed.Index (Source, Pattern));
83
84   function Has_Prefix (X, Prefix : String) return Boolean;
85   function Has_Prefix (X, Prefix : W_Str) return Boolean;
86   --  True if Prefix is at the beginning of X, case insensitive. For example,
87   --  Has_Prefix("An_Identifier", Prefix => "an_") is True.
88
89   function Has_Suffix (X, Suffix : String) return Boolean;
90   function Has_Suffix (X, Suffix : W_Str) return Boolean;
91   --  True if Suffix is at the end of X, case insensitive
92
93   function Strip_Prefix (X, Prefix : String) return String;
94   function Strip_Prefix (X, Prefix : W_Str) return W_Str;
95   --  If Prefix is at the beginning of X (case insensitive), strip it off
96
97   function Strip_Suffix (X, Suffix : String) return String;
98   function Strip_Suffix (X, Suffix : W_Str) return W_Str;
99   --  If Suffix is at the end of X (case insensitive), strip it off
100
101   function Strip_Article (S : String) return String;
102   function Strip_Article (S : W_Str) return W_Str;
103   --  Removes a leading "A_" or "An_" from the string. Case insensitive.
104
105   function Replace_All (S, From, To : W_Str) return W_Str;
106   function Replace_All
107     (S        : W_Str_Access;
108      From, To : W_Str)
109      return     W_Str_Access;
110   --  Replaces all occurrences of From in S with To. In the second form, S is
111   --  freed.
112
113   function Must_Replace (S, From, To : W_Str) return W_Str;
114   function Must_Replace
115     (S        : W_Str_Access;
116      From, To : W_Str)
117      return     W_Str_Access;
118   --  Same as Replace_All, except these require that at least one substring be
119   --  replaced.
120
121   function Replace_String (S, From, To : String) return String;
122   --  Same as Replace_All, but for String
123
124   subtype Digit is Integer range 0 .. 9;
125   function Char_To_Digit (C : Character) return Digit;
126   function Char_To_Digit (C : W_Char) return Digit;
127   --  Converts '0' ==> 0, etc
128
129   BOM_8 : constant Ada.Strings.UTF_Encoding.UTF_8_String :=
130     Ada.Strings.UTF_Encoding.BOM_8;
131
132   function To_UTF8
133     (Item       : W_Str;
134      Output_BOM : Boolean := False)
135      return       Ada.Strings.UTF_Encoding.UTF_8_String renames
136     Ada.Strings.UTF_Encoding.Wide_Strings.Encode;
137
138   function From_UTF8
139     (Item : Ada.Strings.UTF_Encoding.UTF_8_String)
140      return W_Str renames
141     Ada.Strings.UTF_Encoding.Wide_Strings.Decode;
142
143   function W_Name_Find
144     (S    : W_Str)
145      return Namet.Name_Id is
146     (Namet.Name_Find (To_UTF8 (S)));
147   --  Wrapper for Namet.Name_Find
148
149   function Get_Name_String
150     (Id   : Namet.Name_Id)
151      return W_Str is
152     (From_UTF8 (Namet.Get_Name_String (Id)));
153
154   procedure Wide_Text_IO_Put_Char (C : Character);
155   procedure Wide_Text_IO_Put_Char (C : W_Char);
156   --  Put C to Current_Output. Used to instantiate Formatted_Output.
157
158   procedure Std_Err_Put_Char (C : Character);
159   --  Put C to Standard_Error. Used to instantiate Dbg_Out.
160
161   function Read_File (FD : File_Descriptor) return String_Access;
162   function Read_File (File_Name : String) return String_Access;
163   --  Reads the entire contents of the file
164
165   procedure Parallel_Make_Dir
166     (New_Directory : String; Give_Message : Boolean := False);
167   --  Creates a new directory with the given name if it does not already
168   --  exist, creating parent directories as necessary. This is safe for
169   --  parallel processing in the following sense: if two or more processes try
170   --  to create the same directory name at the same time, the directory will
171   --  be created (once), and no exception will be raised. We use this in case
172   --  an ASIS tool is called from gprbuild in parallel using the -j switch.
173   --  If Give_Message is True and the directory is successfully created, a
174   --  message saying so is printed.
175
176   procedure Move_File (Old_Name : String; New_Name : String);
177   --  Same as GNAT.OS_Lib.Rename_File, but overwrites New_Name if it already
178   --  exists.
179
180   package String_Vectors is
181      new Ada.Containers.Indefinite_Vectors (Positive, String);
182   subtype String_Vector is String_Vectors.Vector;
183   use String_Vectors;
184
185   ---------------------
186   -- Bounded Strings --
187   ---------------------
188
189   --  Ada.Strings.Bounded_Strings is too much hassle; we use a simple
190   --  bounded string type here.
191
192   type Bounded_Str (Max_Length : Natural) is limited record
193      Length : Natural := 0;
194      Chars  : String (1 .. Max_Length);
195   end record;
196
197   procedure Append (X : in out Bounded_Str; C : Character);
198   procedure Append (X : in out Bounded_Str; S : String);
199   function To_String (X : Bounded_Str) return String;
200   function "+" (X : Bounded_Str) return String renames To_String;
201
202   type Bounded_W_Str (Max_Length : Natural) is limited record
203      Length : Natural := 0;
204      Chars  : W_Str (1 .. Max_Length);
205   end record;
206
207   procedure Append (X : in out Bounded_W_Str; C : W_Char);
208   procedure Append (X : in out Bounded_W_Str; S : W_Str);
209   function To_String (X : Bounded_W_Str) return W_Str;
210   function "+" (X : Bounded_W_Str) return W_Str renames To_String;
211
212end ASIS_UL.String_Utilities;
213