-------------------------------------------------------------------------------
--
--  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>
--   A collection of writing operations, with cross-reference and anchor
--   generation. For entities that are part of generic instantiations, tries
--   to generate references to the generic template.</DL>
--
-- <!--
-- Revision History
--
--   20-FEB-2002   TW  Created from stuff originally in AD.Scanner.
--   21-FEB-2002   TW  Changed so that it uses the defining name image for
--                     identifiers and enumeration literals. As a result the
--                     output should have consistent casing even if the source
--                     doesn't. Note that this is complicated by ASIS sometimes
--                     returning the wrong defining name! (See comments in
--                     'Write_Reference' below.)
--   09-JUL-2003   TW  New operation 'Write_Special_Anchor' for XRefs to
--                     pragmas.
-- -->
-------------------------------------------------------------------------------

pragma License (GPL);

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

with Asis;
with Asis.Elements;
with Asis.Exceptions;
with Asis.Text;

with Asis2.Spans;

with AD.Crossrefs;
with AD.Messages.Inline;
with AD.Printers;
with AD.Text_Utilities;

with Util.Strings;

package body AD.Writers is

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

   use Asis;
   use Asis.Text;

   use Asis2.Spans;

   use AD.Text_Utilities;

   use Util.Strings;

   ----------------------------------------------------------------------------
   --  Internal operations:

   procedure Update_Last_Pos
     (State : in out Write_State;
      To    : in     Position)
   is
      Last_Line    : constant Line_List   :=
        Asis.Text.Lines (State.Unit, To.Line, To.Line);
      Line_Length  : Character_Position;
   begin
      State.Last_Written := To;
      --  Let's see if we're at the end of the line
      if Last_Line'Last < Last_Line'First then
         --  No line??
         raise Program_Error;
      end if;
      if Is_Nil (Last_Line (Last_Line'First)) then
         Line_Length := 0;
      else
         Line_Length := Length (Last_Line (Last_Line'First));
      end if;
      if Line_Length <= To.Column then
         State.Need_Newline := True;
         State.Write_From   := (To.Line + 1, 1);
      else
         State.Need_Newline := False;
         State.Write_From   := (To.Line, To.Column + 1);
      end if;
   end Update_Last_Pos;

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

   procedure Write
     (Span         : in     Asis.Text.Span;
      State        : in out Write_State;
      Is_Attribute : in     Boolean := False)
   is
      --  Write the given span, which belongs to 'Unit'. Update 'State' to
      --  reflect the last position written. If 'Is_Attribute' is true, the
      --  span comprises exactly one identifier and therefore is on one line:
      --  enclose by the HTML defined by the configuration keys for attributes.

      procedure Write_Line
        (Line         : in String;
         Is_Attribute : in Boolean)
      is
      begin
         if Is_Attribute then
            AD.Printers.Write_Attribute (State.The_Printer, Line);
         else
            AD.Printers.Dump (State.The_Printer, Line);
         end if;
      end Write_Line;

      From : Position          := Start (Span);
      To   : constant Position := Stop (Span);

   begin --  Write
      if Is_Nil (Span) or else To < From then return; end if;
      if From < State.Write_From then
         From := State.Write_From;
      end if;
      if To < From then return; end if;
      declare
         Lines : constant Line_List := Asis.Text.Lines (State.Unit, Span);
      begin
         for I in Lines'Range loop
            declare
               S : constant String := To_String (Line_Image (Lines (I)));
            begin
               if S'Last >= S'First then
                  if I = Lines'First and then
                     From.Line = State.Last_Written.Line and then
                     From.Column > State.Last_Written.Column
                  then
                     --  Omit leading blanks: we're still on the same line as
                     --  the last position written!
                     Write_Line
                       (S (S'First + State.Last_Written.Column .. S'Last),
                        Is_Attribute);
                  else
                     if State.Indent > 0 and then
                        S'Last - S'First + 1 >= State.Indent and then
                        Trim (S (S'First .. S'First + State.Indent - 1)) = ""
                     then
                        Write_Line (S (S'First + State.Indent .. S'Last),
                                    Is_Attribute);
                     else
                        Write_Line (S, Is_Attribute);
                     end if;
                  end if;
               end if;
               if I < Lines'Last then
                  AD.Printers.New_Line (State.The_Printer);
               end if;
            end;
         end loop;
         if Lines'Last >= Lines'First then
            --  We had some lines. Let's see if the last line terminates at the
            --  end of a line.
            Update_Last_Pos (State, To);
         end if;
      end;
   end Write;

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

   procedure Write_Before
     (Span  : in     Asis.Text.Span;
      State : in out Write_State)
   is
      --  Write anything from 'State.Write_From' up to, but not including,
      --  the start of the given span.

      To : Position := Start (Span);

   begin --  Write_Before
      if State.Write_From < To then
         if To.Column > 1 then
            To.Column := To.Column - 1;
         else
            if To.Line = 1 then return; end if;
            --  Need to set 'To' to the end of the preceeding line.
            To.Line := To.Line - 1;
            declare
               Prev_Line : constant Line_List :=
                 Lines (State.Unit, To.Line, To.Line);
            begin
               if Prev_Line'Last < Prev_Line'First then
                  --  No preceeding line??
                  raise Program_Error;
               end if;
               To.Column := Length (Prev_Line (Prev_Line'First));
            end;
         end if;
         declare
            To_Write : Asis.Text.Span;
         begin
            Set_Start (To_Write, State.Write_From);
            Set_Stop  (To_Write, To);
            Write (To_Write, State);
         end;
      else
         State.Need_Newline := False;
      end if;
   end Write_Before;

   ----------------------------------------------------------------------------
   --  Public operations:

   procedure Terminate_Line
     (State : in out Write_State)
   is
   begin
      if State.Need_Newline then
         AD.Printers.New_Line (State.The_Printer); State.Need_Newline := False;
      end if;
   end Terminate_Line;

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

   procedure Write_Reference
     (Name  : in     Asis.Expression;
      State : in out Write_State)
   is
      Reporter : aliased AD.Messages.Inline.Error_Reporter :=
        (AD.Messages.Error_Reporter with The_Printer => State.The_Printer);
      Span : constant Asis.Text.Span      := Get_Span (Name);
      XRef : AD.Crossrefs.Cross_Reference :=
        AD.Crossrefs.Crossref_Exp (Name, State.Unit, Reporter'Access);
   begin
      Write_Before (Span, State);
      Terminate_Line (State);
      AD.Printers.Open_XRef (State.The_Printer, XRef);
      if WASU.Length (XRef.Image) > 0 then
         --  Use the image!
         AD.Printers.Dump (State.The_Printer,
                           ACH.To_String (WASU.To_Wide_String (XRef.Image)));
         --  Update the writing position!!
         Update_Last_Pos (State, Stop (Span));
      else
         Write (Span, State);
      end if;
      AD.Printers.Close_XRef (State.The_Printer);
   end Write_Reference;

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

   procedure Write_Attribute
     (Name  : in     Asis.Expression;
      State : in out Write_State)
   is
      Span : constant Asis.Text.Span := Get_Span (Name);
   begin
      Write_Before (Span, State);
      Terminate_Line (State);
      Write (Span, State, True);
   end Write_Attribute;

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

   procedure Write_Name
     (Name  : in     Asis.Defining_Name;
      State : in out Write_State)
   is
      Reporter : aliased AD.Messages.Inline.Error_Reporter :=
        (AD.Messages.Error_Reporter with The_Printer => State.The_Printer);
      Span     : constant Asis.Text.Span := Get_Span (Name);
   begin
      Write_Before (Span, State);
      Terminate_Line (State);
      AD.Printers.Open_Anchor
        (State.The_Printer,
         AD.Crossrefs.Crossref_Name (Name, State.Unit, Reporter'Access));
      Write (Span, State);
      AD.Printers.Close_Anchor (State.The_Printer);
   end Write_Name;

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

   procedure Write_Special_Anchor
     (Element : in     Asis.Element;
      State   : in out Write_State)
   is
      use Asis.Elements;

      Span : Asis.Text.Span := Get_Span (Element);

   begin
      Write_Before (Span, State);
      Terminate_Line (State);
      Span.Last_Line := Span.First_Line;
      case Element_Kind (Element) is
         when A_Pragma =>
            Span.Last_Column := Span.First_Column + 5;
         when A_Clause =>
            case Representation_Clause_Kind (Element) is
               when An_Attribute_Definition_Clause |
                    An_Enumeration_Representation_Clause |
                    A_Record_Representation_Clause =>
                  Span.Last_Column := Span.First_Column + 2;
               when others =>
                  Ada.Exceptions.Raise_Exception
                    (Asis.Exceptions.ASIS_Inappropriate_Element'Identity,
                     "Unexpected rep clause kind " &
                     Representation_Clause_Kinds'Image
                       (Representation_Clause_Kind (Element)) &
                     " in AD.Writers.Write_Special_Anchor.");
            end case;
         when others =>
            Ada.Exceptions.Raise_Exception
              (Asis.Exceptions.ASIS_Inappropriate_Element'Identity,
               "Unexpected element kind " &
               Element_Kinds'Image (Element_Kind (Element)) &
               " in AD.Writers.Write_Special_Anchor.");
      end case;
      AD.Printers.Open_Anchor
        (State.The_Printer,
         AD.Crossrefs.Crossref_Special (Element, State.Unit));
      Write (Span, State);
      AD.Printers.Close_Anchor (State.The_Printer);
   end Write_Special_Anchor;

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

   procedure Write
     (Element : in     Asis.Element;
      State   : in out Write_State)
   is
   begin
      Write_Span (Get_Span (Element), State);
   end Write;

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

   procedure Write_Span
     (Span  : in     Asis.Text.Span;
      State : in out Write_State)
   is
   begin
      Write_Before (Span, State);
      if State.Write_From <= Stop (Span) then
         Terminate_Line (State);
         declare
            To_Write : Asis.Text.Span := Span;
         begin
            Set_Start (To_Write, State.Write_From);
            Write (To_Write, State);
         end;
      end if;
   end Write_Span;

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

end AD.Writers;
