------------------------------------------------------------------------------ -- G N A T C O L L -- -- -- -- Copyright (C) 2008-2018, 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 -- -- . -- -- -- ------------------------------------------------------------------------------ with Ada.Characters.Handling; use Ada.Characters.Handling; with Ada.Strings.Unbounded; use Ada.Strings.Unbounded; with GNAT.Strings; use GNAT.Strings; package body GNATCOLL.Templates is procedure Find_Identifier (Str : String; Delimiter : Character; First : in out Integer; Last : out Integer; First_After : out Integer); -- Set Last to the last character of the identifier name. -- First should point to the first candidate character, but could be -- moved forward if it points to a curly brace. ---------- -- Free -- ---------- procedure Free (Substrings : in out Substitution_Array) is begin for S in Substrings'Range loop Free (Substrings (S).Name); Free (Substrings (S).Value); end loop; end Free; --------------------- -- Find_Identifier -- --------------------- procedure Find_Identifier (Str : String; Delimiter : Character; First : in out Integer; Last : out Integer; First_After : out Integer) is begin if Str (First) = Delimiter then -- We are escaping the delimiter by doubling it Last := First; First_After := First + 1; elsif Str (First) = '{' then First := First + 1; Last := First; while Last <= Str'Last and then Str (Last) /= '}' loop Last := Last + 1; end loop; First_After := Last + 1; Last := Last - 1; elsif Str (First) = '(' then First := First + 1; Last := First; while Last <= Str'Last and then Str (Last) /= ')' loop Last := Last + 1; end loop; First_After := Last + 1; Last := Last - 1; elsif Is_Digit (Str (First)) then Last := First + 1; while Last <= Str'Last and then Is_Digit (Str (Last)) loop Last := Last + 1; end loop; if Last <= Str'Last and then Str (Last) = '-' then Last := Last + 1; end if; First_After := Last; Last := Last - 1; elsif Is_Alphanumeric (Str (First)) then Last := First + 1; while Last <= Str'Last and then (Is_Alphanumeric (Str (Last)) or else Str (Last) = '_') loop Last := Last + 1; end loop; First_After := Last; Last := Last - 1; else Last := First; First_After := Last + 1; end if; end Find_Identifier; ---------------- -- Substitute -- ---------------- function Substitute (Str : String; Substrings : Substitution_Array := No_Substitution; Callback : Substitute_Callback := null; Delimiter : Character := Default_Delimiter; Recursive : Boolean := False; Errors : Error_Handling := Keep_As_Is) return String is Result : Unbounded_String; First, Last : Natural := Str'First; Found : Boolean; Identifier_First, Identifier_Last, First_After : Natural; Quoted : Boolean := False; begin while First <= Str'Last loop Last := First; -- Skip constant substrings while Last <= Str'Last and then Str (Last) /= Delimiter loop if Str (Last) = '"' then Quoted := not Quoted; end if; Last := Last + 1; end loop; if Last = Str'Last then Last := Last + 1; end if; Append (Result, Str (First .. Last - 1)); exit when Last > Str'Last; -- Find name of identifier First := Last + 1; Identifier_First := First; Find_Identifier (Str, Delimiter, Identifier_First, Last, First_After); -- Does the identifier contain a default value? Identifier_Last := Last; for D in Identifier_First .. Identifier_Last - 1 loop if Str (D) = ':' and then Str (D + 1) = '-' then Identifier_Last := D - 1; exit; end if; end loop; Found := False; for S in Substrings'Range loop if Substrings (S).Name.all = Str (Identifier_First .. Identifier_Last) then if Recursive then Append (Result, Substitute (Str => Substrings (S).Value.all, Substrings => Substrings, Callback => Callback, Delimiter => Delimiter, Recursive => Recursive)); else Append (Result, Substrings (S).Value.all); end if; Found := True; exit; end if; end loop; -- When doubled, the delimiter is always replaced with itself by -- default. if not Found and then Identifier_Last = Identifier_First and then Str (Identifier_First) = Delimiter then -- We are escaping the Substitution_Char by doubling it Append (Result, Delimiter); Found := True; elsif not Found and then Callback /= null then begin declare Sub : constant String := Callback (Str (Identifier_First .. Identifier_Last), Quoted); begin if Recursive then Append (Result, Substitute (Str => Sub, Substrings => Substrings, Callback => Callback, Delimiter => Delimiter, Recursive => Recursive)); else Append (Result, Sub); end if; Found := True; end; exception when Invalid_Substitution => Found := False; end; end if; -- If still not found, try the default value if it was specified if not Found and then Identifier_Last < Last then Append (Result, Str (Identifier_Last + 3 .. Last)); Found := True; end if; if not Found then case Errors is when Keep_As_Is => Append (Result, Str (First - 1 .. First_After - 1)); when Replace_With_Empty => null; when Report_Error => raise Invalid_Substitution; end case; end if; First := First_After; end loop; return To_String (Result); end Substitute; end GNATCOLL.Templates;