-------------------------------------------------------------------------------
--
--  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>
--   HTML output producer.</DL>
--
-- <!--
-- Revision History
--
--   22-JUL-2002   TW  Initial version.
--   30-MAY-2003   TW  'Is_Private' handling in 'Open_Unit' and 'Add_Child'.
--   30-JUN-2003   TW  Rewrote the indexing stuff completely.
--   09-JUL-2003   TW  Changed 'Write_Comment' to use the formatter to catch
--                     e.g. @-shortcuts in inline comments.
--   22-AUG-2003   TW  Relative cell width specification (2%) instead of
--                     absolute pixel-width (10) in indentation table cells.
-- -->
-------------------------------------------------------------------------------

pragma License (GPL);

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

with Asis.Text;

with Asis2.Spans;

with AD.Format;
with AD.Messages;
with AD.HTML.Pathes;
with AD.Text_Utilities;

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

package body AD.Printers.HTML is

   procedure Free is
      new Ada.Unchecked_Deallocation (Blocks, Block_Ptr);

   package ACH  renames Ada.Characters.Handling;
   package ASM  renames Ada.Strings.Maps;
   package ASU  renames Ada.Strings.Unbounded;
   package WASU renames Ada.Strings.Wide_Unbounded;

   use AD.HTML;

   use Util.Strings;

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

   HTML_Suffix : constant String := "html";

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

   Index_XRef_Stuff : ASU.Unbounded_String;

   procedure Set_Index_XRef
     (Value : in String)
   is
   begin
      Index_XRef_Stuff := ASU.To_Unbounded_String (Value);
   end Set_Index_XRef;

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

   procedure Open_XRef
     (Self     : access Printer;
      XRef     : in     AD.Crossrefs.Cross_Reference;
      Is_Index : in     Boolean)
   is
   begin
      if XRef.Ignore or else (XRef.Is_Local and then XRef.Is_Top_Unit) then
         Self.No_XRef := True; return;
      end if;
      Self.No_XRef := False;
      Put (Self, "<A HREF=""");
      if XRef.Is_Local and then not Asis2.Spans.Is_Nil (XRef.Position) then
         Put (Self, '#' & To_String (XRef.Position, Full_Crossrefs));
      else
         declare
            Unit_Name : constant String :=
              To_Lower
                (ACH.To_String (WASU.To_Wide_String (XRef.Full_Unit_Name)));
         begin
            Put (Self,
                 AD.HTML.Pathes.Get_Path (Unit_Name) &
                 AD.Text_Utilities.To_File_Name (Unit_Name, HTML_Suffix));
            if not XRef.Is_Top_Unit and then
               not Asis2.Spans.Is_Nil (XRef.Position)
            then
               Put (Self, '#' & To_String (XRef.Position, Full_Crossrefs));
            end if;
         end;
      end if;
      if Is_Index then
         Put (Self, """ " & ASU.To_String (Index_XRef_Stuff) & '>');
      else
         Put (Self, """>");
      end if;
   end Open_XRef;

   procedure Put_XRef
     (Self     : access Printer;
      XRef     : in     AD.Crossrefs.Cross_Reference;
      Code     : in     Boolean := True;
      Is_Index : in     Boolean := False)
   is
   begin
      if Code then Put (Self, "<CODE>"); end if;
      Open_XRef (Self, XRef, Is_Index);
      Put (Self, HTMLize (ACH.To_String (WASU.To_Wide_String (XRef.Image))));
      Close_XRef (Self);
      if Code then Put (Self, "</CODE>"); end if;
   end Put_XRef;

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

   procedure Open_Block
     (Self : access Printer)
   is
      P : constant Block_Ptr := new Blocks (1 .. Self.First_In_Block'Last + 1);
   begin
      P (1)           := True;
      P (2 .. P'Last) := Self.First_In_Block.all;
      Free (Self.First_In_Block);
      Self.First_In_Block := P;
   end Open_Block;

   procedure Close_Block
     (Self : access Printer)
   is
      P : Block_Ptr := Self.First_In_Block;
   begin
      Self.First_In_Block := new Blocks (1 .. P'Last - 1);
      Self.First_In_Block.all := P (P'First + 1 .. P'Last);
      Free (P);
   end Close_Block;

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

   function Get_Description
     (Kind       : in Item_Kind;
      Is_Private : in Boolean)
     return String
   is
      function Get_Description
        (Kind : in Item_Kind)
        return String
      is
      begin
         case Kind is
            when A_Generic_Signature_Package =>
               --  This is a special case because of the parentheses
               return "Generic (signature) package";

            when others =>
               declare
                  S : String := To_Lower (Library_Item_Kind'Image (Kind));
               begin
                  for I in S'Range loop
                     if S (I) = '_' then S (I) := ' '; end if;
                  end loop;
                  --  The first two characters are "a_", which we omit.
                  S (S'First + 2) := To_Upper (S (S'First + 2));
                  return S (S'First + 2 .. S'Last);
               end;
         end case;
      end Get_Description;

      Text : constant String := Get_Description (Kind);

   begin
      if Is_Private then
         return "Private " &
                To_Lower (Text (Text'First)) &
                Text (Text'First + 1 .. Text'Last);
      else
         return Text;
      end if;
   end Get_Description;

   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
      pragma Warnings (Off, XRef); --  silence -gnatwa
   begin
      begin
         Open_File
           (Self.all,
            AD.Options.Processing_Mode,
            AD.Text_Utilities.To_File_Name
              (ACH.To_String (Unit_Name), HTML_Suffix));
      exception
         when E : others =>
            AD.Messages.Warn (Ada.Exceptions.Exception_Message (E));
      end;
      if Is_Open (Self.all) then
         if Unit_Kind in Library_Item_Kind then
            AD.HTML.Header
              (Self.F.all,
               Get_Description (Unit_Kind, Is_Private) & ": " &
               ACH.To_String (Unit_Name));
         else
            AD.HTML.Header (Self.F.all, ACH.To_String (Unit_Name));
         end if;
         if Self.First_In_Block /= null then
            Free (Self.First_In_Block);
         end if;
         Self.First_In_Block := new Blocks'(1 .. 1 => True);
         Self.Container_Level := -1;
         Self.Type_Has_Parent := False;
         Self.No_XRef         := False;
         Self.In_Exception    := False;
         Self.In_Type         := False;
         Self.In_Dependencies := False;
         Self.In_Constants    := False;
         Self.In_Top_Item     := False;
         Self.Force_Multiline := False;
         Self.In_Task         := False;
         Self.Is_Unit         := True;
      end if;
   end Open_Unit;

   procedure Close_Unit
     (Self : access Printer)
   is
   begin
      AD.HTML.Footer (Self.F.all);
      Free (Self.First_In_Block);
      Self.Is_Unit := False;
   end Close_Unit;

   procedure Write_Comment
     (Self  : access Printer;
      Lines : in     Asis.Text.Line_List)
   is
   begin
      AD.Format.Format (Lines, Self);
   end Write_Comment;

   procedure Emit_Snippet
     (Self : access Printer)
   is
      I    : Natural          := Util.Text.First_Index (Self.Buffer, ASCII.LF);
      Last : constant Natural := Util.Text.Length (Self.Buffer);

   begin
      Self.Use_Buffer := False;
      --  Switch off buffer usage!
      if (I = 0 or else I = Last) and then not Self.Force_Multiline then
         --  Single-line snippet:
         --  TBD: comment-in the following! it is commented out only
         --  for correctness checking: V2.13 didn't replace white
         --  space by &nbsp;, so we don't either. This allows pure
         --  text comparison to verify that the output is still the
         --  same!
         --  declare
         --   Lines : aliased AD.Filters.Filter_Lines;
         --  begin
         --   if I = Last then
         --  Remove that single (and last) LF, otherwise we'll
         --  get a "<BR>" inserted!
         --      Util.Text.Delete (Self.Buffer, Last, Last);
         --   end if;
         --   AD.Filters.Transform (Lines'Access, Self.Buffer);
         --  end;
         declare
            Txt : constant Util.Text.String_Access :=
              Util.Text.Internal.Get_Ptr (Self.Buffer);
         begin
            if Txt (Txt'Last) = ASCII.LF then
               Put_Line (Self,
                         "<CODE>" &
                         Txt (Txt'First .. Txt'Last - 1) &
                         "</CODE>");
            else
               Put_Line (Self, "<CODE>" & Txt.all & "</CODE>");
            end if;
         end;
      else
         --  Multi-line snippet:
         Put (Self, "<PRE><CODE>");
         declare
            Txt   : constant Util.Text.String_Access :=
              Util.Text.Internal.Get_Ptr (Self.Buffer);
            First : Natural := 1;
         begin
            if I = 0 then
               Put (Self, Txt.all);
            else
               loop
                  Put_Line (Self, Txt (First .. I - 1));
                  exit when I = Txt'Last;
                  First := I + 1;
                  I := First_Index (Txt (First .. Txt'Last), ASCII.LF);
                  if I = 0 then
                     Put (Self, Txt (First .. Txt'Last));
                     exit;
                  end if;
               end loop;
            end if;
         end;
         Put_Line (Self, "</CODE></PRE>");
      end if;
      Self.Buffer := Util.Text.Null_Unbounded_String;
   end Emit_Snippet;

   procedure Open_Section
     (Self    : access Printer;
      Section : in     Section_Type)
   is
   begin
      case Section is
         when Index_XRef_Section =>
            Put_Line (Self, "<HR>");
            Self.First_Index := True;
         when Dependencies_Section =>
            if Self.First_In_Block (1) then
               Self.First_In_Block (1) := False;
            else
               Put_Line (Self, "<HR>");
            end if;
            AD.HTML.Subtitle (Self.F.all, "Dependencies");
            Self.In_Dependencies := True;
            --  Self.Force_Multiline := True;
         when Snippet_Section =>
            if Self.Container_Level > 0 then
               Put (Self, "<TR><TD ");
               if Self.In_Top_Item then
                  if Self.Container_Level mod 2 = 0 then
                     Put_Line (Self, "CLASS=""even"">");
                  else
                     Put_Line (Self, "CLASS=""odd"">");
                  end if;
               else
                  if Self.In_Constants then
                     Put (Self, "ALIGN=""LEFT"" ");
                  end if;
                  Put_Line (Self, "CLASS=""code"">");
               end if;
            end if;
            --  We buffer the snippet. When we close it, we first count the
            --  newlines. If there is only one, we run the text though a
            --  Filter_Lines filter, which will replace all whitespace by
            --  "&nbsp;" as needed, wrap it in a "CODE" tag and emit the
            --  result. If there are several lines, we just wrap it all
            --  into a "PRE".
            Self.Use_Buffer := True;
            Self.Force_Multiline := not Self.In_Constants;
         when Description_Section =>
            if Self.In_Exception then
               Put_Line (Self,  "</TD></TR>");
               Self.In_Exception := False;
            end if;
            if Self.Container_Level > 0 then
               Put_Line (Self, "<TR><TD>");
            elsif Self.Container_Level = -1 and then
                  not Self.In_Dependencies
            then
               --  Top-level comment coming!
               if Self.First_In_Block (1) then
                  Self.First_In_Block (1) := False;
               else
                  Put_Line (Self, "<HR>");
               end if;
               AD.HTML.Subtitle (Self.F.all, "Description");
            end if;
            Put_Line (Self, "<DIV>");
         when Header_Section |
              Footer_Section =>
            Put (Self, "<TR><TD COLSPAN=2 CLASS=");
            if Self.Container_Level mod 2 = 0 then
               Put_Line (Self, """even"">");
            else
               Put_Line (Self, """odd"">");
            end if;
            Self.Use_Buffer      := True;
            Self.Force_Multiline := True;
         when Content_Section =>
            --  Was WIDTH=10, but that sometimes fails to display correctly
            --  on IE 5.0.
            Put (Self, "<TR><TD WIDTH=""2%"" CLASS=");
            if Self.Container_Level mod 2 = 0 then
               Put (Self, """even"">");
            else
               Put (Self, """odd"">");
            end if;
            Put_Line (Self, "<PRE> </PRE></TD>");
            Put_Line (Self, "<TD>");
            Put_Line
              (Self,
               "<TABLE WIDTH=""100%"" BORDER=0 CELLSPACING=0 CELLPADDING=0>");
            Open_Block (Self);
         when Top_Item_Section =>
            Self.In_Top_Item := True;
            Self.First_In_Block (1) := False;
         when Children_Section =>
            Put_Line (Self, "<TR><TD>");
            if Self.First_In_Block (1) then
               Self.First_In_Block (1) := False;
            else
               Put_Line (Self, "<HR>");
            end if;
            AD.HTML.Subtitle (Self.F.all, "Known child units");
            Put_Line (Self, "<TABLE BORDER=0>");
         when Exceptions_Section =>
            Put_Line (Self, "<TR><TD>");
            if Self.First_In_Block (1) then
               Self.First_In_Block (1) := False;
            else
               Put_Line (Self, "<HR>");
            end if;
            AD.HTML.Subtitle (Self.F.all, "Exceptions");
            Put_Line (Self, "<TABLE WIDTH=""100%"" BORDER=0 CELLSPACING=0>");
         when Exception_Section =>
            Put_Line (Self, "<TR><TD ALIGN=""LEFT"" CLASS=""code"">");
            Self.In_Exception := True;
            Open_Block (Self);
         when Exception_Rename_Section =>
            Put (Self, "<CODE>");
            Dump (Self, " renames ");
         when Ultimate_Exception_Section =>
            Put (Self, " (ultimately a rename of <CODE>");
         when Type_Summary_Section =>
            Put_Line (Self, "<TR><TD>");
            if Self.First_In_Block (1) then
               Self.First_In_Block (1) := False;
            else
               Put_Line (Self, "<HR>");
            end if;
            AD.HTML.Subtitle (Self.F.all, "Type Summary");
            Put_Line (Self, "<TABLE WIDTH=""100%"" BORDER=0 CELLSPACING=0>");
         when Type_Section =>
            Put_Line
              (Self, "<TR><TD COLSPAN=2 ALIGN=""LEFT"" CLASS=""type"">");
            Self.In_Type := True;
         when Operations_Section =>
            if Self.In_Type then
               Put_Line (Self, "</TD></TR>");
               Self.In_Type := False;
            end if;
         when Constants_Section |
              Variables_Section =>
            Put_Line (Self, "<TR><TD>");
            if Self.First_In_Block (1) then
               Self.First_In_Block (1) := False;
            else
               Put_Line (Self, "<HR>");
            end if;
            if Section = Constants_Section then
               AD.HTML.Subtitle (Self.F.all, "Constants and Named Numbers");
            else
               AD.HTML.Subtitle (Self.F.all, "Variables");
            end if;
            Put_Line (Self, "<TABLE WIDTH=""100%"" BORDER=0 CELLSPACING=0>");
            Self.In_Constants := True;
         when Others_Section =>
            if not Self.In_Task then
               Put_Line (Self, "<TR><TD>");
               if Self.First_In_Block (1) then
                  Self.First_In_Block (1) := False;
               else
                  Put_Line (Self, "<HR>");
               end if;
               AD.HTML.Subtitle (Self.F.all, "Other Items:");
               Put_Line (Self, "</TD></TR>");
            end if;
            Open_Block (Self);
      end case;
   end Open_Section;

   --  Section := {Section | Item }.

   procedure Close_Section
     (Self    : access Printer;
      Section : in     Section_Type)
   is
   begin
      case Section is
         when Index_XRef_Section =>
            if not Self.First_Index then
               Put_Line (Self, "</P>");
               Put_Line (Self, "<HR>");
            end if;
            --  Count the number of chars present; if > 1, write them.
            if Util.Strings.Cardinality (Self.Index_Chars) > 1 then
               Put_Line (Self, "<P>");
               if ASM.Is_In ('"', Self.Index_Chars) then
                  Put (Self, " <A HREF=""#operators"">[Operators]</A>");
               end if;
               for I in Character range 'A' .. 'Z' loop
                  if ASM.Is_In (I, Self.Index_Chars) then
                     Put (Self, " <A HREF=""#" & I & """>[" & I & "]</A>");
                  end if;
               end loop;
               for I in Character range 'a' .. 'z' loop
                  if ASM.Is_In (I, Self.Index_Chars) then
                     Put (Self, " <A HREF=""#" & I & """>[" & I & "]</A>");
                  end if;
               end loop;
               New_Line (Self);
               Put_Line (Self, "</P>");
               Put_Line (Self, "<HR>");
            end if;
            Self.First_Index := True;
         when Dependencies_Section =>
            Self.In_Dependencies := False;
            --  Self.Force_Multiline := False;
         when Snippet_Section =>
            Emit_Snippet (Self);
            if Self.Container_Level > 0 then
               Put_Line (Self, "</TD></TR>");
            end if;
            Self.Force_Multiline := False;
         when Description_Section =>
            Put_Line (Self, "</DIV>");
            if Self.Container_Level > 0 then
               Put_Line (Self, "</TD></TR>");
            end if;
         when Header_Section |
              Footer_Section =>
            Emit_Snippet (Self);
            Put_Line (Self, "</TD></TR>");
            Self.Force_Multiline := False;
         when Content_Section =>
            Close_Block (Self);
            Put_Line (Self, "</TABLE>");
            Put_Line (Self, "</TD></TR>");
         when Top_Item_Section =>
            Self.In_Top_Item := False;
         when Children_Section =>
            Put_Line (Self, "</TABLE>");
            Put_Line (Self, "</TD></TR>");
         when Exceptions_Section =>
            Put_Line (Self, "</TABLE>");
            Put_Line (Self, "</TD></TR>");
         when Exception_Section =>
            Close_Block (Self);
            if Self.In_Exception then
               Put_Line (Self, "</TD></TR>");
            end if;
            Self.In_Exception := False;
         when Exception_Rename_Section =>
            Put (Self, "</CODE>");
         when Ultimate_Exception_Section =>
            Put (Self, "</CODE>)");
         when Type_Summary_Section =>
            Put_Line (Self, "</TABLE>");
            Put_Line (Self, "</TD></TR>");
         when Type_Section =>
            if Self.In_Type then
               Put_Line (Self, "</TD></TR>");
            end if;
            Self.In_Type := False;
         when Operations_Section =>
            null;
         when Constants_Section |
              Variables_Section =>
            Self.In_Constants := False;
            Put_Line (Self, "</TABLE>");
            Put_Line (Self, "</TD></TR>");
         when Others_Section =>
            Close_Block (Self);
      end case;
   end Close_Section;

   procedure Open_Container
     (Self : access Printer;
      XRef : in     AD.Crossrefs.Cross_Reference;
      Kind : in     Item_Kind;
      Name : in     Wide_String := "")
   is
      pragma Warnings (Off, Kind); --  silence -gnatwa
      pragma Warnings (Off, Name); --  silence -gnatwa
      pragma Warnings (Off, XRef); --  silence -gnatwa
   begin
      if Self.Container_Level < 0 then
         Self.Container_Level := 1;
         if Self.First_In_Block (1) then
            Self.First_In_Block (1) := False;
         else
            Put_Line (Self, "<HR>");
         end if;
      else
         Put_Line (Self, "<TR><TD>");
         Self.Container_Level := Self.Container_Level + 1;
      end if;
      Put_Line
        (Self,
         "<TABLE WIDTH=""100%"" BORDER=1 CELLSPACING=0 CELLPADDING=0>");
      if Self.Container_Level = 1 then
         Put_Line (Self, "<TR><TD COLSPAN=2>");
         AD.HTML.Subtitle (Self.F.all, "Header");
         Put_Line (Self, "</TD></TR>");
      end if;
      Open_Block (Self);
      Self.In_Task :=
        Kind = A_Task or else Kind = A_Protected_Object or else
        Kind = A_Task_Type or else Kind = A_Protected_Type;
   end Open_Container;

   procedure Close_Container
     (Self    : access Printer;
      Is_Last : in     Boolean := False)
   is
   begin
      if Self.Container_Level > 0 then
         Put_Line (Self, "</TABLE>");
         Self.Container_Level := Self.Container_Level - 1;
         if Self.Container_Level > 0 then
            if not Is_Last then Put_Line (Self, "<HR>"); end if;
            Put_Line (Self, "</TD></TR>");
         end if;
      end if;
      Close_Block (Self);
      Self.In_Task := False;
   end Close_Container;

   procedure Open_Item
     (Self : access Printer;
      XRef : in     AD.Crossrefs.Cross_Reference;
      Kind : in     Item_Kind   := Not_An_Item;
      Name : in     Wide_String := "")
   is
      pragma Warnings (Off, Kind); --  silence -gnatwa
      pragma Warnings (Off, Name); --  silence -gnatwa
      pragma Warnings (Off, XRef); --  silence -gnatwa
   begin
      if Self.Container_Level < 0 then
         if Self.First_In_Block (1) then
            Self.First_In_Block (1) := False;
         else
            Put_Line (Self, "<HR>");
         end if;
         Put_Line (Self, "<H3 CLASS=""subtitle"">Header</H3>");
         --  Self.Force_Multiline := True;
         Self.Container_Level := 0;
      else
         if not Self.In_Constants then
            Put_Line (Self, "<TR><TD>");
            Put_Line
              (Self,
               "<TABLE WIDTH=""100%"" BORDER=0 CELLSPACING=0 CELLPADDING=0>");
         end if;
      end if;
   end Open_Item;

   procedure Close_Item
     (Self    : access Printer;
      Is_Last : in     Boolean := False)
   is
   begin
      if Self.Container_Level <= 0 then
         Self.Force_Multiline := False;
      else
         if not Self.In_Constants then
            Put_Line (Self, "</TABLE>");
            if not Is_Last then Put_Line (Self, "<HR>"); end if;
            Put_Line (Self, "</TD></TR>");
         end if;
      end if;
   end Close_Item;

   procedure Other_Declaration
     (Self : access Printer;
      XRef : in     AD.Crossrefs.Cross_Reference;
      Text : in     String)
   is
   begin
      New_Line (Self);
      Put (Self, Get_Comment (Before) &
           "--  " & AD.HTML.HTMLize (Text) & ": ");
      Put_XRef (Self, XRef);
      Put (Self, Get_Comment (After));
   end Other_Declaration;

   procedure Add_Child
     (Self       : access Printer;
      Kind       : in     Item_Kind;
      Is_Private : in     Boolean;
      XRef       : in     AD.Crossrefs.Cross_Reference)
   is
   begin
      Put (Self, "<TR><TD>");
      Put_XRef (Self, XRef);
      Put (Self, "</TD>");
      Put_Line (Self,
                "<TD>(" & To_Lower (Get_Description (Kind, Is_Private)) &
                ")</TD></TR>");
   end Add_Child;

   procedure Add_Exception
     (Self : access Printer;
      XRef : in     AD.Crossrefs.Cross_Reference)
   is
   begin
      if Self.First_In_Block (1) then
         Self.First_In_Block (1) := False;
      else
         Put (Self, ", ");
      end if;
      Put (Self, "<CODE>");
      Open_Anchor (Self, XRef);
      Put (Self, ACH.To_String (WASU.To_Wide_String (XRef.Image)));
      Close_Anchor (Self);
      Put (Self, "</CODE>");
   end Add_Exception;

   procedure Type_Name
     (Self : access Printer;
      XRef : in     AD.Crossrefs.Cross_Reference)
   is
   begin
      Put_XRef (Self, XRef);
      Self.Type_Has_Parent := False;
   end Type_Name;

   procedure Type_Kind
     (Self : access Printer;
      Info : in     String)
   is
   begin
      Put (Self, " (" & HTMLize (Info) & ')');
   end Type_Kind;

   procedure Parent_Type
     (Self : access Printer;
      XRef : in     AD.Crossrefs.Cross_Reference)
   is
   begin
      Put (Self, " derived from ");
      Put_XRef (Self, XRef);
      Self.Type_Has_Parent := True;
   end Parent_Type;

   procedure Open_Operation_List
     (Self : access Printer;
      Kind : in     Operation_Kind)
   is
   begin
      Put (Self, "<TR><TD VALIGN=""TOP"">");
      case Kind is
         when Overridden_Operation =>
            Put (Self, "Overridden&nbsp;Operations");
         when Own_Operation =>
            if Self.Type_Has_Parent then
               Put (Self, "New&nbsp;Operations");
            else
               Put (Self, "Primitive&nbsp;Operations");
            end if;
         when Inherited_Operation =>
            Put (Self, "Inherited&nbsp;Operations");
         when Inherited_Original_Operation =>
            Put (Self, "Original&nbsp;Operations");
      end case;
      Put_Line (Self, ":&nbsp;</TD><TD WIDTH=""100%"">");
      Open_Block (Self);
   end Open_Operation_List;

   procedure Close_Operation_List
     (Self : access Printer)
   is
   begin
      New_Line (Self); Put_Line (Self, "</TD></TR>");
      Close_Block (Self);
   end Close_Operation_List;

   procedure Add_Type_Operation
     (Self : access Printer;
      XRef : in     AD.Crossrefs.Cross_Reference)
   is
   begin
      if Self.First_In_Block (1) then
         Self.First_In_Block (1) := False;
      else
         Put_Line (Self, ",");
      end if;
      Put_XRef (Self, XRef);
   end Add_Type_Operation;

   procedure Add_Private
     (Self        : access Printer;
      For_Package : in     Boolean)
   is
   begin
      if not For_Package then
         if Self.Container_Level mod 2 = 0 then
            Put_Line (Self, "<TR><TD CLASS=""even"">");
         else
            Put_Line (Self, "<TR><TD CLASS=""odd"">");
         end if;
         Put (Self, "<CODE>");
         Dump (Self, "private");
         Put_Line (Self, "</CODE></TD></TR>");
         Put_Line (Self, "<TR><TD><HR></TD></TR>");
         Self.First_In_Block (1) := False;
      else
         if Self.First_In_Block (1) then
            Self.First_In_Block (1) := False;
         else
            Put_Line (Self, "<TR><TD><HR></TD></TR>");
         end if;
         Open_Section (Self, Snippet_Section);
         Dump (Self, "private");
         New_Line (Self, 2);
         Dump (Self, "   --  Implementation-defined ...");
         New_Line (Self);
         Close_Section (Self, Snippet_Section);
      end if;
   end Add_Private;

   procedure Open_XRef
     (Self     : access Printer;
      XRef     : in     AD.Crossrefs.Cross_Reference)
   is
   begin
      Open_XRef (Self, XRef, False);
   end Open_XRef;

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

   procedure Open_Anchor
     (Self : access Printer;
      XRef : in     AD.Crossrefs.Cross_Reference)
   is
   begin
      Put (Self,
           "<A NAME=""" &
           To_String (XRef.Position, Full_Crossrefs) & """>" &
           Get_Definition (Before));
   end Open_Anchor;

   procedure Close_Anchor
     (Self : access Printer)
   is
   begin
      Put (Self, Get_Definition (After) & "</A>");
   end Close_Anchor;

   procedure Inline_Error
     (Self : access Printer;
      Msg  : in     String)
   is
   begin
      Put (Self, "<!-- " & HTMLize (Msg) & " -->");
   end Inline_Error;

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

   procedure Write_Keyword
     (Self : access Printer;
      S    : in     String)
   is
   begin
      Put (Self, Get_Keyword (Before) & HTMLize (S) & Get_Keyword (After));
   end Write_Keyword;

   procedure Write_Literal
     (Self : access Printer;
      S    : in     String)
   is
   begin
      Put (Self, Get_Literal (Before) & HTMLize (S) & Get_Literal (After));
   end Write_Literal;

   procedure Write_Attribute
     (Self : access Printer;
      S    : in     String)
   is
   begin
      Put
        (Self, Get_Attribute (Before) & To_Mixed (S) & Get_Attribute (After));
   end Write_Attribute;

   procedure Write_Comment
     (Self : access Printer;
      S    : in     String)
   is
   begin
      Put (Self,
           Get_Comment (Before) & AD.Format.Format (S) & Get_Comment (After));
   end Write_Comment;

   procedure Write
     (Self : access Printer;
      S    : in     String)
   is
   begin
      Put (Self, HTMLize (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>" & HTMLize (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
   begin
      begin
         Open_File
           (Self.all, AD.Options.Multiple_Files,
            Util.Pathes.Replace_Extension (File_Name, HTML_Suffix), False);
      exception
         when E : others =>
            AD.Messages.Error (Ada.Exceptions.Exception_Message (E));
      end;
      if Is_Open (Self.all) then
         AD.HTML.Header (Self.F.all, Title);
         Self.Index_Chars := Present;
      end if;
      Self.Is_Unit := False;
   end Open_Index;

   procedure Close_Index
     (Self : access Printer)
   is
   begin
      if Is_Open (Self.all) then
         if Self.Char_Section_Open then
            Close_Char_Section (Self);
         end if;
         AD.HTML.Footer (Self.F.all);
         Close_File (Self.all);
      end if;
   end Close_Index;

   procedure XRef_Index
     (Self      : access Printer;
      File_Name : in     String;
      Title     : in     String)
   is
   begin
      if Self.First_Index then
         Put_Line (Self, "<P>");
      --  else
      --     Put (Self, "<BR>");
      end if;
      Put_Line
        (Self, " <A HREF=""" &
         Util.Pathes.Replace_Extension (File_Name, HTML_Suffix) &
         """>" & AD.HTML.HTMLize (Title) & "</A>");
      Self.First_Index := False;
   end XRef_Index;

   procedure Open_Char_Section
     (Self : access Printer;
      Char : in     Character)
   is
   begin
      if Char = '"' then
         Put_Line
           (Self, "<H3><A NAME=""operators"">Operators</A></H3>");
      else
         Put_Line
           (Self, "<H3><A NAME=""" & Char & """>" & Char & "</A></H3>");
      end if;
      Self.Char_Section_Open := True;
      Self.First_Index       := True;
   end Open_Char_Section;

   procedure Close_Char_Section
     (Self : access Printer)
   is
   begin
      if Self.Idx_Structures = 0 then
         if not Self.First_Index then
            Put_Line (Self, "</P>");
         end if;
      else
         while Self.Idx_Structures > 0 loop
            Close_Index_Structure (Self);
         end loop;
      end if;
      Self.Char_Section_Open := False;
   end Close_Char_Section;

   procedure Open_Index_Structure
     (Self : access Printer)
   is
   begin
      Put_Line (Self, "<UL CLASS=""index"">");
      Self.Idx_Structures := Self.Idx_Structures + 1;
   end Open_Index_Structure;

   procedure Close_Index_Structure
     (Self : access Printer)
   is
   begin
      if Self.Idx_Structures > 0 then
         Put_Line (Self, "</UL>");
         Self.Idx_Structures := Self.Idx_Structures - 1;
      end if;
   end Close_Index_Structure;

   procedure Open_Index_Item
     (Self : access Printer)
   is
   begin
      if Self.Idx_Structures > 0 then
         Put (Self, "<LI>");
      else
         if Self.First_Index then
            Put_Line (Self, "<P>");
         end if;
      end if;
      Self.First_Index := False;
   end Open_Index_Item;

   procedure Close_Index_Item
     (Self : access Printer)
   is
   begin
      if Self.Idx_Structures = 0 then
         Put_Line (Self, "<BR>");
      else
         New_Line (Self);
      end if;
   end Close_Index_Item;

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

   procedure Finalize
     (Self : in out Printer)
   is
   begin
      if Self.First_In_Block /= null then
         Free (Self.First_In_Block);
      end if;
      Finalize (Real_Printer (Self));
   end Finalize;

end AD.Printers.HTML;
