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