File : src/templates_parser.ads


------------------------------------------------------------------------------
--                             Templates Parser                             --
--                                                                          --
--                        Copyright (C) 1999 - 2003                         --
--                               Pascal Obry                                --
--                                                                          --
--  This library is free software; you can redistribute it and/or modify    --
--  it under the terms of the GNU General Public License as published by    --
--  the Free Software Foundation; either version 2 of the License, 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              --
--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU       --
--  General Public License for more details.                                --
--                                                                          --
--  You should have received a copy of the GNU General Public License       --
--  along with this library; if not, write to the Free Software Foundation, --
--  Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.          --
--                                                                          --
--  As a special exception, if other files instantiate generics from this   --
--  unit, or you link this unit with other files to produce an executable,  --
--  this  unit  does not  by itself cause  the resulting executable to be   --
--  covered by the GNU General Public License. This exception does not      --
--  however invalidate any other reasons why the executable file  might be  --
--  covered by the  GNU Public License.                                     --
------------------------------------------------------------------------------

--  $Id: templates_parser.ads,v 1.1 2004/01/27 17:33:42 obry Exp $

with Ada.Finalization;
with Ada.Strings.Unbounded;

package Templates_Parser is

   use Ada.Strings.Unbounded;

   Template_Error : exception;

   Default_Begin_Tag : constant String := "@_";
   Default_End_Tag   : constant String := "_@";

   Default_Separator : constant String := ", ";

   procedure Set_Tag_Separators
     (Start_With : in String := Default_Begin_Tag;
      Stop_With  : in String := Default_End_Tag);
   --  Set the tag separators for the whole session. This should be changed as
   --  the very first API call and should not be changed after.

   ----------------
   -- Vector Tag --
   ----------------

   type Vector_Tag is private;
   --  A vector tag is a set of strings. Note that this object is using a
   --  by-reference semantic. A reference counter is associated to it and
   --  the memory is realeased when there is no more reference to it.

   function "+" (Value : in String) return Vector_Tag;
   --  Vector_Tag constructor.

   function "+" (Value : in Character) return Vector_Tag;
   --  Vector_Tag constructor.

   function "+" (Value : in Boolean) return Vector_Tag;
   --  Vector_Tag constructor.

   function "+" (Value : in Unbounded_String) return Vector_Tag;
   --  Vector_Tag constructor.

   function "+" (Value : in Integer) return Vector_Tag;
   --  Vector_Tag constructor.

   function "&"
     (Vect  : in Vector_Tag;
      Value : in String)
      return Vector_Tag;
   --  Add Value at the end of the vector tag set.

   function "&"
     (Value : in String;
      Vect  : in Vector_Tag)
      return Vector_Tag;
   --  Same as above but add Value in front of the vector tag

   function "&"
     (Vect  : in Vector_Tag;
      Value : in Character)
      return Vector_Tag;
   --  Add Value at the end of the vector tag set.

   function "&"
     (Value : in Character;
      Vect  : in Vector_Tag)
      return Vector_Tag;
   --  Same as above but add Value in front of the vector tag

   function "&"
     (Vect  : in Vector_Tag;
      Value : in Boolean)
      return Vector_Tag;
   --  Add Value (either string TRUE or FALSE) at the end of the vector tag
   --  set.

   function "&"
     (Value : in Boolean;
      Vect  : in Vector_Tag)
      return Vector_Tag;
   --  Same as above but add Value in front of the vector tag

   function "&"
     (Vect  : in Vector_Tag;
      Value : in Unbounded_String)
      return Vector_Tag;
   --  Add Value at the end of the vector tag set.

   function "&"
     (Value : in Unbounded_String;
      Vect  : in Vector_Tag)
      return Vector_Tag;
   --  Same as above but add Value in front of the vector tag

   function "&"
     (Vect  : in Vector_Tag;
      Value : in Integer)
      return Vector_Tag;
   --  Add Value (converted to a String) at the end of the vector tag set.

   function "&"
     (Value : in Integer;
      Vect  : in Vector_Tag)
      return Vector_Tag;
   --  Same as above but add Value in front of the vector tag

   procedure Clear (Vect : in out Vector_Tag);
   --  Removes all values in the vector tag. Current Vect is not released but
   --  the returned object is separated (not using the same reference) from
   --  the original one.

   function Size (Vect : in Vector_Tag) return Natural;
   --  Returns the number of value into Vect.

   function Item (Vect : in Vector_Tag; N : in Positive) return String;
   --  Returns the Nth Vector Tag's item. Raises Constraint_Error if there is
   --  no such Item in the vector (i.e. vector length < N).

   ----------------
   -- Matrix Tag --
   ----------------

   type Matrix_Tag is private;
   --  A matrix tag is a set of vectors. Note that this object is using a
   --  by-reference semantic. A reference counter is associated to it and
   --  the memory is realeased when there is no more reference to it.

   function "+" (Vect : in Vector_Tag) return Matrix_Tag;
   --  Matrix_Tag constructor. It returns a matrix with a single row whose
   --  value is Vect.

   function "&"
     (Matrix : in Matrix_Tag;
      Vect   : in Vector_Tag)
      return Matrix_Tag;
   --  Returns Matrix with Vect added to the end.

   function Size (Matrix : in Matrix_Tag) return Natural;
   --  Returns the number of Vector_Tag (rows) inside the Matrix.

   function Vector (Matrix : in Matrix_Tag; N : in Positive) return Vector_Tag;
   --  Returns Nth Vector_Tag in the Matrix. Raises Constraint_Error if there
   --  is no such vector in the matrix.

   -----------------------
   -- Association table --
   -----------------------

   type Association is private;

   type Association_Kind is (Std, Vect, Matrix);
   --  The kind of association which is either Std (a simple value), a vector
   --  tag or a Matrix tag.

   type Translate_Table is array (Positive range <>) of Association;

   No_Translation : constant Translate_Table;

   function Assoc
     (Variable  : in String;
      Value     : in String)
      return Association;
   --  Build an Association (Variable = Value) to be added to a
   --  Translate_Table. This is a standard association, value is a string.

   function Assoc
     (Variable  : in String;
      Value     : in Unbounded_String)
      return Association;
   --  Build an Association (Variable = Value) to be added to a
   --  Translate_Table. This is a standard association, value is an
   --  Unbounded_String.

   function Assoc
     (Variable  : in String;
      Value     : in Integer)
      return Association;
   --  Build an Association (Variable = Value) to be added to a
   --  Translate_Table. This is a standard association, value is an Integer.
   --  It will be displayed without leading space if positive.

   function Assoc
     (Variable  : in String;
      Value     : in Boolean)
      return Association;
   --  Build an Association (Variable = Value) to be added to a
   --  Translate_Table. It set the variable to TRUE or FALSE depending on
   --  value.

   function Assoc
     (Variable  : in String;
      Value     : in Vector_Tag;
      Separator : in String     := Default_Separator)
      return Association;
   --  Build an Association (Variable = Value) to be added to a
   --  Translate_Table. This is a vector tag association, value is a
   --  Vector_Tag. If the vector tag is found outside a table tag statement
   --  it is returned as a single string, each value being separated by the
   --  specified separator.

   function Assoc
     (Variable  : in String;
      Value     : in Matrix_Tag;
      Separator : in String     := Default_Separator)
      return Association;
   --  Build an Association (Variable = Value) to be added to a
   --  Translate_Table. This is a matrix tag association, value is a
   --  Matrix_Tag. If the matrix tag is found outside of a 2nd level table tag
   --  statement, Separator is used to build string representation of the
   --  matrix tag's vectors.

   -----------------------------
   -- Parsing and Translating --
   -----------------------------

   function Parse
     (Filename          : in String;
      Translations      : in Translate_Table := No_Translation;
      Cached            : in Boolean         := False;
      Keep_Unknown_Tags : in Boolean         := False)
      return String;
   --  Parse the Template_File replacing variables' occurrences by the
   --  corresponding values. If Cached is set to True, Filename tree will be
   --  recorded into a cache for quick retrieval. If Keep_Unknown_Tags is set
   --  to True then tags that are not in the translate table are kept
   --  as-is if it is part of the template data. If this tags is part of a
   --  condition (in an IF statement tag), the condition will evaluate to
   --  False.

   function Parse
     (Filename          : in String;
      Translations      : in Translate_Table := No_Translation;
      Cached            : in Boolean         := False;
      Keep_Unknown_Tags : in Boolean         := False)
      return Unbounded_String;
   --  Idem as above but returns an Unbounded_String.

   function Translate
     (Template     : in String;
      Translations : in Translate_Table := No_Translation)
      return String;
   --  Just translate the discrete variables in the Template string using the
   --  Translations table. This function does not parse the command tag
   --  (TABLE, IF, INCLUDE). All Vector and Matrix tag are replaced by the
   --  empty string.

   procedure Print_Tree (Filename : in String);
   --  Use for debugging purpose only, it will output the internal tree
   --  representation.

