-------------------------------------------------------------------------------
--
--  This file is part of AdaBrowse.
--
-- <STRONG>Copyright (c) 2002 by Thomas Wolf.</STRONG>
-- <BLOCKQUOTE>
--    AdaBrowse 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, or (at your option) any
--    later version. AdaBrowse is distributed in the hope that it will be
--    useful, but <EM>without any warranty</EM>; without even the implied
--    warranty of <EM>merchantability or fitness for a particular purpose.</EM>
--    See the GNU General Public License for  more details. You should have
--    received a copy of the GNU General Public License with this distribution,
--    see file "<A HREF="GPL.txt">GPL.txt</A>". If not, write to the Free
--    Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307,
--    USA.
-- </BLOCKQUOTE>
--
-- <DL><DT><STRONG>
-- Author:</STRONG><DD>
--   Thomas Wolf  (TW)
--   <ADDRESS><A HREF="mailto:twolf@acm.org">twolf@acm.org</A></ADDRESS></DL>
--
-- <DL><DT><STRONG>
-- Purpose:</STRONG><DD>
--   Configuration file management.</DL>
--
-- <!--
-- Revision History
--
--   05-FEB-2002   TW  Created from stuff that had piled up in AD.HTML.
--   18-FEB-2002   TW  'Configure' now skips empty lines.
--   22-FEB-2002   TW  'Configure' now skips any non-empty lines that start
--                     with '#': this allows comments in configuration files.
--                     Also improved some error messages.
--   12-MAR-2002   TW  Uses Util.Files.Text_IO.Next_Line now to read the
--                     configuration file.
--   13-MAR-2002   TW  Added key 'Index_XRef'.
--   14-MAR-2002   TW  Added key 'Index_Title'.
--   02-MAY-2002   TW  Added key 'Include_File', rewrote 'Configure' to do file
--                     inclusion and check for recursive inclusions.
--   24-JUN-2002   TW  Changed to use new package 'Util.Files.Config'.
--   28-JUN-2002   TW  Unquotes now the compile command and index titles.
--   03-JUL-2002   TW  Handled the case-sensitivity bug for the "Path." keys
--                     at the source: I mistakenly used 'Key' instead of 'K'.
--   04-JUN-2002   TW  Added "include" and "xref" keys.
--   08-JUN-2003   TW  Added 'Full_Name' to 'Set_File_Name'.
--   02-JUL-2003   TW  Added support for the "index" and "rule" keys.
--   18-NOV-2003   TW  Use AD.Environment.Get to make sure to account for -X
--                     options...
-- -->
-------------------------------------------------------------------------------

pragma License (GPL);

with Ada.Exceptions;
with Ada.Strings.Maps;
with Ada.Strings.Unbounded;
with Ada.Unchecked_Deallocation;

with AD.Compiler;
with AD.Crossrefs;
with AD.Descriptions;
with AD.Environment;
with AD.Exclusions;
with AD.Expressions;
with AD.Filters;
with AD.Format;
with AD.Indices.Configuration;
with AD.HTML.Pathes;
with AD.Messages;
with AD.Printers.HTML;
with AD.User_Tags;

with Util.Environment.Bash;
with Util.Files.Config;
with Util.Pathes;
with Util.Strings;

