-------------------------------------------------------------------------------
--
--  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>
--   Abstract root type for the various output producers (HTML, XML, DocBook,
--   and so on).</DL>
--
-- <!--
-- Revision History
--
--   22-JUL-2002   TW  Initial version.
--   30-MAY-2003   TW  'Is_Private' handling in 'Open_Unit' and 'Add_Child'.
--   07-JUL-2003   TW  Rewrote the indexing stuff completely.
-- -->
-------------------------------------------------------------------------------

pragma License (GPL);

with Ada.Characters.Handling;
with Ada.Exceptions;
with Ada.Strings.Wide_Unbounded;

with AD.HTML;
with AD.Options;
with AD.Messages;
with AD.Version;

with Util.Strings;
with Util.Text.Internal;

package body AD.Printers.XML is

   package ACH  renames Ada.Characters.Handling;
   package WASU renames Ada.Strings.Wide_Unbounded;

   use Util.Strings;

   XML_Version : constant String := "1.0";
   --  Version of XML itself.

   DTD_Version : constant String := "2.0";
   --  Version of the AdaBrowse DTD we're using.

   function Dots_To_Dashes
     (S : in String)
     return String
   is
      Result : String := S;
   begin
      for I in Result'Range loop
         if Result (I) = '.' then Result (I) := '_'; end if;
      end loop;
      return Result;
   end Dots_To_Dashes;

   function Quot (S : in String) return String
   is
   begin
      --  It happens that HTMLize is also useable for XML output...
      return AD.HTML.HTMLize (S, Keep_Entities => False);
   end Quot;

   procedure Emit_XRef_Data
     (Self   : access Printer;
      XRef   : in     AD.Crossrefs.Cross_Reference;
      Anchor : in     Boolean := False)
   is
   begin
      --   Emit the name even for local XREFs and ANCHORs.
      Put (Self,
           " UNIT=""" &
           ACH.To_String (WASU.To_Wide_String (XRef.Full_Unit_Name)) & '"');
      Put (Self,
           " POS=""" & To_String (XRef.Position, True) & '"');
      if XRef.Is_Top_Unit then
         Put (Self, " IS_TOP=""TRUE""");
      end if;
      if XRef.Is_Local and then not Anchor then
         Put (Self, " IS_LOCAL=""TRUE""");
      end if;
   end Emit_XRef_Data;

   procedure Put_XRef
     (Self   : access Printer;
      Tag    : in     String;
      XRef   : in     AD.Crossrefs.Cross_Reference;
      Anchor : in     Boolean := False)
   is
   begin
      if not XRef.Ignore then
         Put (Self, '<' & Tag);
         Emit_XRef_Data (Self, XRef, Anchor);
         Put (Self, '>');
      end if;
      Put (Self, Quot (ACH.To_String (WASU.To_Wide_String (XRef.Image))));
      if not XRef.Ignore then
         Put (Self, "</" & Tag & '>');
      end if;
   end Put_XRef;

   procedure Indent
     (Self : access Printer)
   is
      S : constant String (1 .. 2 * Self.Indent) := (others => ' ');
   begin
      Put (Self, S);
   end Indent;

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

   function Get_Suffix
     (Self : in Printer)
     return String
   is
      pragma Warnings (Off, Self); --  silence -gnatwa
   begin
      return "xml";
   end Get_Suffix;

   procedure Finalize
     (Self : in out Printer)
   is
   begin
      if Is_Open (Self) then
         Put_Line (Self, "");
         Put_Line (Self, "</ADABROWSE>");
      end if;
      Close_File (Self);
      Finalize (Real_Printer (Self));
   end Finalize;

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

   procedure Open_Unit
     (Self       : access Printer;
      Unit_Kind  : in     Item_Kind;
      Unit_Name  : in     Wide_String;
      Is_Private : in     Boolean;
      XRef       : in     AD.Crossrefs.Cross_Reference)
   is
   begin
      if Self.Initial then
         Self.Initial := False;
         begin
            Open_File (Self.all, AD.Options.Single_File, "adabrowse");
            --  Write the header:
            declare
               Char_Set : constant String := AD.HTML.Character_Set;
            begin
               Put (Self, "<?xml version=""" & XML_Version & '"');
               if Char_Set'Length > 0 then
                  Put (Self, " encoding=""" & Char_Set & '"');
               end if;
               Put_Line (Self, "?>");
            end;
            New_Line (Self);
            Put_Line
              (Self,
               "<!DOCTYPE ADABROWSE " &
               "PUBLIC ""-//ADABROWSE//AdaBrowse DTD " &
               DTD_Version & "//EN"" """ &
               AD.Version.Get_URL & "xml/adabrowse_" &
               Dots_To_Dashes (DTD_Version) &
               ".dtd"">");
            New_Line (Self);
            Put_Line (Self,
                      "<!-- Generated by AdaBrowse " &
                      AD.Version.Get_Version & ' ' &
                      AD.Version.Get_URL & " -->");
            New_Line (Self);
            Put_Line (Self, "<ADABROWSE>");
         exception
            when E : others =>
               AD.Messages.Error (Ada.Exceptions.Exception_Message (E) &
                                  "; XML generation disabled.");
         end;
      end if;
      Self.Use_Buffer := False;
      Self.Buffer     := Util.Text.Null_Unbounded_String;
      if Is_Open (Self.all) then
         New_Line (Self);
         declare
            --  Only add the PRIVATE attribute if the unit really *is* a
            --  private unit. If it isn't, don't add it.
            function Get_Private
              (Is_Private : in Boolean)
              return String
            is
            begin
               if Is_Private then
                  return """ PRIVATE=""" & Boolean'Image (Is_Private);
               else
                  return "";
               end if;
            end Get_Private;
         begin
            Put_Line
              (Self,
               "<UNIT NAME=""" & ACH.To_String (Unit_Name) &
               """ KIND=""" & To_Upper (Item_Kind'Image (Unit_Kind)) &
               Get_Private (Is_Private) &
               """ POS=""" & To_String (XRef.Position, True) & """>");
         end;
         Self.Indent   := 1;
         Self.No_XRef  := False;
      end if;
   end Open_Unit;

   procedure Close_Unit
     (Self : access Printer)
   is
   begin
      Self.Indent := Self.Indent - 1;
      Indent (Self);
      Put_Line (Self, "</UNIT>");
      New_Line (Self);
   end Close_Unit;

   procedure Write_Comment
     (Self  : access Printer;
      Lines : in     Asis.Text.Line_List)
   is
   begin
      if Lines'Last >= Lines'First then
         Indent (Self);
         Put_Line (Self, "<BLOCK>");
         Self.Indent := Self.Indent + 1;
         for I in Lines'Range loop
            Indent (Self);
            Put_Line
              (Self,
               "<LINE>" &
               Quot
                 (Trim (ACH.To_String (Asis.Text.Comment_Image (Lines (I))))) &
               "</LINE>");
         end loop;
         Self.Indent := Self.Indent - 1;
         Indent (Self);
         Put_Line (Self, "</BLOCK>");
      end if;
   end Write_Comment;

   procedure Open_Section
     (Self    : access Printer;
      Section : in     Section_Type)
   is
      S : constant String := To_Upper (Section_Type'Image (Section));
   begin
      if Section = Index_XRef_Section then
         --  Nothing to do: XML doesn't have inter-index xrefs!
         return;
      end if;
      --  'S' ends in "_SECTION".
      Indent (Self);
      Put (Self, '<' & S (S'First .. S'Last - 8) & '>');
      case Section is
         when Exception_Rename_Section | Ultimate_Exception_Section =>
            null;
         when others =>
            New_Line (Self);
            Self.Indent := Self.Indent + 1;
      end case;
      case Section is
         when Snippet_Section |
              Header_Section |
              Footer_Section =>
            Self.Use_Buffer := True;
            Self.Buffer := Util.Text.Null_Unbounded_String;
         when others =>
            null;
      end case;
   end Open_Section;

   procedure Close_Section
     (Self    : access Printer;
      Section : in     Section_Type)
   is
   begin
      case Section is
         when Index_XRef_Section =>
            --  Nothing to do: XML doesn't have inter-index cross-refs!
            return;
         when Snippet_Section |
              Header_Section |
              Footer_Section =>
            --  Now emit the snippet as a sequence of <LINE>'s.
            Self.Use_Buffer := False;
            --  Switch off buffer usage!
            declare
               Txt   : constant Util.Text.String_Access :=
                 Util.Text.Internal.Get_Ptr (Self.Buffer);
               First : Natural := 1;
               I     : Natural := First_Index (Txt.all, ASCII.LF);
            begin
               loop
                  if I = 0 then
                     Indent (Self);
                     Put_Line
                       (Self, "<LINE>" & Txt (First .. Txt'Last) & "</LINE>");
                     exit;
                  else
                     Indent (Self);
                     Put_Line
                       (Self, "<LINE>" & Txt (First .. I - 1) & "</LINE>");
                     exit when I = Txt'Last;
                  end if;
                  First := I + 1;
                  I     := First_Index (Txt (First .. Txt'Last), ASCII.LF);
               end loop;
            end;
            Self.Buffer := Util.Text.Null_Unbounded_String;
         when others =>
            null;
      end case;
      case Section is
         when Exception_Rename_Section | Ultimate_Exception_Section =>
            null;
         when others =>
            Self.Indent := Self.Indent - 1;
            Indent (Self);
      end case;
      declare
         S : constant String := To_Upper (Section_Type'Image (Section));
      begin
         --  'S' ends in "_SECTION".
         Put_Line (Self, "</" & S (S'First .. S'Last - 8) & '>');
      end;
   end Close_Section;

   procedure Open_Item
     (Self : access Printer;
      XRef : in     AD.Crossrefs.Cross_Reference;
      Kind : in     Item_Kind   := Not_An_Item;
      Name : in     Wide_String := "")
   is
   begin
      Indent (Self);
      Put (Self, "<ITEM");
      if Name'Last >= Name'First then
         Put (Self, " NAME=""" & Quot (ACH.To_String (Name)) & '"');
      end if;
      if Kind /= Not_An_Item then
         Put (Self, " KIND=""" & To_Upper (Item_Kind'Image (Kind)) & '"');
      end if;
      if not XRef.Ignore then
         declare
            X : AD.Crossrefs.Cross_Reference := XRef;
         begin
            X.Is_Top_Unit := False; --  We never want the IS_TOP here!
            Emit_XRef_Data (Self, X, True);
         end;
      end if;
      Put_Line (Self, ">");
      Self.Indent := Self.Indent + 1;
   end Open_Item;

   procedure Close_Item
     (Self    : access Printer;
      Is_Last : in     Boolean := False)
   is
      pragma Warnings (Off, Is_Last); --  silence -gnatwa
   begin
      Self.Indent := Self.Indent - 1;
      Indent (Self);
      Put_Line (Self, "</ITEM>");
   end Close_Item;

   procedure Other_Declaration
     (Self : access Printer;
      XRef : in     AD.Crossrefs.Cross_Reference;
      Text : in     String)
   is
   begin
      if XRef.Ignore then return; end if;
      New_Line (Self);
      Put (Self, "<COMMENT>--  " & AD.HTML.HTMLize (Text) & ": ");
      Put_XRef (Self, "XREF", XRef);
      Put (Self, "</COMMENT>");
   end Other_Declaration;

   procedure Open_Container
     (Self  : access Printer;
      XRef  : in     AD.Crossrefs.Cross_Reference;
      Kind  : in     Item_Kind;
      Name  : in     Wide_String := "")
   is
   begin
      Indent (Self);
      Put (Self, "<CONTAINER");
      if Name'Last >= Name'First then
         Put (Self, " NAME=""" & Quot (ACH.To_String (Name)) & '"');
      end if;
      if Kind /= Not_An_Item then
         Put (Self, " KIND=""" & To_Upper (Item_Kind'Image (Kind)) & '"');
      end if;
      if not XRef.Ignore then
         declare
            X : AD.Crossrefs.Cross_Reference := XRef;
         begin
            X.Is_Top_Unit := False; --  We never want the IS_TOP here!
            Emit_XRef_Data (Self, X, True);
         end;
      end if;
      Put_Line (Self, ">");
      Self.Indent := Self.Indent + 1;
   end Open_Container;

   procedure Close_Container
     (Self    : access Printer;
      Is_Last : in     Boolean := False)
   is
      pragma Warnings (Off, Is_Last); --  silence -gnatwa
   begin
      Self.Indent := Self.Indent - 1;
      Indent (Self);
      Put_Line (Self, "</CONTAINER>");
   end Close_Container;

   procedure Add_Child
     (Self       : access Printer;
      Kind       : in     Item_Kind;
      Is_Private : in     Boolean;
      XRef       : in     AD.Crossrefs.Cross_Reference)
   is
   begin
      Indent (Self);
      Put (Self,
           "<CHILD NAME=""" &
           Quot (ACH.To_String (WASU.To_Wide_String (XRef.Image))) &
           '"');
      if Kind /= Not_An_Item then
         Put (Self, " KIND=""" & To_Upper (Item_Kind'Image (Kind)) & '"');
         if Is_Private then
            Put (Self, " PRIVATE=""TRUE""");
         end if;
      end if;
      Put (Self, '>');
      Put_XRef (Self, "XREF", XRef);
      Put_Line (Self,  "</CHILD>");
   end Add_Child;

   procedure Add_Exception
     (Self : access Printer;
      XRef : in     AD.Crossrefs.Cross_Reference)
   is
   begin
      Indent (Self);
      Put (Self, "<EXCEPTION_NAME>");
      Put_XRef (Self, "ANCHOR", XRef, True);
      Put (Self, "</EXCEPTION_NAME>");
      New_Line (Self);
   end Add_Exception;

   procedure Type_Name
     (Self : access Printer;
      XRef : in     AD.Crossrefs.Cross_Reference)
   is
   begin
      Indent (Self);
      Put (Self, "<TYPE_NAME>");
      Put_XRef (Self, "XREF", XRef);
      Put (Self, "</TYPE_NAME>");
      New_Line (Self);
   end Type_Name;

   procedure Type_Kind
     (Self : access Printer;
      Info : in     String)
   is
   begin
      Indent (Self);
      Put_Line (Self, "<TYPE_KIND>" & Quot (Info) & "</TYPE_KIND>");
   end Type_Kind;

   procedure Parent_Type
     (Self : access Printer;
      XRef : in     AD.Crossrefs.Cross_Reference)
   is
   begin
      Indent (Self);
      Put (Self, "<PARENT_TYPE>");
      Put_XRef (Self, "XREF", XRef);
      Put (Self, "</PARENT_TYPE>");
      New_Line (Self);
   end Parent_Type;

   procedure Open_Operation_List
     (Self : access Printer;
      Kind : in     Operation_Kind)
   is
      S : constant String := To_Upper (Operation_Kind'Image (Kind));
   begin
      --  'S' ends in "_Operation"
      Indent (Self);
      Put_Line (Self,
                "<OPLIST KIND=""" & S (S'First .. S'Last - 10) & """>");
      Self.Indent := Self.Indent + 1;
   end Open_Operation_List;

   procedure Close_Operation_List
     (Self : access Printer)
   is
   begin
      Self.Indent := Self.Indent - 1;
      Indent (Self);
      Put_Line (Self, "</OPLIST>");
   end Close_Operation_List;

   procedure Add_Type_Operation
     (Self : access Printer;
      XRef : in     AD.Crossrefs.Cross_Reference)
   is
   begin
      Indent (Self);
      Put_XRef (Self, "XREF", XRef);
      New_Line (Self);
   end Add_Type_Operation;

   procedure Add_Private
     (Self        : access Printer;
      For_Package : in     Boolean)
   is
      pragma Warnings (Off, For_Package); --  silence -gnatwa
   begin
      Indent (Self);
      Put_Line (Self, "<PRIVATE/>");
   end Add_Private;

   procedure Open_Anchor
     (Self : access Printer;
      XRef : in     AD.Crossrefs.Cross_Reference)
   is
   begin
      Put (Self, "<ANCHOR");
      Emit_XRef_Data (Self, XRef, True);
      Put (Self, '>');
   end Open_Anchor;

   procedure Close_Anchor
     (Self : access Printer)
   is
   begin
      Put (Self, "</ANCHOR>");
   end Close_Anchor;

   procedure Open_XRef
     (Self : access Printer;
      XRef : in     AD.Crossrefs.Cross_Reference)
   is
   begin
      if not XRef.Ignore then
         Put (Self, "<XREF");
         Emit_XRef_Data (Self, XRef);
         Put (Self, '>');
         Self.No_XRef := False;
      else
         Self.No_XRef := True;
      end if;
   end Open_XRef;

   procedure Close_XRef
     (Self : access Printer)
   is
   begin
      if not Self.No_XRef then Put (Self, "</XREF>"); end if;
      Self.No_XRef := False;
   end Close_XRef;

   procedure Put_XRef
     (Self     : access Printer;
      XRef     : in     AD.Crossrefs.Cross_Reference;
      Code     : in     Boolean := True;
      Is_Index : in     Boolean := False)
   is
      pragma Warnings (Off, Code); --  silence -gnatwa
      pragma Warnings (Off, Is_Index); --  silence -gnatwa
   begin
      Put_XRef (Self, "XREF", XRef);
   end Put_XRef;

   procedure Inline_Error
     (Self : access Printer;
      Msg  : in     String)
   is
      pragma Warnings (Off, Self); --  silence -gnatwa
      pragma Warnings (Off, Msg);  --  silence -gnatwa
   begin
      --  Just swallow the error message.
      null;
   end Inline_Error;

   ----------------------------------------------------------------------------
   --  Basic inline elements.

   procedure Write_Keyword
     (Self : access Printer;
      S    : in     String)
   is
   begin
      Put (Self, "<KEYWORD>" & Quot (S) & "</KEYWORD>");
   end Write_Keyword;

   procedure Write_Literal
     (Self : access Printer;
      S    : in     String)
   is
   begin
      Put (Self, "<LITERAL>" & Quot (S) & "</LITERAL>");
   end Write_Literal;

   procedure Write_Attribute
     (Self : access Printer;
      S    : in     String)
   is
   begin
      Put (Self, "<ATTRIBUTE>" & Quot (S) & "</ATTRIBUTE>");
   end Write_Attribute;

   procedure Write_Comment
     (Self : access Printer;
      S    : in     String)
   is
   begin
      Put (Self, "<COMMENT>" & Quot (S) & "</COMMENT>");
   end Write_Comment;

   procedure Write
     (Self : access Printer;
      S    : in     String)
   is
   begin
      Put (Self, Quot (S));
   end Write;

   procedure Write_Plain
     (Self : access Printer;
      S    : in     String)
   is
   begin
      Put (Self, S);
   end Write_Plain;

   procedure Write_Code
     (Self : access Printer;
      S    : in     String)
   is
   begin
      Put (Self, "<CODE>" & Quot (S) & "</CODE>");
   end Write_Code;

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

   procedure Open_Index
     (Self      : access Printer;
      File_Name : in     String;
      Title     : in     String;
      Present   : in     Ada.Strings.Maps.Character_Set)
   is
      pragma Warnings (Off, Present); --  silence -gnatwa
   begin
      Indent (Self);
      Put_Line (Self, "<INDEX NAME=""" & Quot (File_Name) & """ TITLE=""" &
                Quot (Title) & """>");
      Self.Indent := Self.Indent + 1;
      Self.Idx_Section_Open := False;
   end Open_Index;

   procedure Close_Index
     (Self : access Printer)
   is
   begin
      Close_Char_Section (Self);
      Self.Indent := Self.Indent - 1;
      Indent (Self);
      Put_Line (Self, "</INDEX>");
      New_Line (Self);
   end Close_Index;

   procedure XRef_Index
     (Self      : access Printer;
      File_Name : in     String;
      Title     : in     String)
   is
      pragma Warnings (Off, Self);      --  silence -gnatwa
      pragma Warnings (Off, File_Name); --  silence -gnatwa
      pragma Warnings (Off, Title);     --  silence -gnatwa
   begin
      null;
   end XRef_Index;

   procedure Open_Char_Section
     (Self : access Printer;
      Char : in     Character)
   is
   begin
      Indent (Self);
      Put_Line (Self, "<INDEX_SECTION NAME=""" & Quot ("" & Char) & """>");
      Self.Indent := Self.Indent + 1;
      Self.Idx_Section_Open := True;
   end Open_Char_Section;

   procedure Close_Char_Section
     (Self : access Printer)
   is
   begin
      if Self.Idx_Section_Open then
         Self.Indent := Self.Indent - 1;
         Indent (Self);
         Put_Line (Self, "</INDEX_SECTION>");
      end if;
      Self.Idx_Section_Open := False;
   end Close_Char_Section;

   procedure Open_Index_Structure
     (Self : access Printer)
   is
      pragma Warnings (Off, Self); --  silence -gnatwa
   begin
      null;
   end Open_Index_Structure;

   procedure Close_Index_Structure
     (Self : access Printer)
   is
      pragma Warnings (Off, Self); --  silence -gnatwa
   begin
      null;
   end Close_Index_Structure;

   procedure Open_Index_Item
     (Self : access Printer)
   is
   begin
      Indent (Self);
      Put (Self, "<INDEX_ITEM>");
   end Open_Index_Item;

   procedure Close_Index_Item
     (Self : access Printer)
   is
   begin
      Put_Line (Self, "</INDEX_ITEM>");
   end Close_Index_Item;

end AD.Printers.XML;
