-------------------------------------------------------------------------------
--
--  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>
--   Filters for formatted output of comments.</DL>
--
-- <!--
-- Revision History
--
--   04-JUN-2002   TW  Initial version.
--   19-JUN-2002   TW  Added 'Close_P' in the 'Transform (Filter_Para)' to
--                     properly close or remove a trailing open "<P>" tag.
--   24-JUN-2002   TW  Changed the pipe filter from a dyadic operator to
--                     a flat, multi-operand operator. For some unknown reason
--                     GNAT had severe problems with finalizing pipe filters
--                     using the recursive dyadic operator implementation: it
--                     somehow took ages. (Note: it may have well been some
--                     programming error of my part, such as may not having
--                     gotten the tree links right. But I don't know, for I
--                     didn't check this; I just rewrote it. Anyway:) With the
--                     new structure, there can be at most one pipe filter,
--                     and it'll be at top level, and finalizing it works like
--                     a charm and is fast.
--   28-JUN-2002   TW  Added support for boolean HTML attributes in minimized
--                     form in 'Param_Expander'.
--                       Changed the 'None'-Filter to at least HTMLize the
--                     text (without HTML parsing).
--   01-JUL-2002   TW  Renamed the "none" filter to "entities". Added the
--                     "unknown_tags" filter.
--   09-JUL-2003   TW  Removed the 'Last_Tag' from the Tag_Stack in
--                     Handle_Standard_HTML; it was set, but not used anywhere.
--   09-SEP-2003   TW  The 'Plain' filter now also removes leading blanks if
--                     the non-blank part of a line starts with "</pre" (case
--                     insensitively). This helps avoid ugly white-space in the
--                     rendering of the generated HTML.
-- -->
-------------------------------------------------------------------------------

pragma License (GPL);

with Ada.Calendar;
with Ada.Exceptions;
with Ada.Streams.Stream_IO;
with Ada.Text_IO;
with Ada.Unchecked_Deallocation;

with AD.File_Ops;
with AD.HTML;
with AD.Messages;
with AD.Parameters;
with AD.User_Tags;

with GAL.Support;

with Util.Calendar.IO;
with Util.Environment.Bash;
with Util.Pipes;
with Util.Strings;

with Util.Text.Internal;

package body AD.Filters is

   package UT  renames Util.Text;

   use AD.Messages;
   use AD.User_Tags;

   use Util.Strings;

   ----------------------------------------------------------------------------
   --  Parsing a filter specification from a string.

   function Parse
     (Program : in String)
     return Filter_Ref
   is
      Pipe_Character : constant Character := '|';

      procedure Get_Param
        (Src      : in     String;
         From, To :    out Natural;
         Before   : in     Character)
      is
      begin
         From := Next_Non_Blank (Src);
         if From = 0 or else Src (From) /= Before then
            --  Missing parameter.
            Ada.Exceptions.Raise_Exception
              (Parse_Error'Identity, "missing parameter");
         end if;
         From := Next_Non_Blank (Src (From + 1 .. Src'Last));
         if From = 0 or else not Is_In (String_Quotes, Src (From)) then
            --  Missing parameter.
            Ada.Exceptions.Raise_Exception
              (Parse_Error'Identity, "string parameter expected");
         end if;
         Get_String (Src (From .. Src'Last), From, To, Src (From), Src (From));
         --  Ada format of strings, i.e. delimiter must be doubled.
         if To = 0 then
            --  Unterminated string.
            Ada.Exceptions.Raise_Exception
              (Parse_Error'Identity,
               "unterminated string: " & Src (From .. Src'Last));
         end if;
      end Get_Param;

      procedure Get_Command
        (Src      : in     String;
         From, To :    out Natural;
         Last     :    out Natural)
      is

         function Read_Command
           (Src   : in String;
            Delim : in Character)
           return Natural
         is
            I : Natural := Src'First + 1;
         begin
            while I <= Src'Last and then Src (I) /= Delim loop
               if Src (I) = '(' then
                  I := Read_Command (Src (I .. Src'Last), ')');
               elsif Src (I) = '{' then
                  I := Read_Command (Src (I .. Src'Last), '}');
               elsif Is_In (Shell_Quotes, Src (I)) then
                  declare
                     J : constant Natural :=
                       Skip_String (Src (I .. Src'Last), Src (I), Src (I));
                  begin
                     if J = 0 then
                        Ada.Exceptions.Raise_Exception
                          (Parse_Error'Identity,
                           "unterminated string: " & Src (I .. Src'Last));
                     end if;
                     I := J;
                  end;
               end if;
               I := I + 1;
            end loop;
            if I > Src'Last then
               --  Unterminated parentheses.
               Ada.Exceptions.Raise_Exception
                 (Parse_Error'Identity,
                  "missing closing '" & Delim & "': " & Src);
            end if;
            return I;
         end Read_Command;

      begin --  Get_Command
         From := Src'First + 1; To := 0;
         Last := Read_Command (Src, ')');
         while From <= Last and then Is_Blank (Src (From)) loop
            From := From + 1;
         end loop;
         To := Last - 1;
         while To >= From and then Is_Blank (Src (To)) loop
            To := To - 1;
         end loop;
      end Get_Command;

      Pipe, Expr : Filter_Ref := null;
      I, J       : Natural;

   begin
      I := Next_Non_Blank (Program);
      if I = 0 then I := Program'Last + 1; end if;
      while I <= Program'Last loop
         J := Identifier (Program (I .. Program'Last));
         if J = 0 then
            --  No identifier found: error
            Ada.Exceptions.Raise_Exception
              (Parse_Error'Identity,
               "identifier expected after " & Program (Program'First .. I));
         end if;
         --  Handle the identifier.
         Parse_Filter :
         declare
            Filter_Name : constant String  := To_Lower (Program (I .. J));
            Start       : constant Natural := I;
         begin
            if Filter_Name = "entities" then
               Expr := new Filter_Entities;
            elsif Filter_Name = "enclose" then
               declare
                  A, B, C, D : Natural;
               begin
                  Get_Param (Program (J + 1 .. Program'Last), A, B, '(');
                  Get_Param (Program (B + 1 .. Program'Last), C, D, ',');
                  J := Next_Non_Blank (Program (D + 1 .. Program'Last));
                  if J = 0 or else Program (J) /= ')' then
                     --  Missing closing parentheses.
                     Ada.Exceptions.Raise_Exception
                       (Parse_Error'Identity,
                        "missing ')': " & Program (Start .. Program'Last));
                  end if;
                  Expr := new Filter_Enclose;
                  Init (Filter_Enclose (Expr.all)'Access,
                        Unquote (Program (A + 1 .. B - 1),
                                 Program (A), Program (A)),
                        Unquote (Program (C + 1 .. D - 1),
                                 Program (C), Program (C)));
               end;
            elsif Filter_Name = "pre" then
               Expr := new Filter_Pre;
            elsif Filter_Name = "swallow" then
               Expr := new Filter_Swallow;
            elsif Filter_Name = "execute" then
               I := Next_Non_Blank (Program (J + 1 .. Program'Last));
               if I = 0 then
                  Ada.Exceptions.Raise_Exception
                    (Parse_Error'Identity,
                     "incomplete execute filter: " &
                     Program (Start .. Program'Last));
               end if;
               declare
                  LF : Filter_Linefeeds := Default_LF;
               begin
                  if Program (I) /= '(' then
                     J := Identifier (Program (I .. Program'Last));
                     if J = 0 then
                        Ada.Exceptions.Raise_Exception
                          (Parse_Error'Identity,
                           "linefeed specification expected: " &
                           Program (Start .. I));
                     end if;
                     declare
                        Mode : constant String := To_Lower (Program (I .. J));
                     begin
                        if Mode = "lf" then
                           LF := LF_Only;
                        elsif Mode = "cr" then
                           LF := CR_Only;
                        elsif Mode = "crlf" then
                           LF := CR_And_LF;
                        else
                           Ada.Exceptions.Raise_Exception
                             (Parse_Error'Identity,
                              "unknown linefeed specification: " &
                              Program (I .. J));
                        end if;
                     end;
                     I := Next_Non_Blank (Program (J + 1 .. Program'Last));
                     if Program (I) /= '(' then
                        Ada.Exceptions.Raise_Exception
                          (Parse_Error'Identity,
                           "'(' expected after 'execute': " &
                           Program (Start .. Program'Last));
                     end if;
                  end if;
                  --  Program (I) = '('.
                  declare
                     A, B : Natural;
                  begin
                     Get_Command (Program (I .. Program'Last), A, B, J);
                     if A > B then
                        --  Empty command
                        Ada.Exceptions.Raise_Exception
                          (Parse_Error'Identity,
                           "empty command: " & Program (Start .. J));
                     end if;
                     Expr := new Filter_Execute (LF);
                     Init (Filter_Execute (Expr.all)'Access,
                           Unquote_All (Program (A .. B), Shell_Quotes));
                  end;
                  --  Program (J) = ')'
               end;
            elsif Filter_Name = "expand" then
               Expr := new Filter_Expand;
            elsif Filter_Name = "strip_comments" then
               Expr := new Filter_Strip;
            elsif Filter_Name = "plain" then
               Expr := new Filter_Plain;
            elsif Filter_Name = "para" then
               Expr := new Filter_Para;
            elsif Filter_Name = "lines" then
               Expr := new Filter_Lines;
            elsif Filter_Name = "shortcut" then
               Expr := new Filter_Shortcut;
            elsif Filter_Name = "standard" then
               Expr := new Filter_Standard;
            elsif Filter_Name = "hr" then
               I := Next_Non_Blank (Program (J + 1 .. Program'Last));
               if I = 0 or else Program (I) = Pipe_Character then
                  -- Default is strip
                  Expr := new Filter_HR (True);
                  if I = 0 then J := Program'Last; else J := I - 1; end if;
               else
                  J := Identifier (Program (I .. Program'Last));
                  if J = 0 then
                     Ada.Exceptions.Raise_Exception
                       (Parse_Error'Identity,
                        "'strip' or 'replace' expected: " &
                        Program (Start .. Program'Last));
                  end if;
                  declare
                     Mode : constant String := To_Lower (Program (I .. J));
                  begin
                     if Mode = "strip" then
                        Expr := new Filter_HR (True);
                     elsif Mode = "replace" then
                        Expr := new Filter_HR (False);
                     else
                        Ada.Exceptions.Raise_Exception
                          (Parse_Error'Identity,
                           "'strip' or 'replace' expected: " &
                           Program (Start .. J));
                     end if;
                  end;
               end if;
            elsif Filter_Name = "unknown_tags" then
               I := Next_Non_Blank (Program (J + 1 .. Program'Last));
               if I = 0 or else Program (I) = Pipe_Character then
                  -- Default is standard tags only:
                  Expr := new Filter_Unknown (True);
                  if I = 0 then J := Program'Last; else J := I - 1; end if;
               else
                  J := Identifier (Program (I .. Program'Last));
                  if J = 0 then
                     Ada.Exceptions.Raise_Exception
                       (Parse_Error'Identity,
                        "'all' or 'standard' expected: " &
                        Program (Start .. Program'Last));
                  end if;
                  declare
                     Mode : constant String := To_Lower (Program (I .. J));
                  begin
                     if Mode = "standard" then
                        Expr := new Filter_Unknown (True);
                     elsif Mode = "all" then
                        Expr := new Filter_Unknown (False);
                     else
                        Ada.Exceptions.Raise_Exception
                          (Parse_Error'Identity,
                           "'all' or 'standard' expected: " &
                           Program (Start .. J));
                     end if;
                  end;
               end if;
            else
               --  Unknown filter
               Ada.Exceptions.Raise_Exception
                 (Parse_Error'Identity,
                  "unknown filter '" & Program (I .. J) & ''');
            end if;
         end Parse_Filter;
         --  J is on the last character processed; Expr is the filter.
         I := Next_Non_Blank (Program (J + 1 .. Program'Last));
         if I = 0 then
            if Pipe /= null then
               --  Expr is the rightmost operand of a pipe: add it.
               Add_Operand (Filter_Pipe (Pipe.all)'Access, Expr);
            end if;
            exit;
         end if;
         if Program (I) /= Pipe_Character then
            Ada.Exceptions.Raise_Exception
              (Parse_Error'Identity,
               "unknown operator '" & Program (I) &
               "', expected a pipe '|'");
         end if;
         --  We're on a pipe operator: 'Expr' is an operand in a pipe (the
         --  right-most operand parsed so far). Hence create the pipe if it
         --  doesn'tz exist already, and then add the operand.
         if Pipe = null then Pipe := new Filter_Pipe; end if;
         Add_Operand (Filter_Pipe (Pipe.all)'Access, Expr);
         I := Next_Non_Blank (Program (I + 1 .. Program'Last));
         if I = 0 then
            Ada.Exceptions.Raise_Exception
              (Parse_Error'Identity, "last pipe '|' has no right-hand side");
         end if;
      end loop;
      if Pipe /= null then
         --  Yes, we have a pipe, and Expr is already contained in it.
         return Pipe;
      else
         --  We may return null here, which (much later on) will be used to
         --  signify "remove this filter completely".
         return Expr;
      end if;
   end Parse;

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

   procedure Free is
      new Ada.Unchecked_Deallocation (Operand_Table, Operand_Ptr);

   procedure Finalize (Self : in out Filter_Killer)
   is
   begin
      if Self.Parent.Operands /= null then
         for I in Self.Parent.Operands'Range loop
            Free (Self.Parent.Operands (I));
         end loop;
         Free (Self.Parent.Operands);
      end if;
   end Finalize;

   procedure Add_Operand
     (Self    : access Filter_Pipe;
      Operand : in     Filter_Ref)
   is
   begin
      if Operand /= null then
         if Self.Operands = null then
            Self.Operands := new Operand_Table'(1 => Operand);
         else
            declare
               New_Ops : constant Operand_Ptr :=
                 new Operand_Table (1 .. Self.Operands'Last + 1);
            begin
               New_Ops (1 .. Self.Operands'Last) := Self.Operands.all;
               New_Ops (New_Ops'Last) := Operand;
               Free (Self.Operands);
               Self.Operands := New_Ops;
            end;
         end if;
      end if;
   end Add_Operand;

   procedure Transform
     (Self : access Filter_Pipe;
      Text : in out Util.Text.Unbounded_String)
   is
   begin
      if Self.Operands /= null then
         for I in Self.Operands'Range loop
            Transform (Self.Operands (I), Text);
         end loop;
      end if;
   end Transform;

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

   procedure Transform
     (Self : access Filter_Entities;
      Text : in out Util.Text.Unbounded_String)
   is
      pragma Warnings (Off, Self); --  silence -gnatwa

      Source   : constant UT.String_Access := UT.Internal.Get_Ptr (Text);
      Result   : UT.Unbounded_String;
      Start, I : Natural;
   begin
      Start := Source'First;
      while Start <= Source'Last loop
         --  Handle the text line by line: it's an attempt to avoid having
         --  huge strings on the secondary stack. (HTMLize is recursive...)
         I := First_Index (Source (Start .. Source'Last), ASCII.LF);
         if I = 0 then I := Source'Last; end if;
         UT.Append (Result, AD.HTML.HTMLize (Source (Start .. I)));
         Start := I + 1;
      end loop;
      Text := Result;
   end Transform;

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

   procedure Init
     (Self          : access Filter_Enclose;
      Before, After : in     String)
   is
   begin
      UT.Set (Self.Before, Before);
      UT.Set (Self.After,  After);
   end Init;

   procedure Transform
     (Self : access Filter_Enclose;
      Text : in out Util.Text.Unbounded_String)
   is
      --  Minimize the number of reallocations:
      Old_Str : constant UT.String_Access := UT.Internal.Get_Ptr (Text);
      Before  : constant UT.String_Access := UT.Internal.Get_Ptr (Self.Before);
      After   : constant UT.String_Access := UT.Internal.Get_Ptr (Self.After);

      Old_Length    : constant Natural := Old_Str'Last;
      Before_Length : constant Natural := Before'Last;
      After_Length  : constant Natural := After'Last;

      New_Str : constant UT.String_Access :=
        new String (1 .. Old_Length + Before_Length + After_Length);
   begin
      New_Str (1 .. Before_Length) := Before.all;
      New_Str (Before_Length + 1 .. Before_Length + Old_Length) :=
        Old_Str.all;
      New_Str (Before_Length + Old_Length + 1 .. New_Str'Last) :=
        After.all;
      UT.Internal.Set_Ptr (Text, New_Str);
   end Transform;

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

   procedure Transform
     (Self : access Filter_Pre;
      Text : in out Util.Text.Unbounded_String)
   is
      pragma Warnings (Off, Self); --  silence -gnatwa

      --  Minimize the number of reallocations:
      Old_Str : constant UT.String_Access := UT.Internal.Get_Ptr (Text);

      Length  : constant Natural := Old_Str'Last;

      New_Str : constant UT.String_Access :=
        new String (1 .. Length + 5 + 6);
   begin
      New_Str (1 .. 5)                     := "<PRE>";
      New_Str (6 .. 5 + Length)            := Old_Str.all;
      New_Str (6 + Length .. New_Str'Last) := "</PRE>";
      UT.Internal.Set_Ptr (Text, New_Str);
   end Transform;

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

   procedure Transform
     (Self : access Filter_Swallow;
      Text : in out Util.Text.Unbounded_String)
   is
      pragma Warnings (Off, Self); --  silence -gnatwa

   begin
      Text := UT.Null_Unbounded_String;
   end Transform;

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

   procedure Init
     (Self : access Filter_Execute;
      Cmd  : in     String)
   is
   begin
      UT.Set (Self.Cmd, Cmd);
   end Init;

   procedure Transform
     (Self : access Filter_Execute;
      Text : in out Util.Text.Unbounded_String)
   is
      Max_Open_Tries : constant := 10;
      --  Number of times we try to open a temp file, each time with a
      --  different name.

      function Unique_Name
        (Base   : in String;
         Suffix : in String)
        return String
      is
         Now : constant Ada.Calendar.Time :=
           Ada.Calendar.Clock;
         TS  : String := Util.Calendar.IO.Image
                           (Instant   => Ada.Calendar.Seconds (Now),
                            Precision => 3);
      begin
         --  TS has the format HH:MM:SS.FFF. Now strip out ':' and '.':
         TS (TS'First + 2 .. TS'First + 3) :=
           TS (TS'First + 3 .. TS'First + 4);  --  HHMM_:SS.FFF
         TS (TS'First + 4 .. TS'First + 5) :=
           TS (TS'First + 6 .. TS'First + 7);  --  HHMMSS__.FFF
         TS (TS'First + 6 .. TS'First + 8) :=
           TS (TS'First + 9 .. TS'First + 11); --  HHMMSSFFF___
         return Base & '_' &
                Util.Calendar.IO.Image (Date => Now, Separator => "") &
                '_' & TS (TS'First .. TS'First + 8) & '.' & Suffix;
      end Unique_Name;

      function Write_Text
        (Text : in String)
        return String
      is
         use Ada.Text_IO;

         File : File_Type;
         Name : String := Unique_Name ("ab", "ppp");

      begin
         --  Create temp file
         for I in 1 .. Max_Open_Tries loop
            begin
               Create (File, Out_File, Name);
               exit;
            exception
               when others =>
                  if I < Max_Open_Tries then
                     --  Create next name.
                     Name := Unique_Name ("ab", "ppp");
                  end if;
            end;
         end loop;
         if not Is_Open (File) then return ""; end if;
         declare
            Start, I : Natural;
         begin
            Start := Text'First;
            while Start <= Text'Last loop
               I := First_Index (Text (Start .. Text'Last), ASCII.LF);
               if I = 0 then I := Text'Last + 1; end if;
               Put_Line (File, Text (Start .. I - 1));
               Start := I + 1;
            end loop;
         end;
         Close (File);
         return Name;
      exception
         when others =>
            if Is_Open (File) then Close (File); end if;
            return "";
      end Write_Text;

      subtype Linefeed_Policy is Filter_Linefeeds range LF_Only .. CR_Only;

      function Write_Stream
        (Policy : in Linefeed_Policy;
         Text   : in String)
        return String
      is
         use Ada.Streams.Stream_IO;

         File : File_Type;
         Name : String := Unique_Name ("ab", "ppp");

      begin
         --  Create temp file
         for I in 1 .. Max_Open_Tries loop
            begin
               Create (File, Out_File, Name);
               exit;
            exception
               when others =>
                  if I < Max_Open_Tries then
                     --  Create next name.
                     Name := Unique_Name ("ab", "ppp");
                  end if;
            end;
         end loop;
         if not Is_Open (File) then return ""; end if;
         declare
            Start, I : Natural;
            S        : constant Stream_Access := Stream (File);
         begin
            Start := Text'First;
            while Start <= Text'Last loop
               I := First_Index (Text (Start .. Text'Last), ASCII.LF);
               if I = 0 then I := Text'Last + 1; end if;
               String'Write (S, Text (Start .. I - 1));
               case Policy is
                  when LF_Only =>
                     Character'Write (S, ASCII.LF);
                  when CR_And_LF =>
                     Character'Write (S, ASCII.CR);
                     Character'Write (S, ASCII.LF);
                  when CR_Only =>
                     Character'Write (S, ASCII.CR);
               end case;
               Start := I + 1;
            end loop;
         end;
         Close (File);
         return Name;
      exception
         when others =>
            if Is_Open (File) then Close (File); end if;
            return "";
      end Write_Stream;

      function Write_File
        (Self : access Filter_Execute;
         Text : in     String)
        return String
      is
      begin
         if Self.Linefeed = Default_LF then
            return Write_Text (Text);
         else
            return Write_Stream (Self.Linefeed, Text);
         end if;
      end Write_File;

      Tmp_Name : constant String :=
        Write_File (Self, UT.Internal.Get_Ptr (Text).all);

   begin
      if Tmp_Name'Last < Tmp_Name'First then
         Warn ("cannot run command: " & UT.Internal.Get_Ptr (Self.Cmd).all);
         return;
      end if;
      Text := UT.Null_Unbounded_String;
      --  Open in-pipe for 'Cmd' with stdin redirected to come from temp file
      declare
         use Util.Pipes;

         P         : Pipe_Stream;
         Exit_Code : Integer;

      begin
         Open (P, UT.Internal.Get_Ptr (Self.Cmd).all,
               In_Stream, True, Tmp_Name);
         while not End_Of_Stream (P) loop
            begin
               declare
                  Line : constant String := Get_Line (P);
               begin
                  UT.Append (Text, Line & ASCII.LF);
               end;
            exception
               when End_Error =>
                  Warn ("Got exception:" & UT.Internal.Get_Ptr (Text).all);
                  exit;
            end;
         end loop;
         Close (P, Exit_Code);
         if Exit_Code /= 0 then
            Warn ("command '" & UT.Internal.Get_Ptr (Self.Cmd).all &
                  "' returned with exit code" & Integer'Image (Exit_Code));
         end if;
      exception
         when E : others =>
            Warn ("command '" & UT.Internal.Get_Ptr (Self.Cmd).all &
                  "' failed!");
            Warn (Ada.Exceptions.Exception_Information (E));
      end;
      --  If an exception occurs, and the pipe is still open, the pipe
      --  is closed automatically.
      AD.File_Ops.Delete (Tmp_Name);
   end Transform;

   ----------------------------------------------------------------------------
   --  Internal utility routines for scanning HTML.

   function Find_Comment_End
     (Source : in String)
     return Natural
   is
      Start : Natural := Source'First;
      I     : Natural;
   begin
      --  According to the HTML 4.01 spec, there may be white space between
      --  the "--" and the ">"!! That definition seems broken to me, but if
      --  they define it that way, we'd better scan it that way, too...
      while Start + 2 <= Source'Last loop
         if Source (Start) = '-' and then Source (Start + 1) = '-' then
            I := Start + 2;
            --  Skip whitespace
            loop
               if Is_Blank (Source (I)) then
                  I := I + 1;
                  if I > Source'Last then return 0; end if;
               else
                  exit;
               end if;
            end loop;
            if Source (I) = '>' then
               return I;
            else
               --  Non-white space, but not '>': the "--" was not the
               --  beginning of the comment end. (Is this correct?)
               Start := I;
            end if;
         else
            Start := Start + 1;
         end if;
      end loop;
      return 0;
   end Find_Comment_End;

   ----------------------------------------------------------------------------
   --  Internal utility routines for parsing HTML.

   type Tag_Type_Kind is (Start_Tag, End_Tag, Comment);

   generic
      type Tag_Handling_State (<>) is limited private;
      with procedure Handle_Tag
             (Source             : access String;
              Result             : in out UT.Unbounded_String;
              Tag_Start, Tag_End : in     Natural;
              Tag_Type           : in     Tag_Type_Kind;
              State              : in out Tag_Handling_State);
   procedure Process_Tags
     (Text   : in     UT.Unbounded_String;
      Result : in out UT.Unbounded_String;
      State  : in out Tag_Handling_State);
   --  'Process_Tags' calls 'Handle_Tag' for any HTML mark-up tag it finds
   --  and replaces the tags by whatever 'Handle_Tag' puts into 'Result'.
   --  Note that HTML comments also are mark-up elements!
   --
   --  Anything between tags reminas unchanged.
   --
   --  'Tag_Start' and 'Tag_End' are indices into 'Source'. If 'Tag_End' is
   --  greater than Length (Source), an unclosed tag was found. 'State' is just
   --  passed through to 'Handle_Tags'.

   generic
      type Tag_Handling_State (<>) is limited private;
      with procedure Handle_Tag
             (Source             : access String;
              Result             : in out UT.Unbounded_String;
              Tag_Start, Tag_End : in     Natural;
              Tag_Type           : in     Tag_Type_Kind;
              State              : in out Tag_Handling_State);
      with procedure Handle_Content
             (Source   : in     String;
              Result   : in out UT.Unbounded_String;
              State    : in out Tag_Handling_State);
   procedure Process_Content
     (Text   : in     UT.Unbounded_String;
      Result : in out UT.Unbounded_String;
      State  : in out Tag_Handling_State);
   --  As 'Process_Tags', but additionally calls 'Handle_Content' for any
   --  content stretch 'Source (From .. To)'.

   procedure Process_Content
     (Text   : in     UT.Unbounded_String;
      Result : in out UT.Unbounded_String;
      State  : in out Tag_Handling_State)
   is
      S           : constant UT.String_Access := UT.Internal.Get_Ptr (Text);
      Tag_Type    : Tag_Type_Kind;
      Start, I    : Natural;
   begin
      Start := S'First;
      while Start <= S'Last loop
         I := Start;
         --  Scan ahead to the next '<' that is the start of either a
         --  tag or an HTML comment:
         while I <= S'Last loop
            if I < S'Last and then S (I) = '<' then
               if Is_In (Letters, S (I + 1)) then
                  Tag_Type := Start_Tag; exit;
               elsif S (I + 1) = '/' and then
                     I + 1 < S'Last and then
                     Is_In (Letters, S (I + 2))
               then
                  Tag_Type := End_Tag; exit;
               elsif I + 3 <= S'Last and then
                     S (I + 1 .. I + 3) = "!--"
               then
                  Tag_Type := Comment; exit;
               end if;
               --  Not a tag start after all.
            end if;
            I := I + 1;
         end loop;
         Handle_Content (S (Start .. I - 1), Result, State);
         exit when I > S'Last;
         Start := I;
         case Tag_Type is
            when Comment =>
               --  Scan ahead to the comment end.
               I := Find_Comment_End (S (I + 4 .. S'Last));
            when Start_Tag =>
               --  Scan ahead to the next '>' not within a string
               I := AD.HTML.Find_Tag_End (S (Start .. S'Last));
            when End_Tag =>
               --  Scan ahead to the next '>':
               I := First_Index (S (Start .. S'Last), '>');
         end case;
         --  'Start' is now on the opening '<', and 'I' is on the closing '>',
         --  or, if no closing '>' exists, 'I' is zero.
         if I = 0 then I := S'Last; end if;
         Handle_Tag (S, Result, Start, I, Tag_Type, State);
         Start := I + 1;
      end loop;
   end Process_Content;

   procedure Process_Tags
     (Text   : in     UT.Unbounded_String;
      Result : in out UT.Unbounded_String;
      State  : in out Tag_Handling_State)
   is
      procedure Content
        (Source   : in     String;
         Result   : in out UT.Unbounded_String;
         State    : in out Tag_Handling_State)
      is
         pragma Warnings (Off, State); --  Silence -gnatwa
      begin
         --  Pass on content unchanged.
         if Source'Last >= Source'First then
            UT.Append (Result, Source);
         end if;
      end Content;

      procedure Process is
         new Process_Content (Tag_Handling_State, Handle_Tag, Content);

   begin --  Process_Tags
      Process (Text, Result, State);
   end Process_Tags;

   function Get_Tag_Key
     (Source   : in String;
      Tag_Type : in Tag_Type_Kind)
     return String
   is
      I : Natural := Source'First + 1;
      J : Natural;
   begin
      if Tag_Type = End_Tag then I := I + 1; end if;
      J := Util.Strings.Identifier (Source (I .. Source'Last));
      return Source (I .. J);
   end Get_Tag_Key;

   ----------------------------------------------------------------------------
   --  Tag-modifying filters

   type Param_Expander (Values : access String) is
     new Util.Environment.Bash.Bash_Expander with null record;

   function Legal_Name
     (Self   : access Param_Expander;
      Source : in     String)
     return Natural;

   function Get
     (Self : access Param_Expander;
      Name : in     String)
     return String;

   function Recurse
     (Self : access Param_Expander;
      Name : in     String)
     return String;

   function Indirection
     (Self : access Param_Expander;
      Name : in     String)
     return String;

   function Legal_Name
     (Self   : access Param_Expander;
      Source : in     String)
     return Natural
   is
   begin
      if Source'Last >= Source'First and then Source (Source'First) = '%' then
         return Source'First;
      end if;
      --  Super call:
      return Util.Environment.Bash.Legal_Name
               (Util.Environment.Bash.Bash_Expander (Self.all)'Access,
                Source);
   end Legal_Name;

   function Get
     (Self : access Param_Expander;
      Name : in     String)
     return String
   is
      --  Of course, parsing the parameter string each and every time is not
      --  exactly hyper-efficient, but I guess that this whole parameter
      --  expansion feature will be used mostly for one or two parameters
      --  only, and thus the cost of building e.g. a hash table with names
      --  and values would not be amortized. Hence I consider this simple
      --  approach adequate.

      function Find
        (Source  : in String;
         Pattern : in String)
        return Natural
      is
         In_String : Boolean   := False;
         Start, J  : Natural;
         Delim     : Character := ' ';

         Length    : constant Natural := Pattern'Length;
      begin
         if Length > Source'Length then return 0; end if;
         for I in 1 .. Source'Length - Length + 1 loop
            --  Skip strings, too; otherwise we might get confused on a
            --  parameter value like "Param="Other=" Other=512".
            Start := Source'First + I - 1;
            if In_String then
               In_String := Source (Start) /= Delim;
            else
               if Source (Start) = '"' or else Source (Start) = ''' then
                  In_String := True;
                  Delim     := Source (Start);
               else
                  J := Start;
                  for K in Pattern'Range loop
                     exit when To_Lower (Source (J)) /= To_Lower (Pattern (K));
                     J := J + 1;
                  end loop;
                  if J = Start + Length then return Start; end if;
               end if;
            end if;
         end loop;
         return 0;
      end Find;

      I, J   : Natural;
      Length : constant Natural := Name'Length;

   begin
      if Length = 1 and then Name (Name'First) = '%' then
         return Self.Values.all;
      end if;
      J := Self.Values'First;
      loop
         I := Find (Self.Values (J .. Self.Values'Last), Name);
         if I = 0 then return ""; end if;
         if I + Length > Self.Values'Last or else
            Self.Values (I + Length) = '=' or else
            Self.Values (I + Length) = ' '
         then
            exit;
         end if;
         --  It was a prefix only...
         J := I + Length;
      end loop;
      if I + Length <= Self.Values'Last and then
         Self.Values (I + Length) = '='
      then
         I := I + Length + 1;
         if I <= Self.Values'Last and then
            (Self.Values (I) = '"' or else Self.Values (I) = ''')
         then
            J := First_Index (Self.Values (I + 1 .. Self.Values'Last),
                              Self.Values (I));
            I := I + 1;
         else
            J := First_Index (Self.Values (I .. Self.Values'Last), ' ');
         end if;
         if J = 0 then
            --  Hmmm... no second quote (or no white space) found.
            return Self.Values (I .. Self.Values'Last);
         end if;
         return Self.Values (I .. J - 1);
      else
         --  A boolean attribute... what shall be it's value? We somehow
         --  need to distinguish the case <TAG ATTR> from <TAG ATTR="">!
         --  Since Self.Values cannot contain linefeeds, we use this and
         --  return a string of length 1 conatining a linefeed:
         return (1 => ASCII.LF);
      end if;
   end Get;

   function Recurse
     (Self : access Param_Expander;
      Name : in     String)
     return String
   is
      pragma Warnings (Off, Self); --  silence -gnatwa
      pragma Warnings (Off, Name); --  silence -gnatwa

   begin
      --  We do not allow recursion.
      return "";
   end Recurse;

   function Indirection
     (Self : access Param_Expander;
      Name : in     String)
     return String
   is
      --  Yes, I'm being sloppy and do not redispatch here. It isn't necessary
      --  because I *know* that there is no further derivation of this type.
   begin
      if Name'Last < Name'First or else Name = "%" or else
         Legal_Name (Self, Name) /= Name'Last
      then
         return "";
      end if;
      --  Redefine ${!Name} as Name="Value" if set.
      declare
         Val    : constant String := Get (Self, Name);
         I      : Natural;
         Length : constant Natural := Val'Length;
      begin
         if Length = 0 then return ""; end if;
         if Length = 1 and then Val (Val'First) = ASCII.LF then
            --  Oops: a boolean attribute in minimized form. We'd better
            --  just return the name! (Some browsers only recognize the
            --  minimized form <TAG ATTR>, but not the full form
            --  <TAG ATTR="ATTR">. Hence we'd better make sure that if an
            --  attribute is in minimized form, this expansion also returns
            --  the minimized form.
            return Name;
         else
            I := First_Index (Val, '"');
            if I > 0 then
               return Name & "='" & Val & ''';
            else
               return Name & "=""" &  Val & '"';
            end if;
         end if;
      end;
   end Indirection;

   procedure Transform
     (Self : access Filter_Expand;
      Text : in out Util.Text.Unbounded_String)
   is
      pragma Warnings (Off, Self); --  silence -gnatwa

      --  We maintain a stack of all open container tags so that we can
      --  properly restore the enabled state.

      type Stack_Entry;
      type Stack_Ptr is access Stack_Entry;
      type Stack_Entry is
         record
            Next    : Stack_Ptr;
            Tag     : User_Tag_Ptr;
            Enabled : Boolean;
         end record;

      procedure Free is
         new Ada.Unchecked_Deallocation (Stack_Entry, Stack_Ptr);

      type Expansion_Stack is
         record
            TOS     : Stack_Ptr;
            Enabled : Boolean := True;
         end record;

      procedure Push
        (S   : in out Expansion_Stack;
         Tag : in     User_Tag_Ptr)
      is
      begin
         --  The first disabled container tag disables everything from then on.
         S.Enabled := S.Enabled and then Tag.Enabled;
         S.TOS     := new Stack_Entry'(S.TOS, Tag, S.Enabled);
      end Push;

      procedure Pop
        (S   : in out Expansion_Stack;
         Tag : in     User_Tag_Ptr)
      is
         P : Stack_Ptr := S.TOS;
      begin
         while P /= null and then P.Tag /= Tag loop
            P := P.Next;
         end loop;
         if P = null then
            --  What now? we have an end tag of a container that has never been
            --  opened! Probably the safest is not to pop...
            return;
         end if;
         while S.TOS /= P loop
            declare
               Q : Stack_Ptr := S.TOS;
            begin
               --  Expand the intermediary open containers' missing closing
               --  tags? That might again change the stack! For simplicity,
               --  we just ignore them!
               S.TOS := Q.Next; Free (Q);
            end;
         end loop;
         --  S.TOS = P: now pop that one, too.
         S.TOS := P.Next; Free (P);
         S.Enabled := S.TOS = null or else S.TOS.Enabled;
         --  If we popped to (or even beyond) the first disabled tag, we'll
         --  re-enable ourselves here.
      end Pop;

      procedure Clear
        (S : in out Expansion_Stack)
      is
      begin
         while S.TOS /= null loop
            declare
               P : Stack_Ptr := S.TOS;
            begin
               S.TOS := P.Next; Free (P);
            end;
         end loop;
      end Clear;

      procedure Expand_Tag
        (Source             : access String;
         Result             : in out UT.Unbounded_String;
         Tag_Start, Tag_End : in     Natural;
         Tag_Type           : in     Tag_Type_Kind;
         State              : in out Expansion_Stack);

      procedure Copy_Content
        (Source   : in     String;
         Result   : in out UT.Unbounded_String;
         State    : in out Expansion_Stack)
      is
      begin
         if State.Enabled then UT.Append (Result, Source); end if;
      end Copy_Content;

      procedure Expand_Tags is
         new Process_Content (Expansion_Stack, Expand_Tag, Copy_Content);

      procedure Expand_Tag
        (Source             : access String;
         Result             : in out UT.Unbounded_String;
         Tag_Start, Tag_End : in     Natural;
         Tag_Type           : in     Tag_Type_Kind;
         State              : in out Expansion_Stack)
      is

         procedure Replace_User_Tag
           (State    : in out Expansion_Stack;
            The_Tag  : in     User_Tag_Ptr;
            Params   : access String;
            From, To : in     Natural;
            Result   : in out UT.Unbounded_String)
         is

            procedure Include_Tag
              (File_Name : in     String;
               Result    : in out UT.Unbounded_String)
            is
               --  Called only when we're enabled.
               F    : Ada.Text_IO.File_Type;
               Buf  : String (1 .. 300);
               Last : Natural;
            begin --  Include_Tag
               if File_Name'Last < File_Name'First then return; end if;
               Ada.Text_IO.Open (F, Ada.Text_IO.In_File, File_Name);
               while not Ada.Text_IO.End_Of_File (F) loop
                  Ada.Text_IO.Get_Line (F, Buf, Last);
                  if Last < Buf'Last or else Ada.Text_IO.End_Of_File (F) then
                     UT.Append (Result, Buf (1 .. Last) & ASCII.LF);
                  else
                     UT.Append (Result, Buf);
                  end if;
               end loop;
               Ada.Text_IO.Close (F);
            exception
               when Ada.Text_IO.Name_Error =>
                  Warn ("Cannot open file """ & File_Name & '"');
               when others =>
                  if Ada.Text_IO.Is_Open (F) then
                     Ada.Text_IO.Close (F);
                  end if;
                  Warn ("Error reading file """ & File_Name & '"');
            end Include_Tag;

            procedure Execute_Tag
              (The_Tag  : in     User_Tag_Ptr;
               Command  : in     String;
               One_Line : in     Boolean;
               Result   : in out UT.Unbounded_String)
            is
               --  Called only when we're enabled.
            begin --  Execute_Tag
               if Command'Last < Command'First then return; end if;
               AD.Parameters.Save_Input;
               declare
                  S         : Util.Pipes.Pipe_Stream;
                  Buf       : String (1 .. 1000);
                  Last      : Natural;
                  Exit_Code : Integer;
               begin
                  Util.Pipes.Open (S, Command, Util.Pipes.In_Stream);
                  if One_Line then
                     begin
                        Util.Pipes.Get_Line (S, Buf, Last);
                     exception
                        when Util.Pipes.End_Error =>
                           Last := 0;
                     end;
                     The_Tag.Kind := Normal;
                     UT.Set (The_Tag.Start, Buf (1 .. Last));
                  else
                     while not Util.Pipes.End_Of_Stream (S) loop
                        Util.Pipes.Get_Line (S, Buf, Last);
                        if Last < Buf'Last or else
                           Util.Pipes.End_Of_Stream (S)
                        then
                           UT.Append (Result, Buf (1 .. Last) & ASCII.LF);
                        else
                           UT.Append (Result, Buf);
                        end if;
                     end loop;
                  end if;
                  Util.Pipes.Close (S, Exit_Code);
                  if Exit_Code /= 0 then
                     Warn ("Called program """ & Command &
                           """ returned exit code" &
                           Integer'Image (Exit_Code));
                  end if;
               exception
                  when Util.Pipes.Name_Error =>
                     Warn ("Cannot execute """ & Command & '"');
                     if One_Line then
                        The_Tag.Kind  := Normal;
                        The_Tag.Start := UT.Null_Unbounded_String;
                     end if;
                  when others =>
                     Warn ("Error running """ & Command & '"');
                     if One_Line then
                        The_Tag.Kind  := Normal;
                        The_Tag.Start := UT.Null_Unbounded_String;
                     end if;
               end;
            end Execute_Tag;

            procedure Expand_Parameters
              (Source   : in     String;
               Params   : in     String;
               Result   :    out UT.Unbounded_String)
            is
               Attributes : aliased String := AD.HTML.Attributes (Params);
               Expander : aliased Param_Expander (Attributes'Access);
            begin --  Expand_Parameters
               Set_Reference_Character (Expander'Access, '%');
               UT.Set (Result, Expand (Expander'Access, Source));
            end Expand_Parameters;

         begin --  Replace_User_Tag
            if The_Tag.Enabled and then State.Enabled then
               --  Otherwise we're either already disabled, or this tag
               --  itself is disabled and hence we needn't do anything.
               declare
                  Definition : UT.Unbounded_String;
                  Substitute : UT.String_Access :=
                    UT.Internal.Get_Ptr (The_Tag.Start);
                  use type UT.String_Access;
               begin
                  if From <= To and then
                     Next_Non_Blank (Params (From .. To)) >= From
                  then
                     --  Only do something if there are parameters!
                     Expand_Parameters
                       (Substitute.all, Params (From .. To), Definition);
                     Substitute := UT.Internal.Get_Ptr (Definition);
                  end if;
                  case The_Tag.Kind is
                     when Execute =>
                        Execute_Tag
                          (The_Tag, Substitute.all, False, Result);
                     when Include =>
                        Include_Tag (Substitute.all, Result);
                     when others =>
                        if The_Tag.Kind = Initialize then
                           Execute_Tag
                             (The_Tag, Substitute.all, True, Result);
                           Substitute := UT.Internal.Get_Ptr (The_Tag.Start);
                        end if;
                        if The_Tag.Kind = Container then
                           Push (State, The_Tag);
                        end if;
                        if Substitute'Last >= Substitute'First then
                           if Substitute =
                              UT.Internal.Get_Ptr (The_Tag.Start)
                           then
                              Expand_Tags (The_Tag.Start, Result, State);
                           else
                              Expand_Tags (Definition, Result, State);
                           end if;
                        end if;
                  end case;
               end;
            else
               --  Disabled...
               if The_Tag.Kind = Container then
                  --  No need to do anything for disabled non-container tags.
                  Push (State, The_Tag);
                  --  If we weren't already disabled, we're now.
               end if;
            end if;
         end Replace_User_Tag;

         procedure Close_User_Tag
           (State   : in out Expansion_Stack;
            The_Tag : in     User_Tag_Ptr;
            Result  : in out UT.Unbounded_String)
         is
            --  Called only for closing tags of containers.
            Old_TOS : constant Stack_Ptr := State.TOS;
         begin --  Close_User_Tag
            Pop (State, The_Tag);
            --  We may be re-enabled now. We still need to also check the tag's
            --  own enabled flag, for even if the state is now enabled again,
            --  we mustn't expand the closing tag if the tag itself is not
            --  enabled (and it therefore was the tag that caused overall
            --  disabling in the first place).
            --    Also note that we don't expand (and hence swallow the tag)
            --  if we didn't pop: if TOS is still the same, we had a stray end
            --  tag without corresponding opening tag. We ignore those.
            if State.TOS /= Old_TOS and then
               The_Tag.Enabled and then State.Enabled and then
               UT.Length (The_Tag.Final) > 0
            then
               Expand_Tags (The_Tag.Final, Result, State);
            end if;
         end Close_User_Tag;

      begin --  Expand_Tag
         if Tag_Type = Comment then
            if State.Enabled then
               UT.Append (Result, Source (Tag_Start .. Tag_End));
            end if;
            return;
         end if;
         --  'Tag_Start' is on the '<', and 'Tag_End' on the closing '>'
         --  We ignore the case where 'Tag_End' > Length (Source); we just
         --  handle unclosed tags as if they were closed...
         --  First extract the tag name.
         declare
            Tag_Key : constant String :=
              Get_Tag_Key (Source (Tag_Start .. Tag_End), Tag_Type);
            The_Tag : constant Tag_Ptr := Find_Tag (Tag_Key);
         begin
            if The_Tag = null then
               --  Unknown tag.
               if State.Enabled then
                  UT.Append (Result, Source (Tag_Start .. Tag_End));
               end if;
               return;
            end if;
            if The_Tag.all in Standard_Tag'Class then
               --  Standard tag: no expansion needed.
               if State.Enabled then
                  UT.Append (Result, Source (Tag_Start .. Tag_End));
               end if;
               return;
            end if;
            declare
               P : constant User_Tag_Ptr := User_Tag_Ptr (The_Tag);
            begin
               if P.In_Expansion then
                  --  Error!!
                  Ada.Exceptions.Raise_Exception
                    (Recursive_Expansion'Identity,
                     "recursive replacement of user-defined tag '" &
                     The_Tag.Name & ''');
               end if;
               P.In_Expansion := True;
               if Tag_Type = Start_Tag then
                  Replace_User_Tag
                    (State, P,
                     Source, Tag_Start + Tag_Key'Length + 1, Tag_End - 1,
                     Result);
               else
                  --  Ignore end tags for non-containers.
                  if P.Kind /= Container then return; end if;
                  Close_User_Tag (State, P, Result);
               end if;
               P.In_Expansion := False;
            end;
         end;
      end Expand_Tag;

      State  : Expansion_Stack;
      Result : UT.Unbounded_String;

   begin --  Transform (Filter_Expand)
      Expand_Tags (Text, Result, State);
      Text := Result;
      Clear (State);
   end Transform;

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

   procedure Transform
     (Self : access Filter_Unknown;
      Text : in out Util.Text.Unbounded_String)
   is

      procedure Handle_Unknown_Tag
        (Source             : access String;
         Result             : in out UT.Unbounded_String;
         Tag_Start, Tag_End : in     Natural;
         Tag_Type           : in     Tag_Type_Kind;
         Standard_Tags_Only : in out Boolean)
      is
      begin
         if Tag_Type = Comment then
            UT.Append (Result, Source (Tag_Start .. Tag_End));
         else
            declare
               Tag_Key : constant String :=
                 Get_Tag_Key (Source (Tag_Start .. Tag_End), Tag_Type);
               The_Tag : constant Tag_Ptr := Find_Tag (Tag_Key);
            begin
               if Source (Tag_End) /= '>' or else
                  The_Tag = null or else
                  (Standard_Tags_Only and then
                   The_Tag.all not in Standard_Tag'Class)
               then
                  --  An unknown or unclosed tag.
                  UT.Append (Result,
                             AD.HTML.HTMLize (Source (Tag_Start .. Tag_End)));
               else
                  UT.Append (Result, Source (Tag_Start .. Tag_End));
               end if;
            end;
         end if;
      end Handle_Unknown_Tag;

      procedure Replace_Unknown_Tags is
         new Process_Tags (Boolean, Handle_Unknown_Tag);

      Result : UT.Unbounded_String;
      Dummy  : Boolean := Self.Std_Only;

   begin
      Replace_Unknown_Tags (Text, Result, Dummy);
      Text := Result;
   end Transform;

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

   procedure Transform
     (Self : access Filter_Strip;
      Text : in out Util.Text.Unbounded_String)
   is

      pragma Warnings (Off, Self); --  silence -gnatwa

      Dummy  : GAL.Support.Null_Type;

      procedure Suppress_Comment
        (Source             : access String;
         Result             : in out UT.Unbounded_String;
         Tag_Start, Tag_End : in     Natural;
         Tag_Type           : in     Tag_Type_Kind;
         State              : in out GAL.Support.Null_Type)
      is
         --  Shall we do the full HTML parse and *not* remove HTML comments
         --  within <SCRIPT> tags?
      begin
         if Tag_Type /= Comment then
            UT.Append (Result, Source (Tag_Start .. Tag_End));
         else
            State := Dummy; --  Silence -gnatwa
         end if;
      end Suppress_Comment;

      procedure Remove_Comments is
         new Process_Tags (GAL.Support.Null_Type, Suppress_Comment);

      Result : UT.Unbounded_String;

   begin --  Transform (Filter_Strip)
      Remove_Comments (Text, Result, Dummy);
      Text := Result;
   end Transform;

   ----------------------------------------------------------------------------
   --  Content-modifying filters

   package Handle_Standard_HTML is

      --  We maintain a stack of all currently open standard HTML tags. This
      --  serves two purposes: (1) it allows us to know where we may modify
      --  text, and (2) it is necessary to properly close entities whose
      --  end tag is optional.

      type Stack_Entry;
      type Stack_Ptr is access Stack_Entry;
      type Stack_Entry is
         record
            Next     : Stack_Ptr;
            Tag      : Standard_Ptr;
            From, To : Natural;
         end record;

      procedure Free is
         new Ada.Unchecked_Deallocation (Stack_Entry, Stack_Ptr);

      type Tag_Stack is
         record
            TOS : Stack_Ptr;
         end record;

      function TOS
        (S : in Tag_Stack)
        return Standard_Ptr;

      procedure Pop_To_Follow_Set
        (S   : in out Tag_Stack;
         Tag : in     Standard_Ptr);

      procedure Push
        (S        : in out Tag_Stack;
         Tag      : in     Standard_Ptr;
         From, To : in     Natural);

      procedure Pop
        (S   : in out Tag_Stack;
         Tag : in     Standard_Ptr);

      procedure Clear
        (S : in out Tag_Stack);

      function Top_Block
        (S : in Tag_Stack)
        return Standard_Ptr;

      procedure Top_Block
        (S        : in     Tag_Stack;
         Tag      :    out Standard_Ptr;
         From, To :    out Natural);

      generic
         with procedure Handle_Tag
                (Source             : access String;
                 Result             : in out UT.Unbounded_String;
                 Tag_Start, Tag_End : in out Natural;
                 Tag_Type           : in     Tag_Type_Kind;
                 The_Tag            : in     Tag_Ptr;
                 State              : in out Tag_Stack);
         with procedure Handle_Content
                (Source   : in     String;
                 Result   : in out UT.Unbounded_String;
                 State    : in out Tag_Stack);
      procedure Process
        (Text   : in     UT.Unbounded_String;
         State  : in out Tag_Stack;
         Result : in out UT.Unbounded_String);

   end Handle_Standard_HTML;

   package body Handle_Standard_HTML is

      function  TOS
        (S : in Tag_Stack)
        return Standard_Ptr
      is
      begin
         if S.TOS = null then return null; end if;
         return S.TOS.Tag;
      end TOS;

      procedure Pop_To_Follow_Set
        (S   : in out Tag_Stack;
         Tag : in     Standard_Ptr)
      is
         P : Stack_Ptr := S.TOS;
         I : Natural   := 0;
      begin
         while P /= null and then P.Tag.Class /= Block loop
            P := P.Next;
         end loop;
         if P = null or else P.Tag.Syntax /= End_Optional then return; end if;
         if P.Tag.Follow'First = P.Tag.Follow'Last and then
            P.Tag.Follow (P.Tag.Follow'First) = null
         then
            --  P tag: only one follow entry, which is null: anything
            --  teminates this!
            I := P.Tag.Follow'First;
         else
            for J in P.Tag.Follow'Range loop
               if Tag_Ptr (Tag) = P.Tag.Follow (J) then
                  I := J; exit;
               end if;
            end loop;
         end if;
         --  If I is still zero, this tag doesn't terminate P
         if I = 0 then return; end if;
         --  This tag does terminate P, so pop
         P := P.Next;
         while S.TOS /= P loop
            declare
               Q : Stack_Ptr := S.TOS;
            begin
               --  Debug ("Pop_To_Follow -> " & Q.Tag.Name);
               S.TOS := Q.Next; Free (Q);
            end;
         end loop;
      end Pop_To_Follow_Set;

      procedure Push
        (S        : in out Tag_Stack;
         Tag      : in     Standard_Ptr;
         From, To : in     Natural)
      is
      begin
         --  Debug ("Pushing " & Tag.Name);
         if Tag.Class = Block then
            --  Follow sets can contain only block entities.
            Pop_To_Follow_Set (S, Tag);
         end if;
         if Tag.Syntax /= Single then
            S.TOS := new Stack_Entry'(S.TOS, Tag, From, To);
         end if;
      end Push;

      procedure Pop
        (S   : in out Tag_Stack;
         Tag : in     Standard_Ptr)
      is
         P : Stack_Ptr := S.TOS;
      begin
         --  Debug ("Pop " & Tag.Name);
         while P /= null and then P.Tag /= Tag loop
            P := P.Next;
         end loop;
         if P = null then
            if Tag.Class = Block then
               --  A stray "</UL>" shall terminate an open "<LI>" even if
               --  there is no starting "<UL>".
               Pop_To_Follow_Set (S, Tag);
            end if;
            return;
         end if;
         --  Here, we have found the corresponding start tag. We'll pop
         --  anything up to and including this start tag, so in the case
         --  above, an intervening open "<LI>" also will vanish.
         P := P.Next;
         while S.TOS /= P loop
            declare
               Q : Stack_Ptr := S.TOS;
            begin
               --  Debug ("Popping " & Q.Tag.Name);
               S.TOS := Q.Next; Free (Q);
            end;
         end loop;
      end Pop;

      procedure Clear
        (S : in out Tag_Stack)
      is
      begin
         --  Debug ("Clearing stack");
         while S.TOS /= null loop
            declare
               P : Stack_Ptr := S.TOS;
            begin
               S.TOS := P.Next; Free (P);
            end;
         end loop;
      end Clear;

      function Top_Block
        (S : in Tag_Stack)
        return Standard_Ptr
      is
         P : Stack_Ptr := S.TOS;
      begin
         while P /= null and then P.Tag.Class /= Block loop
            P := P.Next;
         end loop;
         if P = null then return null; end if;
         return P.Tag;
      end Top_Block;

      procedure Top_Block
        (S        : in     Tag_Stack;
         Tag      :    out Standard_Ptr;
         From, To :    out Natural)
      is
         P : Stack_Ptr := S.TOS;
      begin
         while P /= null and then P.Tag.Class /= Block loop
            P := P.Next;
         end loop;
         if P = null then
            Tag := null; From := 0; To := 0;
         else
            Tag := P.Tag; From := P.From; To := P.To;
         end if;
      end Top_Block;

      procedure Process
        (Text   : in     UT.Unbounded_String;
         State  : in out Tag_Stack;
         Result : in out UT.Unbounded_String)
      is

         procedure Do_Tags
           (Source             : access String;
            Result             : in out UT.Unbounded_String;
            Tag_Start, Tag_End : in     Natural;
            Tag_Type           : in     Tag_Type_Kind;
            State              : in out Tag_Stack)
         is
            A : Natural := Tag_Start;
            B : Natural := Tag_End;
         begin
            if Tag_Type = Comment then
               Handle_Tag (Source, Result, A, B, Tag_Type, null, State);
               return;
            end if;
            declare
               Tag_Key : constant String :=
                 Get_Tag_Key (Source (Tag_Start .. Tag_End), Tag_Type);
               The_Tag : constant Tag_Ptr := Find_Tag (Tag_Key);
            begin
--                 Debug
--                   ("Tag_Key = " & Tag_Key &
--                    "//" & Source (Tag_Start .. Tag_End) &
--                    "//" & Tag_Type_Kind'Image (Tag_Type));
               A := Tag_Start; B := Tag_End;
               Handle_Tag (Source, Result, A, B, Tag_Type, The_Tag, State);
               if The_Tag /= null and then
                  The_Tag.all in Standard_Tag'Class
               then
                  if Tag_Type = Start_Tag then
                     Push (State, Standard_Ptr (The_Tag), A, B);
                  else
                     Pop (State, Standard_Ptr (The_Tag));
                  end if;
               end if;
            end;
         end Do_Tags;

         procedure Process_It is new
           Process_Content (Tag_Stack, Do_Tags, Handle_Content);

      begin --  Process
         Process_It (Text, Result, State);
      end Process;

   end Handle_Standard_HTML;

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

   procedure Copy_Tags
     (Source             : access String;
      Result             : in out UT.Unbounded_String;
      Tag_Start, Tag_End : in out Natural;
      Tag_Type           : in     Tag_Type_Kind;
      The_Tag            : in     Tag_Ptr;
      State              : in out Handle_Standard_HTML.Tag_Stack)
   is
      pragma Warnings (Off, Tag_Type); --  Silence -gnatwa
      pragma Warnings (Off, The_Tag);  --  Silence -gnatwa
      pragma Warnings (Off, State);    --  Silence -gnatwa
   begin
      UT.Append (Result, Source (Tag_Start .. Tag_End));
   end Copy_Tags;

   procedure Copy_Tags_Position
     (Source             : access String;
      Result             : in out UT.Unbounded_String;
      Tag_Start, Tag_End : in out Natural;
      Tag_Type           : in     Tag_Type_Kind;
      The_Tag            : in     Tag_Ptr;
      State              : in out Handle_Standard_HTML.Tag_Stack)
   is
      pragma Warnings (Off, Tag_Type); --  Silence -gnatwa
      pragma Warnings (Off, The_Tag);  --  Silence -gnatwa
      pragma Warnings (Off, State);    --  Silence -gnatwa
   begin
      UT.Append (Result, Source (Tag_Start .. Tag_End));
      declare
         A : Natural;
         B : Natural := UT.Length (Result);
      begin
         if Tag_End >= Tag_Start then
            A := B - (Tag_End - Tag_Start);
         else
            A := 0; B := 0;
         end if;
         Tag_Start := A; Tag_End := B;
      end;
   end Copy_Tags_Position;

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

   procedure Transform
     (Self : access Filter_Plain;
      Text : in out Util.Text.Unbounded_String)
   is

      pragma Warnings (Off, Self); --  silence -gnatwa

      procedure HTMLify_Text
        (Source   : in     String;
         Result   : in out UT.Unbounded_String;
         State    : in out Handle_Standard_HTML.Tag_Stack)
      is
         TOS : constant Standard_Ptr := Handle_Standard_HTML.TOS (State);
      begin
         if TOS /= null and then TOS.Contains = Dont_Touch then
            UT.Append (Result, Source);
         else
            UT.Append (Result, AD.HTML.HTMLize (Source));
         end if;
      end HTMLify_Text;

      procedure HTMLify is new
        Handle_Standard_HTML.Process (Copy_Tags, HTMLify_Text);

      procedure Move_PRE_To_Start_Of_Line
        (Source : in     UT.Unbounded_String;
         Dest   : in out UT.Unbounded_String)
      is
         function Remove_Blanks
           (S : in String)
           return String
         is
            NB  : constant Natural := Next_Non_Blank (S);
            PRE : constant String := "</pre";
         begin
            if NB /= 0 and then
               S'Last - NB + 1 >= PRE'Length and then
               To_Lower (S (NB .. NB + PRE'Length - 1)) = PRE
            then
               return S (NB .. S'Last);
            else
               return S;
            end if;
         end Remove_Blanks;

         Src      : constant UT.String_Access := UT.Internal.Get_Ptr (Source);
         Start, I : Natural;

      begin --  Move_PRE_To_Start_Of_Line
         Dest  := UT.Null_Unbounded_String;
         Start := Src'First;
         while Start <= Src'Last loop
            --  Go through 'Src' line-by-line and remove any leading blanks
            --  if the first non-blank stuff is "</PRE" (case-insensitively).
            I := First_Index (Src (Start .. Src'Last), ASCII.LF);
            if I = 0 then I := Src'Last; end if;
            UT.Append (Dest, Remove_Blanks (Src (Start .. I)));
            Start := I + 1;
         end loop;
      end Move_PRE_To_Start_Of_Line;

      State        : Handle_Standard_HTML.Tag_Stack;
      Intermediate : UT.Unbounded_String;

   begin
      HTMLify (Text, State, Intermediate);
      Handle_Standard_HTML.Clear (State);
      Move_PRE_To_Start_Of_Line (Intermediate, Text);
   end Transform;

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

   procedure Transform
     (Self : access Filter_Para;
      Text : in out Util.Text.Unbounded_String)
   is

      pragma Warnings (Off, Self); --  silence -gnatwa

      P_Tag          : constant Standard_Ptr :=
        Standard_Ptr (AD.User_Tags.Find_Tag ("P"));

      Pending_P      : Boolean := False;
      Trailing_Start : Natural := 0;
      Trailing_End   : Natural := 0;

      procedure Add_P
        (Source : in     String;
         Result : in out UT.Unbounded_String;
         State  : in out Handle_Standard_HTML.Tag_Stack)
      is
      begin
         if Trailing_Start > 0 then
            UT.Append
              (Result,
               "<P>" & Source (Trailing_Start .. Trailing_End));
         else
            UT.Append (Result, "<P>");
         end if;
         --  And correct the tag stack.
         declare
            P_End : constant Natural := UT.Length (Result) - 1;
         begin
            Handle_Standard_HTML.Push
              (State, P_Tag, P_End - 2, P_End);
         end;
      end Add_P;

      procedure Copy_Tags_With_Para
        (Source             : access String;
         Result             : in out UT.Unbounded_String;
         Tag_Start, Tag_End : in out Natural;
         Tag_Type           : in     Tag_Type_Kind;
         The_Tag            : in     Tag_Ptr;
         State              : in out Handle_Standard_HTML.Tag_Stack)
      is
      begin
         --  Debug ("P Pending:" & Boolean'Image (Pending_P));
         if Tag_Type /= Comment then
            --  Debug ("Copy_Tag: " & The_Tag.Name);
            if Pending_P then
               if The_Tag = null or else
                  (The_Tag.all in Standard_Tag'Class and then
                   Standard_Ptr (The_Tag).Class = Inline)
               then
                  --  Debug ("Adding a pending P");
                  --  Now add that pending paragraph.
                  Add_P (Source.all, Result, State);
               else
                  if Trailing_Start > 0 then
                     UT.Append
                       (Result, Source (Trailing_Start .. Trailing_End));
                  end if;
               end if;
            end if;
            --  Debug ("Setting P to false");
            Pending_P := False; Trailing_Start := 0; Trailing_End := 0;
         end if;
         --  Note that we leave a pending paragraph if we only encounter
         --  comments!
         Copy_Tags_Position
           (Source, Result, Tag_Start, Tag_End, Tag_Type, The_Tag, State);
      end Copy_Tags_With_Para;

      procedure Insert_P
        (Source   : in     String;
         Result   : in out UT.Unbounded_String;
         State    : in out Handle_Standard_HTML.Tag_Stack)
      is
         TOS   : Standard_Ptr;
         TOB   : Standard_Ptr;
         Start : Natural := Source'First;
      begin
         if Pending_P then
            --  If we're here, we only encountered comments since we decided
            --  that maybe we'll need to add a paragraph. Hence any conditions
            --  for inserting a "<P>" still hold.
            declare
               I : Natural := Start;
            begin
               while I <= Source'Last and then Is_Blank (Source (I)) loop
                  I := I + 1;
               end loop;
               if I > Source'Last then
                  --  Only white space here...
                  UT.Append (Result, Source);
                  --  And return, leaving P pending.
                  return;
               end if;
               --  Some non-blank found...
               Add_P (Source, Result, State);
               Start     := I;
               Pending_P := False; Trailing_Start := 0; Trailing_End := 0;
            end;
         end if;
         TOS := Handle_Standard_HTML.TOS (State);
         TOB := Handle_Standard_HTML.Top_Block (State);
--           Debug (Source);
--           if TOS = null then
--              Debug ("TOS = null");
--           else
--              Debug ("TOS = " & TOS.Name);
--           end if;
--           if TOB = null then
--              Debug ("TOB = null");
--           else
--              Debug ("TOB = " & TOB.Name);
--           end if;
         if TOS /= null and then TOS.Contains <= Pure then
            UT.Append (Result, Source);
         else
            if (TOB = null or else TOB.Contains >= Block or else TOB = P_Tag)
               and then
               (TOS = null or else TOS.Contains >= Block or else TOS = P_Tag)
            then
               --  Do it: replace any sequence "LF (Blank* LF)+" by "LF<P>LF".
               declare
                  I, J, K      : Natural;
                  Added_P      : Boolean := False;
                  Last_P_End   : Natural;
                  Last_P_Start : Natural;
               begin
                  while Start <= Source'Last loop
                     I :=
                       First_Index (Source (Start .. Source'Last), ASCII.LF);
                     if I = 0 then
                        UT.Append (Result, Source (Start .. Source'Last));
                        exit;
                     end if;
                     J := I + 1; K := 0;
                     while J <= Source'Last and then Is_Blank (Source (J)) loop
                        if Source (J) = ASCII.LF then K := J; end if;
                        J := J + 1;
                     end loop;
                     if K = 0 then
                        --  No terminating LF found:
                        UT.Append (Result, Source (Start .. J - 1));
                     else
                        if J <= Source'Last then
                           --  We still have some non-blank, so it's certain
                           --  that we need to add a "<P>".
                           UT.Append
                             (Result,
                              Source (Start .. I) & "<P>" &
                              Source (K .. J - 1));
                           Added_P := True;
                           --  Now compute the indices in Result of the
                           --  last "<P>".
                           if J > K then
                              Last_P_End := UT.Length (Result) - (J - K);
                           else
                              Last_P_End := UT.Length (Result);
                           end if;
                           Last_P_Start := Last_P_End - 2;
                        else
                           --  Only blanks after the last LF... we must insert
                           --  a "<P>" only if the next tag wouldn't terminate
                           --  that paragraph immediately again. (And we know
                           --  that whatever follows next will be either a tag
                           --  or the end of the whole comment block.) Hence
                           --  we do *not* insert the "<P>", but take note that
                           --  there is a pending paragraph.
                           --  Debug ("Setting P pending to True");
                           Pending_P := True;
                           Trailing_Start := K;
                           Trailing_End   := J - 1;
                           UT.Append (Result, Source (Start .. I));
                        end if;
                     end if;
                     Start := J;
                  end loop;
                  if Added_P then
                     --  Correct the stack:
                     Handle_Standard_HTML.Push
                       (State, P_Tag, Last_P_Start, Last_P_End);
                  end if;
               end;
            else
               --  Top block is pure, or top tag may contain only inline
               --  entities: don't do anything. Which means that in a comment
               --
               --  Some text <CODE> blah
               --
               --  blah</CODE> and more text
               --
               --  we will (correctly) *not* insert a <P>!
               UT.Append (Result, Source);
            end if;
         end if;
      end Insert_P;

      procedure Close_P
        (Text           : in out UT.Unbounded_String;
         Last           : in     Natural;
         P_Start, P_End : in     Natural;
         State          : in out Handle_Standard_HTML.Tag_Stack)
      is
         P    : constant UT.String_Access := UT.Internal.Get_Ptr (Text);
         Stop : constant Natural          := Natural'Min (P'Last, Last);
         I    : Natural                   := P_End + 1;
      begin
         while I <= Stop and then Is_Blank (P (I)) loop
            I := I + 1;
         end loop;
         if I > Stop then
            --  "<P>" followed only by whitespace: remove the "<P>"!
            UT.Delete (Text, P_Start, P'Last);
         else
            --  "<P>" followed by some non-white space: insert a "</P>".
            if Stop < P'Last then
               if P (Stop) = ASCII.LF then
                  UT.Replace_Slice (Text, Stop + 1, Last, "</P>" & ASCII.LF);
               else
                  UT.Replace_Slice (Text, Stop + 1, Last,
                                    ASCII.LF & "</P>" & ASCII.LF);
               end if;
            else
               if P (Stop) = ASCII.LF then
                  UT.Append (Text, "</P>" & ASCII.LF);
               else
                  UT.Append (Text, ASCII.LF & "</P>" & ASCII.LF);
               end if;
            end if;
         end if;
         Handle_Standard_HTML.Pop (State, P_Tag);
      end Close_P;

      procedure Insert_Paragraphs is new
        Handle_Standard_HTML.Process (Copy_Tags_With_Para, Insert_P);

      State  : Handle_Standard_HTML.Tag_Stack;
      Result : UT.Unbounded_String;

   begin
      Insert_Paragraphs (Text, State, Result);
      Pending_P := False;
      declare
         TOB, TOS           : Standard_Ptr;
         TOB_Start, TOB_End : Natural;
      begin
         Handle_Standard_HTML.Top_Block (State, TOB, TOB_Start, TOB_End);
         TOS := Handle_Standard_HTML.TOS (State);
         if TOB = P_Tag and then TOB = TOS then
            --  We have an open <P> at the end: close it!
            Close_P (Result, UT.Length (Result), TOB_Start, TOB_End, State);
         end if;
      end;
      Text := Result;
      Handle_Standard_HTML.Clear (State);
   end Transform;

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

   procedure Transform
     (Self : access Filter_Lines;
      Text : in out Util.Text.Unbounded_String)
   is

      pragma Warnings (Off, Self); --  silence -gnatwa

      procedure Append_Src
        (Result   : in out UT.Unbounded_String;
         Source   : in     String;
         Suffix   : in     String := "")
      is
         --  Preallocate a buffer large enough to avoid an excessive number
         --  of allocations and deallocations.

         P : UT.String_Access :=
           new String (1 .. 6 * Source'Length + Suffix'Length);
         I : Positive      := 1;
      begin
         for J in Source'Range loop
            if Is_In (Blanks, Source (J)) then
               P (I .. I + 5) := "&nbsp;";
               I := I + 6;
            else
               P (I) := Source (J);
               I := I + 1;
            end if;
         end loop;
         for J in Suffix'Range loop
            P (I) := Suffix (J); I := I + 1;
         end loop;
         if I > 1 then UT.Append (Result, P (1 .. I - 1)); end if;
         UT.Free (P);
      end Append_Src;

      procedure Fix_Line
        (Source   : in     String;
         Result   : in out UT.Unbounded_String;
         State    : in out Handle_Standard_HTML.Tag_Stack)
      is
         TOS : constant Standard_Ptr := Handle_Standard_HTML.TOS (State);
         TOB : constant Standard_Ptr := Handle_Standard_HTML.Top_Block (State);
      begin
         if (TOS /= null and then TOS.Contains <= Pure)
            or else
            (TOB /= null and then TOB.Contains <= Pure)
         then
            --  Top block or top tag is pure: don't do anything.
            UT.Append (Result, Source);
         else
            --  Do it: replace all blanks by "&nbsp;", and replace any LF
            --  by "<BR>LF".
            declare
               Start : Natural := Source'First;
               I     : Natural;
            begin
               while Start <= Source'Last loop
                  I := First_Index (Source (Start .. Source'Last), ASCII.LF);
                  if I = 0 then
                     Append_Src (Result, Source (Start .. Source'Last));
                     exit;
                  else
                     Append_Src
                       (Result, Source (Start .. I - 1), "<BR>" & ASCII.LF);
                     Start := I + 1;
                  end if;
               end loop;
            end;
         end if;
      end Fix_Line;

      procedure Line_Structure is new
        Handle_Standard_HTML.Process (Copy_Tags, Fix_Line);

      State  : Handle_Standard_HTML.Tag_Stack;
      Result : UT.Unbounded_String;

   begin
      Line_Structure (Text, State, Result);
      Text := Result;
      Handle_Standard_HTML.Clear (State);
   end Transform;

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

   procedure Transform
     (Self : access Filter_Shortcut;
      Text : in out Util.Text.Unbounded_String)
   is

      pragma Warnings (Off, Self); --  silence -gnatwa

      procedure Do_Shortcuts
        (Source   : in     String;
         Result   : in out UT.Unbounded_String;
         State    : in out Handle_Standard_HTML.Tag_Stack)
      is
         TOS : constant Standard_Ptr := Handle_Standard_HTML.TOS (State);
      begin
         if TOS /= null and then TOS.Contains = Dont_Touch then
            UT.Append (Result, Source);
         else
            declare
               Start : Natural := Source'First;
            begin
               while Start <= Source'Last loop
                  declare
                     I : Natural := Start;
                     J : Natural;
                  begin
                     I := First_Index (Source (Start .. Source'Last), '@');
                     if I = 0 then
                        J := Source'Last + 1;
                     else
                        --  Try to find a second '@':
                        J := I + 1;
                        while J <= Source'Last loop
                           exit when Source (J) = '@' or else
                                     Is_Blank (Source (J));
                           J := J + 1;
                        end loop;
                     end if;
                     if J > Source'Last or else Source (J) /= '@' then
                        --  No second '@' found:
                        UT.Append (Result, Source (Start .. J - 1));
                        Start := J;
                     else
                        --  I is on the first '@', J on the second.
                        UT.Append (Result, Source (Start .. I - 1) &
                                   "<CODE>" & Source (I + 1 .. J - 1) &
                                   "</CODE>");
                        Start := J + 1;
                     end if;
                  end;
               end loop;
            end;
         end if;
      end Do_Shortcuts;

      procedure Do_It is new
        Handle_Standard_HTML.Process (Copy_Tags, Do_Shortcuts);

      State  : Handle_Standard_HTML.Tag_Stack;
      Result : UT.Unbounded_String;

   begin
      Do_It (Text, State, Result);
      Text := Result;
      Handle_Standard_HTML.Clear (State);
   end Transform;

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

   procedure Transform
     (Self : access Filter_HR;
      Text : in out Util.Text.Unbounded_String)
   is

      P_Tag  : constant Standard_Ptr :=
        Standard_Ptr (AD.User_Tags.Find_Tag ("P"));
      HR_Tag : constant Standard_Ptr :=
        Standard_Ptr (AD.User_Tags.Find_Tag ("HR"));

      procedure Handle_HR
        (Source   : in     String;
         Result   : in out UT.Unbounded_String;
         State    : in out Handle_Standard_HTML.Tag_Stack)
      is
         TOS : constant Standard_Ptr := Handle_Standard_HTML.TOS (State);
         TOB : constant Standard_Ptr := Handle_Standard_HTML.Top_Block (State);
      begin
         if TOS /= null and then TOS.Contains <= Pure then
            UT.Append (Result, Source);
         else
            if (TOB = null or else TOB.Contains >= Block or else TOB = P_Tag)
               and then
               (TOS = null or else TOS.Contains >= Block or else TOS = P_Tag)
            then
               --  Do it: replace any sequence "LF Dash+ LF" by "LF<HR>LF".
               declare
                  Start    : Natural  := Source'First;
                  I, J     : Natural;
                  Added_HR : Boolean  := False;
                  Initial  : Boolean  := True;
               begin
                  while Start <= Source'Last loop
                     if Initial and then Source (Start) = '-' then
                        I := Source'First - 1;
                     else
                        I :=
                          First_Index (Source (Start .. Source'Last),
                                       ASCII.LF);
                        if I = 0 then
                           UT.Append (Result, Source (Start .. Source'Last));
                           exit;
                        end if;
                     end if;
                     Initial := False;
                     J := I + 1;
                     while J <= Source'Last and then Source (J) = '-' loop
                        J := J + 1;
                     end loop;
                     if J > Source'Last or else Source (J) /= ASCII.LF then
                        --  No terminating LF found:
                        UT.Append (Result, Source (Start .. J - 1));
                     else
                        if Self.Strip then
                           UT.Append (Result, Source (Start .. I));
                        else
                           UT.Append (Result, Source (Start .. I) & "<HR>");
                           Added_HR := True;
                        end if;
                     end if;
                     Start := J;
                  end loop;
                  if Added_HR then
                     --  Correct the stack:
                     Handle_Standard_HTML.Push (State, HR_Tag, 0, 0);
                  end if;
               end;
            else
               --  Top block is pure, or top tag may contain only inline
               --  entities: don't do anything.
               UT.Append (Result, Source);
            end if;
         end if;
      end Handle_HR;

      procedure Replace_HR is new
        Handle_Standard_HTML.Process (Copy_Tags, Handle_HR);

      State  : Handle_Standard_HTML.Tag_Stack;
      Result : UT.Unbounded_String;

   begin
      Replace_HR (Text, State, Result);
      Text := Result;
      Handle_Standard_HTML.Clear (State);
   end Transform;

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

   procedure Transform
     (Self : access Filter_Standard;
      Text : in out Util.Text.Unbounded_String)
   is
      pragma Warnings (Off, Self); --  silence -gnatwa

      --  This is a non-optimized version. If performance turns out to be
      --  inadequate, do the following:
      --    - handle shortcut and plain in one go.
      --    - handle HR and para in one go.

   begin
      declare
         F : aliased Filter_Expand;          --  Expand user-defined tags
      begin
         Transform (F'Access, Text);
      end;
      declare
         F : aliased Filter_Strip;           --  Strip comments
      begin
         Transform (F'Access, Text);
      end;
      declare
         F : aliased Filter_Unknown (True);  --  Textify unknown tags
      begin
         Transform (F'Access, Text);
      end;
      declare
         F : aliased Filter_HR (True);       --  Strip dash lines
      begin
         Transform (F'Access, Text);
      end;
      declare
         F : aliased Filter_Para;            --  Insert paragraphs
      begin
         Transform (F'Access, Text);
      end;
      declare
         F : aliased Filter_Shortcut;        --  Do @-shortcut handling
      begin
         Transform (F'Access, Text);
      end;
      declare
         F : aliased Filter_Plain;           --  HTMLify the text content
      begin
         Transform (F'Access, Text);
      end;
   end Transform;

end AD.Filters;