package body AD.Config is

   package ASU renames Ada.Strings.Unbounded;

   use AD.HTML;

   use Util.Strings;

   procedure Deallocate is
      new Ada.Unchecked_Deallocation (String, ASU.String_Access);

   Reorder          : constant Boolean := True;

   Config_Files     : ASU.Unbounded_String;
   Nof_Config_Files : Natural := 0;

   function Get_Nof_Config_Files
     return Natural
   is
   begin
      return Nof_Config_Files;
   end Get_Nof_Config_Files;

   function Get_Config_Files
     return String
   is
   begin
      return ASU.To_String (Config_Files);
   end Get_Config_Files;

   function Get_Reorder
     return Boolean
   is
   begin
      return Reorder;
   end Get_Reorder;

   ----------------------------------------------------------------------------

   type Add_Procedure is access procedure (Key : in String);

   ----------------------------------------------------------------------------

   type Environment_Expander is
     new Util.Environment.Bash.Bash_Expander with
      record
         File_Name : ASU.String_Access;
      end record;

   function Legal_Name
     (Self   : access Environment_Expander;
      Source : in     String)
     return Natural;

   function Get
     (Self : access Environment_Expander;
      Name : in     String)
     return String;

   function Legal_Name
     (Self   : access Environment_Expander;
      Source : in     String)
     return Natural
   is
   begin
      if Source'Last >= Source'First and then
         (Source (Source'First) = '@' or else Source (Source'First) = '$')
      then
         return Source'First;
      end if;
      --  Super call:
      return Util.Environment.Bash.Legal_Name
               (Util.Environment.Bash.Bash_Expander (Self.all)'Access,
                Source);
   end Legal_Name;

   function Get
     (Self : access Environment_Expander;
      Name : in     String)
     return String
   is
   begin
      if Name = "$" then
         return Util.Pathes.Name (Self.File_Name.all);
      elsif Name = "@" then
         return Util.Pathes.Normalize (Util.Pathes.Path (Self.File_Name.all));
      end if;
      return AD.Environment.Get (Name);
      --  Super call:
      --  return Util.Environment.Bash.Get
      --           (Util.Environment.Bash.Bash_Expander (Self.all)'Access,
      --            Name);
   end Get;

   ----------------------------------------------------------------------------

   type Reader (Expander : access Environment_Expander) is
     new Util.Files.Config.Reader with null record;

   procedure Set_File_Name
     (Self      : in out Reader;
      Name      : in     String;
      Full_Name : in     String);

   function Delimiters
     (Self : in Reader)
     return Ada.Strings.Maps.Character_Set;

   function Skip_String
     (Self  : in Reader;
      Line  : in String;
      Delim : in Character)
     return Natural;

   function Parse_Key
     (Self : in Reader;
      Line : in String)
     return Natural;

   procedure New_Key
     (Self     : in out Reader;
      Key      : in     String;
      Operator : in     String;
      Value    : in     String);

   procedure Set_File_Name
     (Self      : in out Reader;
      Name      : in     String;
      Full_Name : in     String)
   is
      pragma Warnings (Off, Self); --  silence -gnatwa
   begin
      if Nof_Config_Files = 0 then
         Config_Files := ASU.To_Unbounded_String (Name);
      else
         ASU.Append (Config_Files, ", " & Name);
      end if;
      Nof_Config_Files := Nof_Config_Files + 1;
      Self.Expander.File_Name := new String'(Full_Name);
   end Set_File_Name;

   function Delimiters
     (Self : in Reader)
     return Ada.Strings.Maps.Character_Set
   is
      pragma Warnings (Off, Self); --  silence -gnatwa
   begin
      return Util.Strings.Shell_Quotes;
   end Delimiters;

   function Skip_String
     (Self  : in Reader;
      Line  : in String;
      Delim : in Character)
     return Natural
   is
      pragma Warnings (Off, Self); --  silence -gnatwa
   begin
      --  Ada format: enclosed delimiters must be doubled.
      return Util.Strings.Skip_String (Line, Delim, Delim);
   end Skip_String;

   function Parse_Key
     (Self : in Reader;
      Line : in String)
     return Natural
   is
      I : Natural;
   begin
      I := Util.Files.Config.Parse_Key (Util.Files.Config.Reader (Self), Line);
      --  "Format." key may be followed by a string!
      if I > 0 and then I + 1 < Line'Last then
         if Line (I + 1) = '.' and then
            Is_In (String_Quotes, Line (I + 2)) and then
            To_Lower (Line (Line'First .. I + 1)) = "format."
         then
            --  Last component may be a string!
            I := Skip_String (Self, Line (I + 2 .. Line'Last), Line (I + 2));
            if I = 0 then
               Ada.Exceptions.Raise_Exception
                 (Invalid_Config'Identity,
                  "unterminated string found");
            end if;
         end if;
      end if;
      return I;
   end Parse_Key;

   procedure New_Key
     (Self     : in out Reader;
      Key      : in     String;
      Operator : in     String;
      Value    : in     String)
   is

      pragma Warnings (Off, Operator); --  silence -gnatwa

      procedure Parse_List
        (Add   : in Add_Procedure;
         Value : in String)
      is
         I, J : Natural;
      begin
         I := Value'First;
         while I <= Value'Last loop
            J := Index (Value (I .. Value'Last), ',');
            if J = 0 then J := Value'Last + 1; end if;
            declare
               Prefix : constant String := Trim (Value (I .. J - 1));
            begin
               if Prefix'Last >= Prefix'First then
                  Add (To_Lower (Prefix));
               end if;
            end;
            I := J + 1;
         end loop;
      end Parse_List;

      function Read_Bool
        (Str : in String)
        return Boolean
      is
      begin
         return Boolean'Value (To_Upper (Str));
      exception
         when others =>
            Ada.Exceptions.Raise_Exception
              (Invalid_Config'Identity,
               "value must be either 'True' or 'False'");
            return False;
      end Read_Bool;

      K   : constant String := To_Lower (Key);

   begin --  New_Key
      if K = "include_file" then
         --  Recursive include of a configuration file.
         declare
            use type ASU.String_Access;
            Old_File : constant ASU.String_Access := Self.Expander.File_Name;
            Name     : constant String :=
              Expand (Self.Expander, Value);
         begin
            --  Note: expansion still uses the old file name!
            if Name'Last >= Name'First then
               Util.Files.Config.Read (Name, Self);
               if Self.Expander.File_Name /= Old_File then
                  Deallocate (Self.Expander.File_Name);
                  Self.Expander.File_Name := Old_File;
               end if;
            end if;
         exception
            when others =>
               if Self.Expander.File_Name /= Old_File then
                  Deallocate (Self.Expander.File_Name);
                  Self.Expander.File_Name := Old_File;
               end if;
               raise;
         end;
      elsif K = "refs_to_standard" then
         AD.Crossrefs.Set_Standard_Units (Read_Bool (Value));
      elsif K = "compile" then
         AD.Compiler.Set_Compile_Command
             (Expand (Self.Expander, Unquote_All (Value, Shell_Quotes)));
      elsif K = "index_title" then
         AD.Indices.Configuration.Set_Title
           (AD.Indices.Configuration.Unit_Index, Value);
      elsif K = "index_xref" then
         AD.Printers.HTML.Set_Index_XRef (Value);
      elsif K = "char_set" then
         Set_Char_Set (Value);
      elsif K = "style_sheet" then
         Set_Style_Sheet (Expand (Self.Expander, Value));
      elsif K = "body" then
         Set_Body (Value);
      elsif K = "title.before" then
         Set_Title (Before, Value);
      elsif K = "title.after" then
         Set_Title (After, Value);
      elsif K = "sub_title.before" then
         Set_Subtitle (Before, Value);
      elsif K = "sub_title.after" then
         Set_Subtitle (After, Value);
      elsif K = "keyword.before" then
         Set_Keyword (Before, Value);
      elsif K = "keyword.after" then
         Set_Keyword (After, Value);
      elsif K = "attribute.before" then
         Set_Attribute (Before, Value);
      elsif K = "attribute.after" then
         Set_Attribute (After, Value);
      elsif K = "definition.before" then
         Set_Definition (Before, Value);
      elsif K = "definition.after" then
         Set_Definition (After, Value);
      elsif K = "comment.before" then
         Set_Comment (Before, Value);
      elsif K = "comment.after" then
         Set_Comment (After, Value);
      elsif K = "literal.before" then
         Set_Literal (Before, Value);
      elsif K = "literal.after" then
         Set_Literal (After, Value);
      elsif K = "no_xref" then
         Parse_List (AD.Exclusions.Add_No_XRef'Access, Value);
      elsif K = "xref" then
         Parse_List (AD.Exclusions.Add_No_XRef_Exception'Access, Value);
      elsif K = "exclude" then
         if Value'Last < Value'First then
            AD.Exclusions.Clear_Exclusions;
         else
            Parse_List (AD.Exclusions.Add_Exclusion'Access, Value);
         end if;
      elsif K = "include" then
         if Value'Last < Value'First then
            AD.Exclusions.Clear_Exclusion_Exceptions;
         else
            Parse_List (AD.Exclusions.Add_Exclusion_Exception'Access, Value);
         end if;
      elsif Is_Prefix (K, "path.") then
         if K'Length > 5 then
            AD.HTML.Pathes.Add_Path
              (K (K'First + 5 .. K'Last), Expand (Self.Expander, Value));
         else
            Ada.Exceptions.Raise_Exception
              (Invalid_Config'Identity, ''' & Key & "' is an invalid key.");
         end if;
      elsif Is_Prefix (K, "description.") then
         AD.Descriptions.Parse (K (K'First + 12 .. K'Last), Value);
      elsif Is_Prefix (K, "index_title.") then
         declare
            use AD.Indices.Configuration;
            Idx : Index_Type;
         begin
            begin
               Idx := Index_Type'Value (To_Upper (K (K'First + 12 .. K'Last)));
            exception
               when others =>
                  Ada.Exceptions.Raise_Exception
                    (Invalid_Config'Identity,
                     ''' & Key & "' is an invalid key.");
            end;
            AD.Indices.Configuration.Set_Title
              (Idx, Unquote_All (Value, Shell_Quotes));
         end;
      elsif Is_Prefix (K, "user_tag.") then
         begin
            AD.User_Tags.Parse_Tag
              (K (K'First + 9 .. K'Last), Value, Self.Expander);
         exception
            when E : AD.User_Tags.Invalid_Tag =>
               Ada.Exceptions.Raise_Exception
                 (Invalid_Config'Identity,
                  Ada.Exceptions.Exception_Message (E));
         end;
      elsif Is_Prefix (K, "format.") then
         declare
            A, B : Natural := 0;
         begin
            --  Use 'Key' here, for the string must be case sensitive!!
            if Key'Length > 8 then
               if Is_In (String_Quotes, Key (Key'First + 7)) then
                  A := Key'First + 7;
                  B := Skip_String
                         (Self, Key (Key'First + 7 .. Key'Last),
                          Key (Key'First + 7));
               end if;
            end if;
            if A = 0 then
               Ada.Exceptions.Raise_Exception
                 (Invalid_Config'Identity,
                  "'Format.' must be followed by a string");
            elsif B = 0 then
               Ada.Exceptions.Raise_Exception
                 (Invalid_Config'Identity,
                  "Unterminated string after 'Format.'");
            end if;
            if not Is_Prefix (Key (A + 1 .. B - 1), "--") then
               Ada.Exceptions.Raise_Exception
                 (Invalid_Config'Identity,
                  "Format comment prefix must start with ""--""");
            end if;
            begin
               AD.Format.Enter
                 (Unquote (Key (A + 1 .. B - 1), Key (A), Key (A)),
                  AD.Filters.Parse (Expand (Self.Expander, Value)));
            exception
               when E : AD.Filters.Parse_Error =>
                  Ada.Exceptions.Raise_Exception
                    (Invalid_Config'Identity,
                     Ada.Exceptions.Exception_Message (E));
            end;
         end;
      elsif Is_Prefix (K, "rule.") then
         --  Must be followed by an identifier.
         declare
            I : constant Natural := Identifier (K (K'First + 5 .. K'Last));
         begin
            if I = 0 then
               Ada.Exceptions.Raise_Exception
                 (Invalid_Config'Identity,
                  "'Rule.' must be followed by an identifier");
            elsif I /= K'Last then
               Ada.Exceptions.Raise_Exception
                 (Invalid_Config'Identity,
                  "Key must have the form 'Rule.<Identifier>'");
            end if;
         end;
         declare
            Expr      : AD.Expressions.Expression;
            Redefined : Boolean;
         begin
            Expr := AD.Expressions.Parse (Value);
            AD.Expressions.Define_Macro
              (Key (Key'First + 5 .. Key'Last), Expr, Redefined);
            if Redefined then
               AD.Messages.Info
                 (Key & " redefined in " & Self.Expander.File_Name.all);
            end if;
         exception
            when E : AD.Expressions.Parse_Error =>
               Ada.Exceptions.Raise_Exception
                 (Invalid_Config'Identity,
                  Ada.Exceptions.Exception_Message (E));
         end;
      elsif Is_Prefix (K, "index.") then
         AD.Indices.Configuration.Parse
           (Key (Key'First + 6 .. Key'Last), Expand (Self.Expander, Value));
      else
         Ada.Exceptions.Raise_Exception
           (Invalid_Config'Identity, "unknown key '" & Key & ''');
      end if;
   end New_Key;

   ----------------------------------------------------------------------------

   procedure Configure
     (File_Name : in String)
   is

      Expander : aliased Environment_Expander;
      Parser   : Reader (Expander'Access);

   begin
      Util.Files.Config.Read (File_Name, Parser);
      Deallocate (Expander.File_Name);
   exception
      when E : others =>
         Deallocate (Expander.File_Name);
         Ada.Exceptions.Raise_Exception
           (Invalid_Config'Identity,
            Ada.Exceptions.Exception_Message (E));
   end Configure;

end AD.Config;
