-------------------------------------------------------------------------------
--
--  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.
--   28-AUG-2002   TW  Added the private 'To_String', and 'Set_Line_Only'.
--   30-MAY-2003   TW  Added the 'Is_Private' parameter for 'Open_Unit' and
--                     'Add_Child'.
--   30-JUN-2003   TW  Complete rewrite of the indexing stuff.
-- -->
-------------------------------------------------------------------------------

pragma License (GPL);

with Ada.Finalization;
with Ada.Strings.Maps;
with Ada.Text_IO;
with Ada.Unchecked_Deallocation;

with Asis.Text;

with Asis2.Spans;

with AD.Crossrefs;
with AD.Options;

with Util.Text;

package AD.Printers is

   pragma Elaborate_Body;

   type Item_Kind is
     (Not_An_Item,

      A_Use_Clause,
      A_Use_Type_Clause,

      A_Pragma,

      A_Procedure,
      A_Function,

      A_Generic_Procedure,
      A_Generic_Function,

      A_Package_Instantiation,
      A_Procedure_Instantiation,
      A_Function_Instantiation,

      A_Package_Renaming,
      A_Procedure_Renaming,
      A_Function_Renaming,
      A_Generic_Package_Renaming,
      A_Generic_Procedure_Renaming,
      A_Generic_Function_Renaming,

      A_Package,
      A_Generic_Package,
      A_Generic_Signature_Package,
      --  Generic package declarations with no visible items (except the formal
      --  part).

      A_Task_Type,
      A_Protected_Type,
      A_Task,
      A_Protected_Object,

      A_Type,

      A_Subtype,

      A_Variable,
      A_Constant,
      A_Deferred_Constant,

      An_Object_Renaming,

      An_Entry,
      A_Protected_Procedure,
      A_Protected_Function,

      An_Exception,
      An_Exception_Renaming);

   subtype Library_Item_Kind is Item_Kind
     range A_Procedure .. A_Generic_Signature_Package;

   subtype Container_Item_Kind is Item_Kind
     range A_Package .. A_Protected_Object;

   subtype Declaration_Item_Kind is Item_Kind
     range Item_Kind'Succ (A_Pragma) .. Item_Kind'Last;

   function Get_Item_Kind
     (Item : in Asis.Element)
     return Item_Kind;

   type Printer is abstract
     new Ada.Finalization.Limited_Controlled with null record;

   type Printer_Ref is access all Printer'Class;

   Open_Failed : exception;
   --  Raised by @Open_Output@ if the file could not be opened.

   Cannot_Overwrite : exception;
   --  Raised by @Open_Output@ if a file with the given already exists, but
   --  may not be overwritten.

   type Section_Type is
     (Dependencies_Section, Snippet_Section, Description_Section,
      Header_Section, Footer_Section, Content_Section, Top_Item_Section,
      Children_Section, Exceptions_Section, Exception_Section,
      Exception_Rename_Section, Ultimate_Exception_Section,
      Type_Summary_Section, Type_Section, Operations_Section,
      Constants_Section, Variables_Section, Others_Section,
      Index_XRef_Section);
   --  All sections opened and closed through simple calls.

   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 abstract;

   procedure Close_Unit
     (Self : access Printer)
     is abstract;

   procedure Write_Comment
     (Self  : access Printer;
      Lines : in     Asis.Text.Line_List)
      is abstract;

   procedure Open_Section
     (Self    : access Printer;
      Section : in     Section_Type)
     is abstract;

   procedure Close_Section
     (Self    : access Printer;
      Section : in     Section_Type)
     is abstract;

   procedure Open_Item
     (Self : access Printer;
      XRef : in     AD.Crossrefs.Cross_Reference;
      Kind : in     Item_Kind   := Not_An_Item;
      Name : in     Wide_String := "")
     is abstract;

   procedure Close_Item
     (Self    : access Printer;
      Is_Last : in     Boolean := False)
     is abstract;

   procedure Other_Declaration
     (Self : access Printer;
      XRef : in     AD.Crossrefs.Cross_Reference;
      Text : in     String)
     is abstract;

   procedure Open_Container
     (Self : access Printer;
      XRef : in     AD.Crossrefs.Cross_Reference;
      Kind : in     Item_Kind;
      Name : in     Wide_String := "")
     is abstract;

   procedure Close_Container
     (Self    : access Printer;
      Is_Last : in     Boolean := False)
     is abstract;

   procedure Add_Child
     (Self       : access Printer;
      Kind       : in     Item_Kind;
      Is_Private : in     Boolean;
      XRef       : in     AD.Crossrefs.Cross_Reference)
     is abstract;

   procedure Add_Exception
     (Self : access Printer;
      XRef : in     AD.Crossrefs.Cross_Reference)
     is abstract;

   procedure Type_Name
     (Self : access Printer;
      XRef : in     AD.Crossrefs.Cross_Reference)
     is abstract;

   procedure Type_Kind
     (Self : access Printer;
      Info : in     String)
     is abstract;

   procedure Parent_Type
     (Self : access Printer;
      XRef : in     AD.Crossrefs.Cross_Reference)
     is abstract;

   type Operation_Kind is
     (Overridden_Operation,
      Own_Operation,
      Inherited_Operation,
      Inherited_Original_Operation);

   procedure Open_Operation_List
     (Self : access Printer;
      Kind : in     Operation_Kind)
     is abstract;

   procedure Close_Operation_List
     (Self : access Printer)
     is abstract;

   procedure Add_Type_Operation
     (Self : access Printer;
      XRef : in     AD.Crossrefs.Cross_Reference)
     is abstract;

   procedure Add_Private
     (Self        : access Printer;
      For_Package : in     Boolean)
     is abstract;

   procedure Open_Anchor
     (Self : access Printer;
      XRef : in     AD.Crossrefs.Cross_Reference)
     is abstract;

   procedure Close_Anchor
     (Self : access Printer)
     is abstract;

   procedure Open_XRef
     (Self : access Printer;
      XRef : in     AD.Crossrefs.Cross_Reference)
     is abstract;

   procedure Close_XRef
     (Self : access Printer)
     is abstract;

   procedure Put_XRef
     (Self     : access Printer;
      XRef     : in     AD.Crossrefs.Cross_Reference;
      Code     : in     Boolean := True;
      Is_Index : in     Boolean := False)
     is abstract;
   --  Open_XRef, emit XRef.Image, Close_XRef.

   procedure Inline_Error
     (Self : access Printer;
      Msg  : in     String)
     is abstract;

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

   procedure Write_Keyword
     (Self : access Printer;
      S    : in     String)
     is abstract;

   procedure Write_Literal
     (Self : access Printer;
      S    : in     String)
     is abstract;

   procedure Write_Attribute
     (Self : access Printer;
      S    : in     String)
     is abstract;

   procedure Write_Comment
     (Self : access Printer;
      S    : in     String)
     is abstract;

   procedure Write
     (Self : access Printer;
      S    : in     String)
     is abstract;

   procedure Write_Plain
     (Self : access Printer;
      S    : in     String)
     is abstract;

   procedure Write_Code
     (Self : access Printer;
      S    : in     String)
     is abstract;

   procedure New_Line
     (Self : access Printer;
      N    : in     Positive := 1)
     is abstract;

   ----------------------------------------------------------------------------
   --  Formatted output.

   procedure Dump
     (Self : access Printer'Class;
      Line : in     String);

   ----------------------------------------------------------------------------
   --  I/O management.

   function  Is_Open
     (Self : in Printer)
     return Boolean
     is abstract;

   ----------------------------------------------------------------------------
   --  Index management.

   procedure Open_Index
     (Self      : access Printer;
      File_Name : in     String;
      Title     : in     String;
      Present   : in     Ada.Strings.Maps.Character_Set)
     is abstract;

   procedure Close_Index
     (Self : access Printer)
     is abstract;

   procedure XRef_Index
     (Self      : access Printer;
      File_Name : in     String;
      Title     : in     String)
     is abstract;

   procedure Open_Char_Section
     (Self : access Printer;
      Char : in     Character)
     is abstract;

   procedure Close_Char_Section
     (Self : access Printer)
     is abstract;

   procedure Open_Index_Structure
     (Self : access Printer)
     is abstract;

   procedure Close_Index_Structure
     (Self : access Printer)
     is abstract;

   procedure Open_Index_Item
     (Self : access Printer)
     is abstract;

   procedure Close_Index_Item
     (Self : access Printer)
     is abstract;

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

   function "+"
     (Left, Right : in Printer_Ref)
     return Printer_Ref;
   --  Be careful here! You shouldn't try to use Left.all or Right.all
   --  directly after having called "@+@". It's only intended use is to
   --  facilitate composing printers in adabrowse.adb!

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

   procedure Free is
      new Ada.Unchecked_Deallocation (Printer'Class, Printer_Ref);

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

   procedure Set_Line_Only;
   --  Make cross-references use only the line number.

private

   type Real_Printer is abstract new Printer with
      record
         File       : aliased Ada.Text_IO.File_Type;
         F          :         Ada.Text_IO.File_Access;
         Buffer     :         Util.Text.Unbounded_String;
         Use_Buffer :         Boolean := False;
      end record;

   function Get_Suffix
     (Self : in Real_Printer)
     return String
     is abstract;

   procedure Finalize
     (Self : in out Real_Printer);

   procedure Open_File
     (Self        : in out Real_Printer;
      Mode        : in     AD.Options.File_Handling;
      File_Name   : in     String;
      Use_Default : in     Boolean := True);

   function Is_Open
     (Self : in Real_Printer)
     return Boolean;

   procedure Close_File
     (Self : in out Real_Printer);

   ----------------------------------------------------------------------------
   --  The following operations will write to Self.Buffer if Self.Use_Buffer
   --  is True; otherwise to the file Self.F.all.

   procedure Put
     (Self : access Real_Printer;
      S    : in     String);

   procedure Put
     (Self : access Real_Printer;
      Ch   : in     Character);

   procedure Put_Line
     (Self : access Real_Printer;
      S    : in     String);

   procedure New_Line
     (Self : access Real_Printer;
      N    : in     Positive := 1);

   procedure Put_Line
     (Self : in out Real_Printer;
      S    : in     String);

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

   type Composer is new Printer with
      record
         Left, Right           : Printer_Ref;
         Left_Open, Right_Open : Boolean := False;
      end record;

   procedure Finalize
     (Self : in out Composer);

   function Is_Open
     (Self : in Composer)
     return Boolean;

   procedure Write_Comment
     (Self  : access Composer;
      Lines : in     Asis.Text.Line_List);

   procedure Open_Unit
     (Self       : access Composer;
      Unit_Kind  : in     Item_Kind;
      Unit_Name  : in     Wide_String;
      Is_Private : in     Boolean;
      XRef       : in     AD.Crossrefs.Cross_Reference);

   procedure Close_Unit
     (Self : access Composer);

   procedure Open_Section
     (Self    : access Composer;
      Section : in     Section_Type);

   procedure Close_Section
     (Self    : access Composer;
      Section : in     Section_Type);

   procedure Open_Item
     (Self : access Composer;
      XRef : in     AD.Crossrefs.Cross_Reference;
      Kind : in     Item_Kind   := Not_An_Item;
      Name : in     Wide_String := "");

   procedure Close_Item
     (Self    : access Composer;
      Is_Last : in     Boolean := False);

   procedure Other_Declaration
     (Self : access Composer;
      XRef : in     AD.Crossrefs.Cross_Reference;
      Text : in     String);

   procedure Open_Container
     (Self : access Composer;
      XRef : in     AD.Crossrefs.Cross_Reference;
      Kind : in     Item_Kind;
      Name : in     Wide_String := "");

   procedure Close_Container
     (Self    : access Composer;
      Is_Last : in     Boolean := False);

   procedure Add_Child
     (Self       : access Composer;
      Kind       : in     Item_Kind;
      Is_Private : in     Boolean;
      XRef       : in     AD.Crossrefs.Cross_Reference);

   procedure Add_Exception
     (Self : access Composer;
      XRef : in     AD.Crossrefs.Cross_Reference);

   procedure Type_Name
     (Self : access Composer;
      XRef : in     AD.Crossrefs.Cross_Reference);

   procedure Type_Kind
     (Self : access Composer;
      Info : in     String);

   procedure Parent_Type
     (Self : access Composer;
      XRef : in     AD.Crossrefs.Cross_Reference);

   procedure Open_Operation_List
     (Self : access Composer;
      Kind : in     Operation_Kind);

   procedure Close_Operation_List
     (Self : access Composer);

   procedure Add_Type_Operation
     (Self : access Composer;
      XRef : in     AD.Crossrefs.Cross_Reference);

   procedure Add_Private
     (Self        : access Composer;
      For_Package : in     Boolean);

   procedure Open_Anchor
     (Self : access Composer;
      XRef : in     AD.Crossrefs.Cross_Reference);

   procedure Close_Anchor
     (Self : access Composer);

   procedure Open_XRef
     (Self : access Composer;
      XRef : in     AD.Crossrefs.Cross_Reference);

   procedure Close_XRef
     (Self : access Composer);

   procedure Put_XRef
     (Self     : access Composer;
      XRef     : in     AD.Crossrefs.Cross_Reference;
      Code     : in     Boolean := True;
      Is_Index : in     Boolean := False);
   --  Open_XRef, emit XRef.Image, Close_XRef.

   procedure Inline_Error
     (Self : access Composer;
      Msg  : in     String);

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

   procedure Write_Keyword
     (Self : access Composer;
      S    : in     String);

   procedure Write_Literal
     (Self : access Composer;
      S    : in     String);

   procedure Write_Attribute
     (Self : access Composer;
      S    : in     String);

   procedure Write_Comment
     (Self : access Composer;
      S    : in     String);

   procedure Write
     (Self : access Composer;
      S    : in     String);

   procedure Write_Plain
     (Self : access Composer;
      S    : in     String);

   procedure Write_Code
     (Self : access Composer;
      S    : in     String);

   procedure New_Line
     (Self : access Composer;
      N    : in     Positive := 1);

   ----------------------------------------------------------------------------
   --  I/O management.

   procedure Open_Index
     (Self      : access Composer;
      File_Name : in     String;
      Title     : in     String;
      Present   : in     Ada.Strings.Maps.Character_Set);

   procedure Close_Index
     (Self : access Composer);

   procedure XRef_Index
     (Self      : access Composer;
      File_Name : in     String;
      Title     : in     String);

   procedure Open_Char_Section
     (Self : access Composer;
      Char : in     Character);

   procedure Close_Char_Section
     (Self : access Composer);

   procedure Open_Index_Structure
     (Self : access Composer);

   procedure Close_Index_Structure
     (Self : access Composer);

   procedure Open_Index_Item
     (Self : access Composer);

   procedure Close_Index_Item
     (Self : access Composer);

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

   Full_Crossrefs : Boolean := True;

   function To_String
     (Pos  : in Asis2.Spans.Position;
      Full : in Boolean)
     return String;

end AD.Printers;