private

   ------------------
   --  Vector Tags --
   ------------------

   type Vector_Tag_Node;
   type Vector_Tag_Node_Access is access Vector_Tag_Node;

   type Vector_Tag_Node is record
      Value : Unbounded_String;
      Next  : Vector_Tag_Node_Access;
   end record;

   type Integer_Access is access Integer;

   type Access_Vector_Tag_Node_Access is access Vector_Tag_Node_Access;

   type Vector_Tag is new Ada.Finalization.Controlled with record
      Ref_Count : Integer_Access;
      Count     : Natural;
      Head      : Vector_Tag_Node_Access;
      Last      : Vector_Tag_Node_Access;
      Current   : Access_Vector_Tag_Node_Access; -- Current/Pos are Iterator
      Pos       : Integer_Access;                -- cache information.
   end record;

   type Vector_Tag_Access is access Vector_Tag;

   procedure Initialize (V : in out Vector_Tag);
   procedure Finalize   (V : in out Vector_Tag);
   procedure Adjust     (V : in out Vector_Tag);

   ------------------
   --  Matrix Tags --
   ------------------

   type Matrix_Tag_Node;

   type Matrix_Tag_Node_Access is access Matrix_Tag_Node;

   type Matrix_Tag_Node is record
      Vect : Vector_Tag;
      Next : Matrix_Tag_Node_Access;
   end record;

   type Access_Matrix_Tag_Node_Access is access Matrix_Tag_Node_Access;

   type Matrix_Tag_Int is new Ada.Finalization.Controlled with record
      Ref_Count : Integer_Access;
      Count     : Natural; -- Number of vector
      Min, Max  : Natural; -- Min/Max vector's sizes
      Head      : Matrix_Tag_Node_Access;
      Last      : Matrix_Tag_Node_Access;
      Current   : Access_Matrix_Tag_Node_Access; -- Current/Pos are Iterator
      Pos       : Integer_Access;                -- cahce information.
   end record;

   type Matrix_Tag is record
      M : Matrix_Tag_Int;
   end record;

   procedure Initialize (M : in out Matrix_Tag_Int);
   procedure Finalize   (M : in out Matrix_Tag_Int);
   procedure Adjust     (M : in out Matrix_Tag_Int);

   ------------------
   --  Association --
   ------------------

   type Association (Kind : Association_Kind := Std) is record
      Variable  : Unbounded_String;

      case Kind is
         when Std =>
            Value : Unbounded_String;

         when Vect =>
            Vect_Value : Vector_Tag;
            Separator  : Unbounded_String;

         when Matrix =>
            Mat_Value        : Matrix_Tag;
            Column_Separator : Unbounded_String;
      end case;
   end record;

   No_Translation : constant Translate_Table
     := (2 .. 1 => Association'(Std,
                                Null_Unbounded_String,
                                Null_Unbounded_String));

end Templates_Parser;