-------------------------------------------------------------------------------
--
--  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>
--   Formatted output of comments. Note that user-defined tags may be defined
--   in terms of other user-defined tags: we do macro expansion here. However,
--   since we neither do re-scanning (as does e.g. the C pre-processor) nor
--   have macro arguments, this macro substitution remains rather simple.</DL>
--
-- <!--
-- Revision History
--
--   29-APR-2002   TW  Initial version.
--   17-JUN-2002   TW  Complete rewrite to use the new filters.
--   18-JUN-2002   TW  Stripping initial and trailing dash-only line now.
--   09-JUL-2003   TW  Added the 'Format' function for formatting inline
--                     comments (i.e. comments within code snippets).
-- -->
-------------------------------------------------------------------------------

pragma License (GPL);

with Ada.Characters.Handling;
with Ada.Unchecked_Deallocation;

with AD.Filters;
--  with AD.Messages;

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

package body AD.Format is

   package UT  renames Util.Text;

   --  use AD.Messages;

   type Node;
   type Link is access Node;
   type Node is
      record
         Next    : Link;
         Name    : UT.String_Access;
         Program : AD.Filters.Filter_Ref;
      end record;

   procedure Free is
      new Ada.Unchecked_Deallocation (Node, Link);

   procedure Free is
      new Ada.Unchecked_Deallocation (String, UT.String_Access);

   Anchor, Last : Link;

   procedure Enter
     (Key    : in String;
      Filter : in AD.Filters.Filter_Ref)
   is
      P : Link := Anchor;
      Q : Link := null;

      use type AD.Filters.Filter_Ref;
   begin
      while P /= null and then P.Name'Length > Key'Length loop
         Q := P; P := P.Next;
      end loop;
      while P /= null and then P.Name'Length = Key'Length and then
            P.Name.all /= Key
      loop
         Q := P; P := P.Next;
      end loop;
      if P /= null and then P.Name'Length = Key'Length then
         --  We already have that key:
         AD.Filters.Free (P.Program);
         if Filter = null then
            if Key = "--" then
               --  Removing the default formatting is not allowed!!
               P.Program := new AD.Filters.Filter_Standard;
            else
               --  Oh, we need to remove that key!
               if Q /= null then
                  Q.Next := P.Next;
               else
                  Anchor := P.Next;
               end if;
               if P = Last then Last := Q; end if;
               Free (P.Name);
               Free (P);
            end if;
         else
            P.Program := Filter;
         end if;
      elsif Filter /= null then
         --  We don't have that key yet:
         P := new Node'(P, new String'(Key), Filter);
         if Q = null then
            Anchor := P;
         else
            Q.Next := P;
         end if;
         if Last = Q then Last := P; end if;
      end if;
   end Enter;

   procedure Format
     (Lines       : in     Asis.Text.Line_List;
      The_Printer : access AD.Printers.Printer'Class)
   is
      use Asis.Text;
      use Util.Strings;
      use Ada.Characters.Handling;

      function Longest_Matching_Prefix
        (S : in String)
        return Link
      is
         --  We'll always find something; at the very least the "--" filter.
         P : Link := Anchor;
      begin
         while P /= null and then not Is_Prefix (S, P.Name.all) loop
            P := P.Next;
         end loop;
         return P;
      end Longest_Matching_Prefix;

      procedure Append
        (Line        : in     String;
         Prefix      : in     Link;
         Text        : in out UT.Unbounded_String;
         Skip_Dashes : in     Boolean)
      is
         First : constant Natural := Line'First + Prefix.Name'Length;
         Last  : Natural;
      begin
         if Line'Length >= Prefix.Name'Length + 3 and then
            Line (Line'Last - 2 .. Line'Last) = " --"
         then
            Last := Line'Last - 3;
         else
            Last := Line'Last;
         end if;
         if Skip_Dashes then
            declare
               I : Natural := First;
            begin
               while I <= Last and then Line (I) = '-' loop
                  I := I + 1;
               end loop;
               if I > Last then return; end if;
            end;
         end if;
         while Last >= First and then Is_Blank (Line (Last)) loop
            Last := Last - 1;
         end loop;
         UT.Append (Text, Line (First .. Last) & ASCII.LF);
      end Append;

      Text       : UT.Unbounded_String;
      First_Line : Asis.Text.Line_Number;

      use type Asis.Text.Line_Number;

   begin
      --  Split into blocks.
      First_Line := Lines'First;
      while First_Line <= Lines'Last loop
         Text := UT.Null_Unbounded_String;
         declare
            Prefix : constant Link :=
              Longest_Matching_Prefix
                (Trim (To_String (Comment_Image (Lines (First_Line)))));
         begin
            while First_Line <= Lines'Last loop
               declare
                  S : constant String :=
                    Trim (To_String (Comment_Image (Lines (First_Line))));
               begin
                  --  Debug (S);
                  if Is_Prefix (S, Prefix.Name.all) and then
                     Longest_Matching_Prefix (S) = Prefix
                  then
                     --  This line belongs to the same block.
                     Append (S, Prefix, Text,
                             First_Line = Lines'First or else
                             First_Line = Lines'Last);
                  else
                     exit;
                  end if;
               end;
               First_Line := First_Line + 1;
            end loop;
            --  All right, we have our text block. Now format it:
            AD.Filters.Transform (Prefix.Program, Text);
            --  And then write it to the file:
            declare
               Src : constant UT.String_Access := UT.Internal.Get_Ptr (Text);
               I   : Natural := Src'First;
               J   : Natural;
            begin
               while I <= Src'Last loop
                  J := First_Index (Src (I .. Src'Last), ASCII.LF);
                  if J = 0 then
                     AD.Printers.Write_Plain
                       (The_Printer, Src (I .. Src'Last));
                     exit;
                  else
                     AD.Printers.Write_Plain
                       (The_Printer, Src (I .. J - 1));
                     AD.Printers.New_Line (The_Printer);
                     I := J + 1;
                  end if;
               end loop;
            end;
         end;
      end loop;
   end Format;

   function Format
     (Inline_Comment : in String)
     return String
   is
      Only_Legal : aliased AD.Filters.Filter_Unknown (True);
      Shortcuts  : aliased AD.Filters.Filter_Shortcut;
      HTMLize    : aliased AD.Filters.Filter_Plain;
      Text       : UT.Unbounded_String;
      Start      : Natural;
      First_Char : Natural;

      use Util.Strings;

   begin
      if Inline_Comment'Length <= 2 then return Inline_Comment; end if;
      if Is_Prefix (Inline_Comment, "--") then
         Start := Inline_Comment'First + 2;
      else
         Start := Inline_Comment'First;
      end if;
      First_Char :=
        Next_Non_Blank
          (Inline_Comment (Start .. Inline_Comment'Last));
      if First_Char = 0 then return Inline_Comment; end if;
      UT.Set (Text, Trim (Inline_Comment (Start .. Inline_Comment'Last)));
      AD.Filters.Transform (Only_Legal'Access, Text);
      AD.Filters.Transform (Shortcuts'Access, Text);
      AD.Filters.Transform (HTMLize'Access, Text);
      if Start > Inline_Comment'First then
         return Inline_Comment (Inline_Comment'First .. First_Char - 1) &
                UT.To_String (Text);
      else
         return UT.To_String (Text);
      end if;
   end Format;

begin
   Enter ("--", new AD.Filters.Filter_Standard);
end AD.Format;
