-------------------------------------------------------------------------------
--
--  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-JUL-2003   TW  Complete rewrite of the indexing stuff.
-- -->
-------------------------------------------------------------------------------

pragma License (GPL);

with Ada.Exceptions;
with Ada.Text_IO;

with Asis.Declarations;
with Asis.Elements;
with Asis.Text;

with AD.File_Ops;
with AD.Messages;
with AD.Syntax;

with Util.Files;
with Util.Pathes;
with Util.Strings;

package body AD.Printers is

   use Asis.Declarations;
   use Asis.Elements;
   use Asis;

   use Util.Strings;

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

   function To_String
     (Pos  : in Asis2.Spans.Position;
      Full : in Boolean)
     return String
   is
   begin
      if Full then
         return Trim (Asis.Text.Line_Number'Image (Pos.Line)) &
                '_' &
                Trim (Asis.Text.Character_Position'Image (Pos.Column));
      else
         return Trim (Asis.Text.Line_Number'Image (Pos.Line));
      end if;
   end To_String;

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

   procedure Set_Line_Only
   is
   begin
      Full_Crossrefs := False;
      AD.Messages.Warn
        ("-l option given: cross-references use only the line number.");
   end Set_Line_Only;

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

   function Get_Item_Kind
     (Item : in Asis.Element)
     return Item_Kind
   is
      function In_PO
        (Decl : in Asis.Declaration)
        return Boolean
      is
         Encl  : Asis.Element := Decl;
      begin
         --  Loop until we either hit a nil element or a declaration.
         loop
            Encl := Enclosing_Element (Encl);
            exit when Is_Nil (Encl);
            case Declaration_Kind (Encl) is
               when Not_A_Declaration =>
                  null;
               when A_Protected_Type_Declaration |
                    A_Single_Protected_Declaration |
                    A_Task_Type_Declaration |
                    A_Single_Task_Declaration =>
                  return True;
               when others =>
                  exit;
            end case;
         end loop;
         return False;
      end In_PO;

   begin
      case Declaration_Kind (Item) is
         when Not_A_Declaration =>
            --  It had better be a pragma! (What about rep clauses?)
            --  We also have use clauses here...
            case Element_Kind (Item) is
               when Asis.A_Pragma =>
                  return AD.Printers.A_Pragma;
               when Asis.A_Clause =>
                  case Clause_Kind (Item) is
                     when A_Use_Package_Clause =>
                        return A_Use_Clause;
                     when Asis.A_Use_Type_Clause =>
                        return AD.Printers.A_Use_Type_Clause;
                     when others =>
                        return Not_An_Item;
                  end case;
               when others =>
                  return Not_An_Item;
            end case;

         when A_Procedure_Declaration =>
            if In_PO (Item) then
               return A_Protected_Procedure;
            else
               return A_Procedure;
            end if;

         when A_Function_Declaration =>
            if In_PO (Item) then
               return A_Protected_Function;
            else
               return A_Function;
            end if;

         when An_Entry_Declaration =>
            return An_Entry;

         when A_Package_Declaration =>
            return A_Package;

         when A_Generic_Package_Declaration =>
            declare
               Visible_Stuff : constant Declaration_List :=
                 Visible_Part_Declarative_Items (Item);
            begin
               if Visible_Stuff'Last < Visible_Stuff'First then
                  return A_Generic_Signature_Package;
               else
                  return A_Generic_Package;
               end if;
            end;

         when A_Generic_Procedure_Declaration =>
            return A_Generic_Procedure;

         when A_Generic_Function_Declaration =>
            return A_Generic_Function;

         when Asis.A_Package_Instantiation =>
            return AD.Printers.A_Package_Instantiation;

         when Asis.A_Procedure_Instantiation =>
            return AD.Printers.A_Procedure_Instantiation;

         when Asis.A_Function_Instantiation =>
            return AD.Printers.A_Function_Instantiation;

         when A_Package_Renaming_Declaration =>
            return A_Package_Renaming;

         when A_Procedure_Renaming_Declaration =>
            return A_Procedure_Renaming;

         when A_Function_Renaming_Declaration =>
            return A_Function_Renaming;

         when A_Generic_Package_Renaming_Declaration =>
            return A_Generic_Package_Renaming;

         when A_Generic_Procedure_Renaming_Declaration =>
            return A_Generic_Procedure_Renaming;

         when A_Generic_Function_Renaming_Declaration =>
            return A_Generic_Function_Renaming;

         when A_Task_Type_Declaration =>
            return A_Task_Type;

         when A_Single_Task_Declaration =>
            return A_Task;

         when A_Protected_Type_Declaration =>
            return A_Protected_Type;

         when A_Single_Protected_Declaration =>
            return A_Protected_Object;

         when A_Subtype_Declaration =>
            return A_Subtype;

         when An_Ordinary_Type_Declaration |
              An_Incomplete_Type_Declaration |
              A_Private_Type_Declaration |
              A_Private_Extension_Declaration =>
            return A_Type;

         when A_Variable_Declaration =>
            return A_Variable;

         when A_Constant_Declaration |
              An_Integer_Number_Declaration |
              A_Real_Number_Declaration =>
            return A_Constant;

         when A_Deferred_Constant_Declaration =>
            return A_Deferred_Constant;

         when An_Object_Renaming_Declaration =>
            return An_Object_Renaming;

         when An_Exception_Renaming_Declaration =>
            return An_Exception_Renaming;

         when An_Exception_Declaration =>
            return An_Exception;

         when others =>
            return Not_An_Item;

      end case;
   end Get_Item_Kind;

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

      Tmp       : String (Line'First ..
                          Line'Last + AD.Syntax.Max_Keyword_Length + 1);
      Last_Char : Character;
      I         : Positive;
      Start     : Natural;
      Stop      : Natural;
   begin
      --  'Tmp' is a lower-case copy of 'Line' with extra padding characters at
      --  the end. It serves to simplify 'Find_Keyword': it doesn't have to
      --  worry about casing, and it can also ignore overflow problems.
      for I in Line'Range loop
         Tmp (I) := To_Lower (Line (I));
      end loop;
      for I in Line'Last + 1 .. Tmp'Last loop
         Tmp (I) := ' ';
      end loop;
      Last_Char := ' ';
      I := Line'First;
      while I <= Line'Last loop
         AD.Syntax.Find_Keyword
           (Tmp (I .. Tmp'Last), Last_Char, Line'Last, Start, Stop);
         if Start = 0 then
            Write (Self, Line (I .. Line'Last));
            return;
         end if;
         if Start > I then
            Write (Self, Line (I .. Start - 1));
         end if;
         if Tmp (Start .. Stop) = "--" then
            --  We have a comment!!
            Write_Comment (Self, Line (Start .. Line'Last));
            exit;
         elsif Tmp (Start) = '"' or Tmp (Start) = ''' then
            --  A string or character literal.
            Write_Literal (Self, Line (Start .. Stop));
         else
            --  A real keyword. Write 'Tmp', not 'Line': this makes all
            --  keywords lowercase for free!
            Write_Keyword (Self, Tmp (Start .. Stop));
         end if;
         Last_Char := Tmp (Stop); I := Stop + 1;
      end loop;
   end Dump;

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

   procedure Open_File
     (Self        : in out Real_Printer;
      Mode        : in     AD.Options.File_Handling;
      File_Name   : in     String;
      Use_Default : in     Boolean := True)
   is
      use type Ada.Text_IO.File_Access;
      use type AD.Options.File_Handling;

      procedure Open
        (File : in out Ada.Text_IO.File_Type;
         Name : in     String)
      is
         procedure Open is
            new Util.Files.Open_G
                  (Ada.Text_IO.File_Type, Ada.Text_IO.File_Mode,
                   Ada.Text_IO.Open, Ada.Text_IO.Create);
      begin
         if not AD.Options.Allow_Overwrite and then
            AD.File_Ops.Exists (Name)
         then
            Ada.Exceptions.Raise_Exception
              (Cannot_Overwrite'Identity,
               "Mustn't write to file """ & Name & """.");
         end if;
         begin
            Open (File, Ada.Text_IO.Out_File, Name);
         exception
            when others =>
               Ada.Exceptions.Raise_Exception
                 (Open_Failed'Identity,
                  "Cannot write to file """ & Name & """.");
         end;
      end Open;

   begin
      if Self.F /= null then Close_File (Self); end if;
      if Use_Default then
         Try_Name :
         declare
            Name : constant String := AD.Options.Output_Name;
         begin
            if Name = "-" then
               --  Output on stdout:
               Self.F := Ada.Text_IO.Current_Output;
               return;
            end if;
            if Name'Last >= Name'First and then
               Mode = AD.Options.Single_File
            then
               --  Not stdout: first try 'Name', if that fails, try 'File_Name'
               begin
                  Open (Self.File,
                        Util.Pathes.Replace_Extension
                          (Name, Get_Suffix (Real_Printer'Class (Self))));
               exception
                  when E : others =>
                     if File_Name'Last >= File_Name'First then
                        AD.Messages.Warn
                          (Ada.Exceptions.Exception_Message (E));
                     else
                        raise;
                     end if;
               end;
            end if;
         end Try_Name;
      end if;
      if not Ada.Text_IO.Is_Open (Self.File) then
         --  Ok, it's not stdout, and either we have no name or we failed to
         --  open file 'Name', or we're in multi-file mode: open a file
         --  'File_Name' in the specified directory.
         if File_Name = "-" then
            Self.F := Ada.Text_IO.Current_Output;
            return;
         end if;
         if Util.Pathes.Path (File_Name) /= "" then
            --  The given File_Name *does* have a path itself: use that!
            Open
              (Self.File,
               Util.Pathes.Replace_Extension
                 (File_Name, Get_Suffix (Real_Printer'Class (Self))));
         else
            --  'File_Name' is a simple file: prepend the default output
            --  directory.
            Open
              (Self.File,
               Util.Pathes.Concat
                 (AD.Options.Output_Directory,
                  Util.Pathes.Replace_Extension
                    (File_Name, Get_Suffix (Real_Printer'Class (Self)))));
         end if;
      end if;
      --  Here, Self.File is open.
      Self.F := Ada.Text_IO.File_Access'(Self.File'Unchecked_Access);
   end Open_File;

   function Is_Open
     (Self : in Real_Printer)
     return Boolean
   is
      use type Ada.Text_IO.File_Access;
   begin
      return Self.F /= null;
   end Is_Open;

   procedure Close_File
     (Self : in out Real_Printer)
   is
   begin
      if Ada.Text_IO.Is_Open (Self.File) then
         Ada.Text_IO.Close (Self.File);
      end if;
      Self.F := null;
   end Close_File;

   procedure Put
     (Self : access Real_Printer;
      Ch   : in     Character)
   is
   begin
      if Self.Use_Buffer then
         Util.Text.Append (Self.Buffer, Ch);
      else
         Ada.Text_IO.Put (Self.F.all, Ch);
      end if;
   end Put;

   procedure Put
     (Self : access Real_Printer;
      S    : in     String)
   is
   begin
      if Self.Use_Buffer then
         Util.Text.Append (Self.Buffer, S);
      else
         Ada.Text_IO.Put (Self.F.all, S);
      end if;
   end Put;

   procedure Put_Line
     (Self : access Real_Printer;
      S    : in     String)
   is
   begin
      Put_Line (Self.all, S);
   end Put_Line;

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

   is
   begin
      if Self.Use_Buffer then
         Util.Text.Append (Self.Buffer, S & ASCII.LF);
      else
         Ada.Text_IO.Put_Line (Self.F.all, S);
      end if;
   end Put_Line;

   procedure New_Line
     (Self : access Real_Printer;
      N    : in     Positive := 1)
   is
   begin
      if Self.Use_Buffer then
         declare
            Line_Feeds : constant String (1 .. N) := (others => ASCII.LF);
         begin
            Util.Text.Append (Self.Buffer, Line_Feeds);
         end;
      else
         Ada.Text_IO.New_Line (Self.F.all, Ada.Text_IO.Positive_Count (N));
      end if;
   end New_Line;

   procedure Finalize
     (Self : in out Real_Printer)
   is
   begin
      Close_File (Self);
   exception
      when others =>
         null;
   end Finalize;

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

   function "+"
     (Left, Right : in Printer_Ref)
     return Printer_Ref
   is
   begin
      if Left = null then
         return Right;
      elsif Right = null then
         return Left;
      else
         declare
            P : constant Printer_Ref := new Composer;
         begin
            Composer (P.all).Left  := Left;
            Composer (P.all).Right := Right;
            return P;
         end;
      end if;
   end "+";

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

   function Is_Open
     (Self : in Composer)
     return Boolean
   is
   begin
      return Is_Open (Self.Left.all) or else Is_Open (Self.Right.all);
   end Is_Open;

   procedure Finalize
     (Self : in out Composer)
   is
   begin
      if Self.Left /= null then
         Free (Self.Left);
      end if;
      if Self.Right /= null then
         Free (Self.Right);
      end if;
      --  A composer has no open files, so no need to close the output!
   end Finalize;

   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)
   is
   begin
      Open_Unit (Self.Left, Unit_Kind, Unit_Name, Is_Private, XRef);
      Self.Left_Open := Is_Open (Self.Left.all);
      Open_Unit (Self.Right, Unit_Kind, Unit_Name, Is_Private, XRef);
      Self.Right_Open := Is_Open (Self.Right.all);
   end Open_Unit;

   procedure Close_Unit
     (Self : access Composer)
   is
   begin
      if Self.Left_Open then
         Close_Unit (Self.Left);
      end if;
      if Self.Right_Open then
         Close_Unit (Self.Right);
      end if;
   end Close_Unit;

   procedure Write_Comment
     (Self  : access Composer;
      Lines : in     Asis.Text.Line_List)
   is
   begin
      if Self.Left_Open then
         Write_Comment (Self.Left, Lines);
      end if;
      if Self.Right_Open then
         Write_Comment (Self.Right, Lines);
      end if;
   end Write_Comment;

   procedure Open_Section
     (Self    : access Composer;
      Section : in     Section_Type)
   is
   begin
      if Self.Left_Open then
         Open_Section (Self.Left, Section);
      end if;
      if Self.Right_Open then
         Open_Section (Self.Right, Section);
      end if;
   end Open_Section;

   procedure Close_Section
     (Self    : access Composer;
      Section : in     Section_Type)
   is
   begin
      if Self.Left_Open then
         Close_Section (Self.Left, Section);
      end if;
      if Self.Right_Open then
         Close_Section (Self.Right, Section);
      end if;
   end Close_Section;

   procedure Open_Item
     (Self : access Composer;
      XRef : in     AD.Crossrefs.Cross_Reference;
      Kind : in     Item_Kind   := Not_An_Item;
      Name : in     Wide_String := "")
   is
   begin
      if Self.Left_Open then
         Open_Item (Self.Left, XRef, Kind, Name);
      end if;
      if Self.Right_Open then
         Open_Item (Self.Right, XRef, Kind, Name);
      end if;
   end Open_Item;

   procedure Close_Item
     (Self    : access Composer;
      Is_Last : in     Boolean := False)
   is
   begin
      if Self.Left_Open then
         Close_Item (Self.Left, Is_Last);
      end if;
      if Self.Right_Open then
         Close_Item (Self.Right, Is_Last);
      end if;
   end Close_Item;

   procedure Other_Declaration
     (Self : access Composer;
      XRef : in     AD.Crossrefs.Cross_Reference;
      Text : in     String)
   is
   begin
      if Self.Left_Open then
         Other_Declaration (Self.Left, XRef, Text);
      end if;
      if Self.Right_Open then
         Other_Declaration (Self.Right, XRef, Text);
      end if;
   end Other_Declaration;

   procedure Open_Container
     (Self : access Composer;
      XRef : in     AD.Crossrefs.Cross_Reference;
      Kind : in     Item_Kind;
      Name : in     Wide_String := "")
   is
   begin
      if Self.Left_Open then
         Open_Container (Self.Left, XRef, Kind, Name);
      end if;
      if Self.Right_Open then
         Open_Container (Self.Right, XRef, Kind, Name);
      end if;
   end Open_Container;

   procedure Close_Container
     (Self    : access Composer;
      Is_Last : in     Boolean := False)
   is
   begin
      if Self.Left_Open then
         Close_Container (Self.Left, Is_Last);
      end if;
      if Self.Right_Open then
         Close_Container (Self.Right, Is_Last);
      end if;
   end Close_Container;

   procedure Add_Child
     (Self       : access Composer;
      Kind       : in     Item_Kind;
      Is_Private : in     Boolean;
      XRef       : in     AD.Crossrefs.Cross_Reference)
   is
   begin
      if Self.Left_Open then
         Add_Child (Self.Left, Kind, Is_Private, XRef);
      end if;
      if Self.Right_Open then
         Add_Child (Self.Right, Kind, Is_Private, XRef);
      end if;
   end Add_Child;

   procedure Add_Exception
     (Self : access Composer;
      XRef : in     AD.Crossrefs.Cross_Reference)
   is
   begin
      if Self.Left_Open then
         Add_Exception (Self.Left, XRef);
      end if;
      if Self.Right_Open then
         Add_Exception (Self.Right, XRef);
      end if;
   end Add_Exception;

   procedure Type_Name
     (Self : access Composer;
      XRef : in     AD.Crossrefs.Cross_Reference)
   is
   begin
      if Self.Left_Open then
         Type_Name (Self.Left, XRef);
      end if;
      if Self.Right_Open then
         Type_Name (Self.Right, XRef);
      end if;
   end Type_Name;

   procedure Type_Kind
     (Self : access Composer;
      Info : in     String)
   is
   begin
      if Self.Left_Open then
         Type_Kind (Self.Left, Info);
      end if;
      if Self.Right_Open then
         Type_Kind (Self.Right, Info);
      end if;
   end Type_Kind;

   procedure Parent_Type
     (Self : access Composer;
      XRef : in     AD.Crossrefs.Cross_Reference)
   is
   begin
      if Self.Left_Open then
         Parent_Type (Self.Left, XRef);
      end if;
      if Self.Right_Open then
         Parent_Type (Self.Right, XRef);
      end if;
   end Parent_Type;

   procedure Open_Operation_List
     (Self : access Composer;
      Kind : in     Operation_Kind)
   is
   begin
      if Self.Left_Open then
         Open_Operation_List (Self.Left, Kind);
      end if;
      if Self.Right_Open then
         Open_Operation_List (Self.Right, Kind);
      end if;
   end Open_Operation_List;

   procedure Close_Operation_List
     (Self : access Composer)
   is
   begin
      if Self.Left_Open then
         Close_Operation_List (Self.Left);
      end if;
      if Self.Right_Open then
         Close_Operation_List (Self.Right);
      end if;
   end Close_Operation_List;

   procedure Add_Type_Operation
     (Self : access Composer;
      XRef : in     AD.Crossrefs.Cross_Reference)
   is
   begin
      if Self.Left_Open then
         Add_Type_Operation (Self.Left, XRef);
      end if;
      if Self.Right_Open then
         Add_Type_Operation (Self.Right, XRef);
      end if;
   end Add_Type_Operation;

   procedure Add_Private
     (Self        : access Composer;
      For_Package : in     Boolean)
   is
   begin
      if Self.Left_Open then
         Add_Private (Self.Left, For_Package);
      end if;
      if Self.Right_Open then
         Add_Private (Self.Right, For_Package);
      end if;
   end Add_Private;

   procedure Open_Anchor
     (Self : access Composer;
      XRef : in     AD.Crossrefs.Cross_Reference)
   is
   begin
      if Self.Left_Open then
         Open_Anchor (Self.Left, XRef);
      end if;
      if Self.Right_Open then
         Open_Anchor (Self.Right, XRef);
      end if;
   end Open_Anchor;

   procedure Close_Anchor
     (Self : access Composer)
   is
   begin
      if Self.Left_Open then
         Close_Anchor (Self.Left);
      end if;
      if Self.Right_Open then
         Close_Anchor (Self.Right);
      end if;
   end Close_Anchor;

   procedure Open_XRef
     (Self : access Composer;
      XRef : in     AD.Crossrefs.Cross_Reference)
   is
   begin
      if Self.Left_Open then
         Open_XRef (Self.Left, XRef);
      end if;
      if Self.Right_Open then
         Open_XRef (Self.Right, XRef);
      end if;
   end Open_XRef;

   procedure Close_XRef
     (Self : access Composer)
   is
   begin
      if Self.Left_Open then
         Close_XRef (Self.Left);
      end if;
      if Self.Right_Open then
         Close_XRef (Self.Right);
      end if;
   end Close_XRef;

   procedure Put_XRef
     (Self     : access Composer;
      XRef     : in     AD.Crossrefs.Cross_Reference;
      Code     : in     Boolean := True;
      Is_Index : in     Boolean := False)
   is
   begin
      if Self.Left_Open then
         Put_XRef (Self.Left, XRef, Code, Is_Index);
      end if;
      if Self.Right_Open then
         Put_XRef (Self.Right, XRef, Code, Is_Index);
      end if;
   end Put_XRef;

   procedure Inline_Error
     (Self : access Composer;
      Msg  : in     String)
   is
   begin
      if Self.Left_Open then
         Inline_Error (Self.Left, Msg);
      end if;
      if Self.Right_Open then
         Inline_Error (Self.Right, Msg);
      end if;
   end Inline_Error;

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

   procedure Write_Keyword
     (Self : access Composer;
      S    : in     String)
   is
   begin
      if Self.Left_Open then
         Write_Keyword (Self.Left, S);
      end if;
      if Self.Right_Open then
         Write_Keyword (Self.Right, S);
      end if;
   end Write_Keyword;

   procedure Write_Literal
     (Self : access Composer;
      S    : in     String)
   is
   begin
      if Self.Left_Open then
         Write_Literal (Self.Left, S);
      end if;
      if Self.Right_Open then
         Write_Literal (Self.Right, S);
      end if;
   end Write_Literal;

   procedure Write_Attribute
     (Self : access Composer;
      S    : in     String)
   is
   begin
      if Self.Left_Open then
         Write_Attribute (Self.Left, S);
      end if;
      if Self.Right_Open then
         Write_Attribute (Self.Right, S);
      end if;
   end Write_Attribute;

   procedure Write_Comment
     (Self : access Composer;
      S    : in     String)
   is
   begin
      if Self.Left_Open then
         Write_Comment (Self.Left, S);
      end if;
      if Self.Right_Open then
         Write_Comment (Self.Right, S);
      end if;
   end Write_Comment;

   procedure Write
     (Self : access Composer;
      S    : in     String)
   is
   begin
      if Self.Left_Open then
         Write (Self.Left, S);
      end if;
      if Self.Right_Open then
         Write (Self.Right, S);
      end if;
   end Write;

   procedure Write_Plain
     (Self : access Composer;
      S    : in     String)
   is
   begin
      if Self.Left_Open then
         Write_Plain (Self.Left, S);
      end if;
      if Self.Right_Open then
         Write_Plain (Self.Right, S);
      end if;
   end Write_Plain;

   procedure Write_Code
     (Self : access Composer;
      S    : in     String)
   is
   begin
      if Self.Left_Open then
         Write_Code (Self.Left, S);
      end if;
      if Self.Right_Open then
         Write_Code (Self.Right, S);
      end if;
   end Write_Code;

   procedure New_Line
     (Self : access Composer;
      N    : in     Positive := 1)
   is
   begin
      if Self.Left_Open then
         New_Line (Self.Left, N);
      end if;
      if Self.Right_Open then
         New_Line (Self.Right, N);
      end if;
   end New_Line;

   procedure Open_Index
     (Self      : access Composer;
      File_Name : in     String;
      Title     : in     String;
      Present   : in     Ada.Strings.Maps.Character_Set)
   is
   begin
      Open_Index (Self.Left, File_Name, Title, Present);
      Self.Left_Open := Is_Open (Self.Left.all);
      Open_Index (Self.Right, File_Name, Title, Present);
      Self.Right_Open := Is_Open (Self.Right.all);
   end Open_Index;

   procedure Close_Index
     (Self : access Composer)
   is
   begin
      Close_Index (Self.Left);
      Close_Index (Self.Right);
   end Close_Index;

   procedure XRef_Index
     (Self      : access Composer;
      File_Name : in     String;
      Title     : in     String)
   is
   begin
      if Self.Left_Open then
         XRef_Index (Self.Left, File_Name, Title);
      end if;
      if Self.Right_Open then
         XRef_Index (Self.Right, File_Name, Title);
      end if;
   end XRef_Index;

   procedure Open_Char_Section
     (Self : access Composer;
      Char : in     Character)
   is
   begin
      if Self.Left_Open then
         Open_Char_Section (Self.Left, Char);
      end if;
      if Self.Right_Open then
         Open_Char_Section (Self.Right, Char);
      end if;
   end Open_Char_Section;

   procedure Close_Char_Section
     (Self : access Composer)
   is
   begin
      if Self.Left_Open then
         Close_Char_Section (Self.Left);
      end if;
      if Self.Right_Open then
         Close_Char_Section (Self.Right);
      end if;
   end Close_Char_Section;

   procedure Open_Index_Structure
     (Self : access Composer)
   is
   begin
      if Self.Left_Open then
         Open_Index_Structure (Self.Left);
      end if;
      if Self.Right_Open then
         Open_Index_Structure (Self.Right);
      end if;
   end Open_Index_Structure;

   procedure Close_Index_Structure
     (Self : access Composer)
   is
   begin
      if Self.Left_Open then
         Close_Index_Structure (Self.Left);
      end if;
      if Self.Right_Open then
         Close_Index_Structure (Self.Right);
      end if;
   end Close_Index_Structure;

   procedure Open_Index_Item
     (Self : access Composer)
   is
   begin
      if Self.Left_Open then
         Open_Index_Item (Self.Left);
      end if;
      if Self.Right_Open then
         Open_Index_Item (Self.Right);
      end if;
   end Open_Index_Item;

   procedure Close_Index_Item
     (Self : access Composer)
   is
   begin
      if Self.Left_Open then
         Close_Index_Item (Self.Left);
      end if;
      if Self.Right_Open then
         Close_Index_Item (Self.Right);
      end if;
   end Close_Index_Item;

end AD.Printers;