--
-- Copyright (c) 2007-2009 Tero Koskinen <tero.koskinen@iki.fi>
--
-- Permission to use, copy, modify, and distribute this software for any
-- purpose with or without fee is hereby granted, provided that the above
-- copyright notice and this permission notice appear in all copies.
--
-- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
-- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
-- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
-- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
-- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
-- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
-- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
--

with Ada.Text_IO;
with Ada.Strings.Fixed;
with Ada.Characters.Latin_1;

with Ahven.Runner;
with Ahven.XML_Runner;
with Ahven.AStrings;

use Ada.Text_IO;
use Ada.Strings.Fixed;

package body Ahven.Text_Runner is
   use Ahven.Results;
   use Ahven.Framework;
   use Ahven.AStrings;

   -- Local procedures
   procedure Pad (Level : Natural);

   procedure Print_Test (Info   : Result_Info;
                         Level  : Natural;
                         Result : String);

   procedure Print_Passes (Result : Result_Collection;
                           Level  : Natural);

   procedure Report_Results (Result  : Result_Collection;
                             Verbose : Boolean := False);

   procedure Print_Log_File (Filename : String);

   procedure Pad (Level : Natural) is
   begin
      for A in Integer range 1 .. Level loop
         Put (" ");
      end loop;
   end Pad;

   procedure Pad (Amount : in     Natural;
                  Total  : in out Natural) is
   begin
      for A in Natural range 1 .. Amount loop
         Put (" ");
      end loop;
      Total := Total + Amount;
   end Pad;

   procedure Multiline_Pad (Input  : String;
                            Level  : Natural) is
   begin
      Pad (Level);
      for A in Input'Range loop
         Put (Input (A));
         if (Input (A) = Ada.Characters.Latin_1.LF) and (A /= Input'Last) then
            Pad (Level);
         end if;
      end loop;
   end Multiline_Pad;

   procedure Print_Test (Info   : Result_Info;
                         Level  : Natural;
                         Result : String) is
      use Ada.Strings;

      Max_Output_Width : constant := 50;
      Max_Result_Width : constant := 7;
      Max_Time_Out_Width : constant := 12;

      subtype Result_Size is Integer range 1 .. Max_Result_Width;
      subtype Time_Out_Size is Integer range 1 .. Max_Time_Out_Width;

      procedure Print_Text (Str : String; Total : in out Natural) is
      begin
         Put (Str);
         Total := Total + Str'Length;
      end Print_Text;

      Msg        : constant String := Get_Message (Info);
      Result_Out : String (Result_Size) := (others => ' ');
      Time_Out   : String (Time_Out_Size) := (others => ' ');
      Total_Text : Natural := 0;

   begin
      Pad (Level + 1, Total_Text);
      Print_Text (Get_Routine_Name (Info), Total_Text);
      if Msg'Length > 0 then
         Print_Text (" - ", Total_Text);
         Print_Text (Msg, Total_Text);
      end if;

      if Total_Text < Max_Output_Width then
         Pad (Max_Output_Width - Total_Text, Total_Text);
      end if;

      -- If we know the name of the routine, we print it,
      -- the result, and the execution time.
      if Get_Routine_Name (Info)'Length > 0 then
         Move (Source  => Result,
               Target  => Result_Out,
               Drop    => Right,
               Justify => Left,
               Pad     => ' ');
         Move (Source  => Duration'Image (Get_Execution_Time (Info)),
               Target  => Time_Out,
               Drop    => Right,
               Justify => Right,
               Pad     => ' ');
         Put (" " & Result_Out);
         Put (" " & Time_Out & "s");
      end if;
      if Get_Long_Message (Info)'Length > 0 then
         New_Line;
         Multiline_Pad (Get_Long_Message (Info), Level + 2);
      end if;

      New_Line;
   end Print_Test;

   type Print_Child_Proc is access
     procedure (Result : Result_Collection; Level : Natural);

   type Child_Count_Proc is access
     function (Result : Result_Collection) return Natural;

   procedure Print_Children (Result : Result_Collection;
                             Level  : Natural;
                             Action : Print_Child_Proc;
                             Count  : Child_Count_Proc)
   is
      Child_Iter : Result_Collection_Cursor := First_Child (Result);
   begin
      loop
         exit when not Is_Valid (Child_Iter);
         if Count.all (Data (Child_Iter).all) > 0 then
            Action.all (Data (Child_Iter).all, Level + 1);
         end if;
         Child_Iter := Next (Child_Iter);
      end loop;
   end Print_Children;

   procedure Print_Statuses (Result    : Result_Collection;
                             Level     : Natural;
                             Start     : Result_Info_Cursor;
                             Action    : Print_Child_Proc;
                             Status    : String;
                             Count     : Child_Count_Proc;
                             Print_Log : Boolean) is
      Position : Result_Info_Cursor := Start;
   begin
      if Length (Get_Test_Name (Result)) > 0 then
         Pad (Level);
         Put_Line (To_String (Get_Test_Name (Result)) & ":");
      end if;

      Test_Loop :
      loop
         exit Test_Loop when not Is_Valid (Position);
         Print_Test (Data (Position), Level, Status);
         if Print_Log and
           (Length (Get_Output_File (Data (Position))) > 0) then
            Print_Log_File (To_String (Get_Output_File (Data (Position))));
         end if;
         Position := Next (Position);
      end loop Test_Loop;

      Print_Children (Result => Result,
                      Level  => Level,
                      Action => Action,
                      Count  => Count);
   end Print_Statuses;

   --
   -- Print all failures from the result collection
   -- and then recurse into child collections.
   --
   procedure Print_Failures (Result : Result_Collection;
                             Level  : Natural) is
   begin
      Print_Statuses
        (Result    => Result,
         Level     => Level,
         Start     => First_Failure (Result),
         Action    => Print_Failures'Access,
         Status    => "FAIL",
         Count     => Failure_Count'Access,
         Print_Log => True);
   end Print_Failures;

   --
   -- Print all skips from the result collection
   -- and then recurse into child collections.
   --
   procedure Print_Skips (Result : Result_Collection;
                          Level  : Natural) is
   begin
      Print_Statuses
        (Result    => Result,
         Level     => Level,
         Start     => First_Skipped (Result),
         Action    => Print_Skips'Access,
         Status    => "SKIPPED",
         Count     => Skipped_Count'Access,
         Print_Log => True);
   end Print_Skips;

   --
   -- Print all errors from the result collection
   -- and then recurse into child collections.
   --
   procedure Print_Errors (Result : Result_Collection;
                           Level  : Natural) is
   begin
      Print_Statuses
        (Result    => Result,
         Level     => Level,
         Start     => First_Error (Result),
         Action    => Print_Errors'Access,
         Status    => "ERROR",
         Count     => Error_Count'Access,
         Print_Log => True);
   end Print_Errors;

   --
   -- Print all passes from the result collection
   -- and then recurse into child collections.
   --
   procedure Print_Passes (Result : Result_Collection;
                           Level  : Natural) is
   begin
      Print_Statuses
        (Result    => Result,
         Level     => Level,
         Start     => First_Pass (Result),
         Action    => Print_Passes'Access,
         Status    => "PASS",
         Count     => Pass_Count'Access,
         Print_Log => False);
   end Print_Passes;

   --
   -- Report passes, skips, failures, and errors from the result collection.
   procedure Report_Results (Result  : Result_Collection;
                             Verbose : Boolean := False) is
   begin
      Put_Line ("Passed : " & Integer'Image (Pass_Count (Result)));
      if Verbose then
         Print_Passes (Result, 0);
      end if;
      New_Line;
      if Skipped_Count (Result) > 0 then
         Put_Line ("Skipped : " & Integer'Image (Skipped_Count (Result)));
         Print_Skips (Result, 0);
         New_Line;
      end if;
      if Failure_Count (Result) > 0 then
         Put_Line ("Failed : " & Integer'Image (Failure_Count (Result)));
         Print_Failures (Result, 0);
         New_Line;
      end if;
      if Error_Count (Result) > 0 then
         Put_Line ("Errors : " & Integer'Image (Error_Count (Result)));
         Print_Errors (Result, 0);
      end if;
   end Report_Results;

   procedure Print_Log_File (Filename : String) is
      Handle : File_Type;
      Char   : Character := ' ';
      First  : Boolean := True;
   begin
      Open (Handle, In_File, Filename);
      loop
         exit when End_Of_File (Handle);
         Get (Handle, Char);
         if First then
            Put_Line ("===== Output =======");
            First := False;
         end if;
         Put (Char);
         if End_Of_Line (Handle) then
            New_Line;
         end if;
      end loop;
      Close (Handle);
      if not First then
         Put_Line ("====================");
      end if;
   end Print_Log_File;

   procedure Do_Report (Test_Results : Results.Result_Collection;
                        Args         : Parameters.Parameter_Info) is
   begin
      if Parameters.XML_Results (Args) then
         XML_Runner.Report_Results
           (Test_Results, Parameters.Result_Dir (Args));
      else
         Report_Results (Test_Results, Parameters.Verbose (Args));
      end if;
   end Do_Report;

   procedure Run (Suite : in out Framework.Test'Class) is
   begin
      Runner.Run_Suite (Suite, Do_Report'Access);
   end Run;

   procedure Run (Suite : Framework.Test_Suite_Access) is
   begin
      Run (Suite.all);
   end Run;
end Ahven.Text_Runner;

--
-- Copyright (c) 2007-2009 Tero Koskinen <tero.koskinen@iki.fi>
--
-- Permission to use, copy, modify, and distribute this software for any
-- purpose with or without fee is hereby granted, provided that the above
-- copyright notice and this permission notice appear in all copies.
--
-- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
-- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
-- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
-- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
-- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
-- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
-- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
--

with Ada.Text_IO;
with Ada.Strings.Fixed;
with Ada.Characters.Latin_1;
with Ada.IO_Exceptions;

with Ahven.Runner;
with Ahven.XML_Runner;
with Ahven.AStrings;

use Ada.Text_IO;
use Ada.Strings.Fixed;

package body Ahven.Text_Runner is
   use Ahven.Results;
   use Ahven.Framework;
   use Ahven.AStrings;

   -- Local procedures
   procedure Pad (Level : Natural);

   procedure Print_Test (Info   : Result_Info;
                         Level  : Natural;
                         Result : String);

   procedure Print_Passes (Result : Result_Collection;
                           Level  : Natural);

   procedure Report_Results (Result  : Result_Collection;
                             Verbose : Boolean := False);

   procedure Print_Log_File (Filename : String);

   procedure Pad (Level : Natural) is
   begin
      for A in Integer range 1 .. Level loop
         Put (" ");
      end loop;
   end Pad;

   procedure Pad (Amount : in     Natural;
                  Total  : in out Natural) is
   begin
      for A in Natural range 1 .. Amount loop
         Put (" ");
      end loop;
      Total := Total + Amount;
   end Pad;

   procedure Multiline_Pad (Input  : String;
                            Level  : Natural) is
   begin
      Pad (Level);
      for A in Input'Range loop
         Put (Input (A));
         if (Input (A) = Ada.Characters.Latin_1.LF) and (A /= Input'Last) then
            Pad (Level);
         end if;
      end loop;
   end Multiline_Pad;

   procedure Print_Test (Info   : Result_Info;
                         Level  : Natural;
                         Result : String) is
      use Ada.Strings;

      Max_Output_Width : constant := 50;
      Max_Result_Width : constant := 7;
      Max_Time_Out_Width : constant := 12;

      subtype Result_Size is Integer range 1 .. Max_Result_Width;
      subtype Time_Out_Size is Integer range 1 .. Max_Time_Out_Width;

      procedure Print_Text (Str : String; Total : in out Natural) is
      begin
         Put (Str);
         Total := Total + Str'Length;
      end Print_Text;

      Msg        : constant String := Get_Message (Info);
      Result_Out : String (Result_Size) := (others => ' ');
      Time_Out   : String (Time_Out_Size) := (others => ' ');
      Total_Text : Natural := 0;

   begin
      Pad (Level + 1, Total_Text);
      Print_Text (Get_Routine_Name (Info), Total_Text);
      if Msg'Length > 0 then
         Print_Text (" - ", Total_Text);
         Print_Text (Msg, Total_Text);
      end if;

      if Total_Text < Max_Output_Width then
         Pad (Max_Output_Width - Total_Text, Total_Text);
      end if;

      -- If we know the name of the routine, we print it,
      -- the result, and the execution time.
      if Get_Routine_Name (Info)'Length > 0 then
         Move (Source  => Result,
               Target  => Result_Out,
               Drop    => Right,
               Justify => Left,
               Pad     => ' ');
         Move (Source  => Duration'Image (Get_Execution_Time (Info)),
               Target  => Time_Out,
               Drop    => Right,
               Justify => Right,
               Pad     => ' ');
         Put (" " & Result_Out);
         Put (" " & Time_Out & "s");
      end if;
      if Get_Long_Message (Info)'Length > 0 then
         New_Line;
         Multiline_Pad (Get_Long_Message (Info), Level + 2);
      end if;

      New_Line;
   end Print_Test;

   type Print_Child_Proc is access
     procedure (Result : Result_Collection; Level : Natural);

   type Child_Count_Proc is access
     function (Result : Result_Collection) return Natural;

   procedure Print_Children (Result : Result_Collection;
                             Level  : Natural;
                             Action : Print_Child_Proc;
                             Count  : Child_Count_Proc)
   is
      Child_Iter : Result_Collection_Cursor := First_Child (Result);
   begin
      loop
         exit when not Is_Valid (Child_Iter);
         if Count.all (Data (Child_Iter).all) > 0 then
            Action.all (Data (Child_Iter).all, Level + 1);
         end if;
         Child_Iter := Next (Child_Iter);
      end loop;
   end Print_Children;

   procedure Print_Statuses (Result    : Result_Collection;
                             Level     : Natural;
                             Start     : Result_Info_Cursor;
                             Action    : Print_Child_Proc;
                             Status    : String;
                             Count     : Child_Count_Proc;
                             Print_Log : Boolean) is
      Position : Result_Info_Cursor := Start;
   begin
      if Length (Get_Test_Name (Result)) > 0 then
         Pad (Level);
         Put_Line (To_String (Get_Test_Name (Result)) & ":");
      end if;

      Test_Loop :
      loop
         exit Test_Loop when not Is_Valid (Position);
         Print_Test (Data (Position), Level, Status);
         if Print_Log and
           (Length (Get_Output_File (Data (Position))) > 0) then
            Print_Log_File (To_String (Get_Output_File (Data (Position))));
         end if;
         Position := Next (Position);
      end loop Test_Loop;

      Print_Children (Result => Result,
                      Level  => Level,
                      Action => Action,
                      Count  => Count);
   end Print_Statuses;

   --
   -- Print all failures from the result collection
   -- and then recurse into child collections.
   --
   procedure Print_Failures (Result : Result_Collection;
                             Level  : Natural) is
   begin
      Print_Statuses
        (Result    => Result,
         Level     => Level,
         Start     => First_Failure (Result),
         Action    => Print_Failures'Access,
         Status    => "FAIL",
         Count     => Failure_Count'Access,
         Print_Log => True);
   end Print_Failures;

   --
   -- Print all skips from the result collection
   -- and then recurse into child collections.
   --
   procedure Print_Skips (Result : Result_Collection;
                          Level  : Natural) is
   begin
      Print_Statuses
        (Result    => Result,
         Level     => Level,
         Start     => First_Skipped (Result),
         Action    => Print_Skips'Access,
         Status    => "SKIPPED",
         Count     => Skipped_Count'Access,
         Print_Log => True);
   end Print_Skips;

   --
   -- Print all errors from the result collection
   -- and then recurse into child collections.
   --
   procedure Print_Errors (Result : Result_Collection;
                           Level  : Natural) is
   begin
      Print_Statuses
        (Result    => Result,
         Level     => Level,
         Start     => First_Error (Result),
         Action    => Print_Errors'Access,
         Status    => "ERROR",
         Count     => Error_Count'Access,
         Print_Log => True);
   end Print_Errors;

   --
   -- Print all passes from the result collection
   -- and then recurse into child collections.
   --
   procedure Print_Passes (Result : Result_Collection;
                           Level  : Natural) is
   begin
      Print_Statuses
        (Result    => Result,
         Level     => Level,
         Start     => First_Pass (Result),
         Action    => Print_Passes'Access,
         Status    => "PASS",
         Count     => Pass_Count'Access,
         Print_Log => False);
   end Print_Passes;

   --
   -- Report passes, skips, failures, and errors from the result collection.
   procedure Report_Results (Result  : Result_Collection;
                             Verbose : Boolean := False) is
   begin
      Put_Line ("Passed : " & Integer'Image (Pass_Count (Result)));
      if Verbose then
         Print_Passes (Result, 0);
      end if;
      New_Line;
      if Skipped_Count (Result) > 0 then
         Put_Line ("Skipped : " & Integer'Image (Skipped_Count (Result)));
         Print_Skips (Result, 0);
         New_Line;
      end if;
      if Failure_Count (Result) > 0 then
         Put_Line ("Failed : " & Integer'Image (Failure_Count (Result)));
         Print_Failures (Result, 0);
         New_Line;
      end if;
      if Error_Count (Result) > 0 then
         Put_Line ("Errors : " & Integer'Image (Error_Count (Result)));
         Print_Errors (Result, 0);
      end if;
   end Report_Results;

   procedure Print_Log_File (Filename : String) is
      Handle : File_Type;
      Char   : Character := ' ';
      First  : Boolean := True;
   begin
      Open (Handle, In_File, Filename);
      begin
         loop
            exit when End_Of_File (Handle);
            Get (Handle, Char);
            if First then
               Put_Line ("===== Output =======");
               First := False;
            end if;
            Put (Char);
            if End_Of_Line (Handle) then
               New_Line;
            end if;

         end loop;

         --  The End_Error exception is sometimes raised.
      exception
         when Ada.IO_Exceptions.End_Error =>
            null;

      end;
      Close (Handle);
      if not First then
         Put_Line ("====================");
      end if;
   end Print_Log_File;

   procedure Do_Report (Test_Results : Results.Result_Collection;
                        Args         : Parameters.Parameter_Info) is
   begin
      if Parameters.XML_Results (Args) then
         XML_Runner.Report_Results
           (Test_Results, Parameters.Result_Dir (Args));
      else
         Report_Results (Test_Results, Parameters.Verbose (Args));
      end if;
   end Do_Report;

   procedure Run (Suite : in out Framework.Test'Class) is
   begin
      Runner.Run_Suite (Suite, Do_Report'Access);
   end Run;

   procedure Run (Suite : Framework.Test_Suite_Access) is
   begin
      Run (Suite.all);
   end Run;
end Ahven.Text_Runner;

Fix the Ahven text runner: the END_ERROR exception can be raised when reading the test output file


-----------------------------------------------------------------------
--  gen-commands-templates -- Template based command
--  Copyright (C) 2011 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------

with Ada.Containers.Vectors;
with Util.Strings.Sets;
package Gen.Commands.Templates is

   --  ------------------------------
   --  Template Generic Command
   --  ------------------------------
   --  This command adds a XHTML page to the web application.
   type Command is new Gen.Commands.Command with private;
   type Command_Access is access all Command'Class;

   --  Execute the command with the arguments.
   procedure Execute (Cmd       : in Command;
                      Generator : in out Gen.Generator.Handler);

   --  Write the help associated with the command.
   procedure Help (Cmd       : in Command;
                   Generator : in out Gen.Generator.Handler);

   --  Read the template commands defined in dynamo configuration directory.
   procedure Read_Commands (Generator : in out Gen.Generator.Handler);

private

   type Param is record
      Name        : Ada.Strings.Unbounded.Unbounded_String;
      Argument    : Ada.Strings.Unbounded.Unbounded_String;
      Value       : Ada.Strings.Unbounded.Unbounded_String;
      Is_Optional : Boolean := False;
   end record;

   package Param_Vectors is
      new Ada.Containers.Vectors (Index_Type   => Positive,
                                  Element_Type => Param);

   type Command is new Gen.Commands.Command with record
      Name      : Ada.Strings.Unbounded.Unbounded_String;
      Title     : Ada.Strings.Unbounded.Unbounded_String;
      Usage     : Ada.Strings.Unbounded.Unbounded_String;
      Help_Msg  : Ada.Strings.Unbounded.Unbounded_String;
      Base_Dir  : Ada.Strings.Unbounded.Unbounded_String;
      Templates : Util.Strings.Sets.Set;
      Params    : Param_Vectors.Vector;
   end record;

end Gen.Commands.Templates;

-----------------------------------------------------------------------
--  gen-commands-templates -- Template based command
--  Copyright (C) 2011, 2013 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------

with Ada.Containers.Vectors;
with Util.Strings.Sets;
with Util.Strings.Vectors;
package Gen.Commands.Templates is

   --  ------------------------------
   --  Template Generic Command
   --  ------------------------------
   --  This command adds a XHTML page to the web application.
   type Command is new Gen.Commands.Command with private;
   type Command_Access is access all Command'Class;

   --  Execute the command with the arguments.
   procedure Execute (Cmd       : in Command;
                      Generator : in out Gen.Generator.Handler);

   --  Write the help associated with the command.
   procedure Help (Cmd       : in Command;
                   Generator : in out Gen.Generator.Handler);

   --  Read the template commands defined in dynamo configuration directory.
   procedure Read_Commands (Generator : in out Gen.Generator.Handler);

private

   type Param is record
      Name        : Ada.Strings.Unbounded.Unbounded_String;
      Argument    : Ada.Strings.Unbounded.Unbounded_String;
      Value       : Ada.Strings.Unbounded.Unbounded_String;
      Is_Optional : Boolean := False;
   end record;

   package Param_Vectors is
      new Ada.Containers.Vectors (Index_Type   => Positive,
                                  Element_Type => Param);

   type Patch is record
      Template  : Ada.Strings.Unbounded.Unbounded_String;
      After     : Util.Strings.Vectors.Vector;
      Before    : Ada.Strings.Unbounded.Unbounded_String;
   end record;

   package Patch_Vectors is
     new Ada.Containers.Vectors (Index_Type   => Positive,
                                 Element_Type => Patch);

   type Command is new Gen.Commands.Command with record
      Name      : Ada.Strings.Unbounded.Unbounded_String;
      Title     : Ada.Strings.Unbounded.Unbounded_String;
      Usage     : Ada.Strings.Unbounded.Unbounded_String;
      Help_Msg  : Ada.Strings.Unbounded.Unbounded_String;
      Base_Dir  : Ada.Strings.Unbounded.Unbounded_String;
      Templates : Util.Strings.Sets.Set;
      Patches   : Patch_Vectors.Vector;
      Params    : Param_Vectors.Vector;
   end record;

end Gen.Commands.Templates;

Add support to patch files when executing some template command


--  SPDX-License-Identifier: Apache-2.0
--
--  Copyright (c) 2012 Felix Krause <contact@flyx.org>
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.

private with GL.Low_Level;
with GL.Types;

package GL.Toggles is
   pragma Preelaborate;

   type Toggle_State is (Disabled, Enabled);

   type Toggle is (Line_Smooth, Polygon_Smooth, Cull_Face, Depth_Test,
                   Stencil_Test, Dither, Blend, Color_Logic_Op, Scissor_Test,
                   Polygon_Offset_Point, Polygon_Offset_Line,
                   Clip_Distance_0, Clip_Distance_1, Clip_Distance_2, Clip_Distance_3,
                   Clip_Distance_4, Clip_Distance_5, Clip_Distance_6, Clip_Distance_7,
                   Polygon_Offset_Fill, Multisample,
                   Sample_Alpha_To_Coverage, Sample_Alpha_To_One, Sample_Coverage,
                   Debug_Output_Synchronous,
                   Program_Point_Size, Depth_Clamp,
                   Texture_Cube_Map_Seamless, Sample_Shading,
                   Rasterizer_Discard, Primitive_Restart_Fixed_Index,
                   Framebuffer_SRGB, Sample_Mask, Primitive_Restart,
                   Debug_Output);

   procedure Enable  (Subject : Toggle);
   procedure Disable (Subject : Toggle);

   procedure Set (Subject : Toggle; Value : Toggle_State);
   function State (Subject : Toggle) return Toggle_State;

   subtype Toggle_Indexed is Toggle
     with Static_Predicate => Toggle_Indexed in Scissor_Test | Blend;

   procedure Enable  (Subject : Toggle_Indexed; Index : Types.UInt);
   procedure Disable (Subject : Toggle_Indexed; Index : Types.UInt);

   procedure Set (Subject : Toggle_Indexed; Index : Types.UInt; Value : Toggle_State);
   function State (Subject : Toggle_Indexed; Index : Types.UInt) return Toggle_State;

private

   for Toggle use (Line_Smooth               => 16#0B20#,
                   Polygon_Smooth            => 16#0B41#,
                   Cull_Face                 => 16#0B44#,
                   Depth_Test                => 16#0B71#,
                   Stencil_Test              => 16#0B90#,
                   Dither                    => 16#0BD0#,
                   Blend                     => 16#0BE2#,
                   Color_Logic_Op            => 16#0BF2#,
                   Scissor_Test              => 16#0C11#,
                   Polygon_Offset_Point      => 16#2A01#,
                   Polygon_Offset_Line       => 16#2A02#,
                   Clip_Distance_0           => 16#3000#,
                   Clip_Distance_1           => 16#3001#,
                   Clip_Distance_2           => 16#3002#,
                   Clip_Distance_3           => 16#3003#,
                   Clip_Distance_4           => 16#3004#,
                   Clip_Distance_5           => 16#3005#,
                   Clip_Distance_6           => 16#3006#,
                   Clip_Distance_7           => 16#3007#,
                   Polygon_Offset_Fill       => 16#8037#,
                   Multisample               => 16#809D#,
                   Sample_Alpha_To_Coverage  => 16#809E#,
                   Sample_Alpha_To_One       => 16#809F#,
                   Sample_Coverage           => 16#80A0#,
                   Debug_Output_Synchronous  => 16#8242#,
                   Program_Point_Size        => 16#8642#,
                   Depth_Clamp               => 16#864F#,
                   Texture_Cube_Map_Seamless => 16#884F#,
                   Sample_Shading            => 16#8C36#,
                   Rasterizer_Discard        => 16#8C89#,
                   Primitive_Restart_Fixed_Index => 16#8D69#,
                   Framebuffer_SRGB          => 16#8DB9#,
                   Sample_Mask               => 16#8E51#,
                   Primitive_Restart         => 16#8F9D#,
                   Debug_Output              => 16#92E0#);
   for Toggle'Size use Low_Level.Enum'Size;

end GL.Toggles;

--  SPDX-License-Identifier: Apache-2.0
--
--  Copyright (c) 2012 Felix Krause <contact@flyx.org>
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.

private with GL.Low_Level;
with GL.Types;

package GL.Toggles is
   pragma Preelaborate;

   type Toggle_State is (Disabled, Enabled);

   type Toggle is (Line_Smooth, Polygon_Smooth, Cull_Face, Depth_Test,
                   Stencil_Test, Dither, Blend, Color_Logic_Op, Scissor_Test,
                   Polygon_Offset_Point, Polygon_Offset_Line,
                   Clip_Distance_0, Clip_Distance_1, Clip_Distance_2, Clip_Distance_3,
                   Clip_Distance_4, Clip_Distance_5, Clip_Distance_6, Clip_Distance_7,
                   Polygon_Offset_Fill, Multisample,
                   Sample_Alpha_To_Coverage, Sample_Alpha_To_One, Sample_Coverage,
                   Debug_Output_Synchronous,
                   Program_Point_Size, Depth_Clamp,
                   Texture_Cube_Map_Seamless, Sample_Shading,
                   Rasterizer_Discard, Primitive_Restart_Fixed_Index,
                   Framebuffer_SRGB, Sample_Mask, Primitive_Restart,
                   Debug_Output);

   procedure Enable  (Subject : Toggle);
   procedure Disable (Subject : Toggle);

   procedure Set (Subject : Toggle; Value : Toggle_State);
   function State (Subject : Toggle) return Toggle_State;

   type Toggle_Indexed is (Blend, Scissor_Test);

   procedure Enable  (Subject : Toggle_Indexed; Index : Types.UInt);
   procedure Disable (Subject : Toggle_Indexed; Index : Types.UInt);

   procedure Set (Subject : Toggle_Indexed; Index : Types.UInt; Value : Toggle_State);
   function State (Subject : Toggle_Indexed; Index : Types.UInt) return Toggle_State;

private

   for Toggle use (Line_Smooth               => 16#0B20#,
                   Polygon_Smooth            => 16#0B41#,
                   Cull_Face                 => 16#0B44#,
                   Depth_Test                => 16#0B71#,
                   Stencil_Test              => 16#0B90#,
                   Dither                    => 16#0BD0#,
                   Blend                     => 16#0BE2#,
                   Color_Logic_Op            => 16#0BF2#,
                   Scissor_Test              => 16#0C11#,
                   Polygon_Offset_Point      => 16#2A01#,
                   Polygon_Offset_Line       => 16#2A02#,
                   Clip_Distance_0           => 16#3000#,
                   Clip_Distance_1           => 16#3001#,
                   Clip_Distance_2           => 16#3002#,
                   Clip_Distance_3           => 16#3003#,
                   Clip_Distance_4           => 16#3004#,
                   Clip_Distance_5           => 16#3005#,
                   Clip_Distance_6           => 16#3006#,
                   Clip_Distance_7           => 16#3007#,
                   Polygon_Offset_Fill       => 16#8037#,
                   Multisample               => 16#809D#,
                   Sample_Alpha_To_Coverage  => 16#809E#,
                   Sample_Alpha_To_One       => 16#809F#,
                   Sample_Coverage           => 16#80A0#,
                   Debug_Output_Synchronous  => 16#8242#,
                   Program_Point_Size        => 16#8642#,
                   Depth_Clamp               => 16#864F#,
                   Texture_Cube_Map_Seamless => 16#884F#,
                   Sample_Shading            => 16#8C36#,
                   Rasterizer_Discard        => 16#8C89#,
                   Primitive_Restart_Fixed_Index => 16#8D69#,
                   Framebuffer_SRGB          => 16#8DB9#,
                   Sample_Mask               => 16#8E51#,
                   Primitive_Restart         => 16#8F9D#,
                   Debug_Output              => 16#92E0#);
   for Toggle'Size use Low_Level.Enum'Size;

   for Toggle_Indexed use
     (Blend        => 16#0BE2#,
      Scissor_Test => 16#0C11#);
   for Toggle_Indexed'Size use Low_Level.Enum'Size;

end GL.Toggles;

gl: Make subtype Toggle_Indexed a type to workaround compiler bug

Static_Predicate would fail for value GL.Toggles.Blend. Changing
Toggle_Indexed from a subtype with a predicate to a separate type avoids
raising the Assert_Failure exception when compiled with GNAT FSF.

Signed-off-by: onox <34c1d3d2d1347bea60a26f46574de21a7a79b6d5@gmail.com>


-----------------------------------------------------------------------
--  wiki-nodes -- Wiki Document Internal representation
--  Copyright (C) 2016, 2019, 2020 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------

package body Wiki.Documents is

   use Wiki.Nodes;
   use Wiki.Nodes.Lists;

   --  ------------------------------
   --  Append a HTML tag start node to the document.
   --  ------------------------------
   procedure Push_Node (Into       : in out Document;
                        Tag        : in Html_Tag;
                        Attributes : in Wiki.Attributes.Attribute_List) is

      Node : constant Node_Type_Access := new Node_Type '(Kind       => N_TAG_START,
                                                          Len        => 0,
                                                          Tag_Start  => Tag,
                                                          Attributes => Attributes,
                                                          Children   => null,
                                                          Parent     => Into.Current);
   begin
      Append (Into, Node);
      Into.Current := Node;
   end Push_Node;

   --  ------------------------------
   --  Pop the HTML tag.
   --  ------------------------------
   procedure Pop_Node (From : in out Document;
                       Tag  : in Html_Tag) is
      pragma Unreferenced (Tag);
   begin
      if From.Current /= null then
         From.Current := From.Current.Parent;
      end if;
   end Pop_Node;

   --  ------------------------------
   --  Returns True if the current node is the root document node.
   --  ------------------------------
   function Is_Root_Node (Doc : in Document) return Boolean is
   begin
      return Doc.Current = null;
   end Is_Root_Node;

   --  ------------------------------
   --  Append a section header at end of the document.
   --  ------------------------------
   procedure Append (Into   : in out Document;
                     Header : in Wiki.Strings.WString;
                     Level  : in Positive) is
   begin
      Append (Into, new Node_Type '(Kind   => N_HEADER,
                                    Len    => Header'Length,
                                    Parent => Into.Current,
                                    Header => Header,
                                    Level  => Level));
   end Append;

   --  ------------------------------
   --  Append a node to the document.
   --  ------------------------------
   procedure Append (Into : in out Document;
                     Node : in Wiki.Nodes.Node_Type_Access) is
   begin
      if Into.Current = null then
         Append (Into.Nodes, Node);
      else
         Append (Into.Current, Node);
      end if;
   end Append;

   --  ------------------------------
   --  Append a simple node such as N_LINE_BREAK, N_HORIZONTAL_RULE or N_PARAGRAPH.
   --  ------------------------------
   procedure Append (Into : in out Document;
                     Kind : in Simple_Node_Kind) is
   begin
      case Kind is
         when N_LINE_BREAK =>
            Append (Into, new Node_Type '(Kind => N_LINE_BREAK, Len => 0,
                                          Parent => Into.Current));

         when N_HORIZONTAL_RULE =>
            Append (Into, new Node_Type '(Kind => N_HORIZONTAL_RULE, Len => 0,
                                          Parent => Into.Current));

         when N_PARAGRAPH =>
            Append (Into, new Node_Type '(Kind => N_PARAGRAPH, Len => 0,
                                          Parent => Into.Current));

         when N_NEWLINE =>
            Append (Into, new Node_Type '(Kind => N_NEWLINE, Len => 0,
                                          Parent => Into.Current));

         when N_TOC_DISPLAY =>
            Append (Into, new Node_Type '(Kind => N_TOC_DISPLAY, Len => 0,
                                          Parent => Into.Current));
            Into.Using_TOC := True;

      end  case;
   end Append;

   --  ------------------------------
   --  Append the text with the given format at end of the document.
   --  ------------------------------
   procedure Append (Into   : in out Document;
                     Text   : in Wiki.Strings.WString;
                     Format : in Format_Map) is
   begin
      Append (Into, new Node_Type '(Kind => N_TEXT, Len => Text'Length,
                                    Parent => Into.Current,
                                    Text => Text, Format => Format));
   end Append;

   --  ------------------------------
   --  Add a link.
   --  ------------------------------
   procedure Add_Link (Into       : in out Document;
                       Name       : in Wiki.Strings.WString;
                       Attributes : in out Wiki.Attributes.Attribute_List) is
   begin
      Append (Into, new Node_Type '(Kind => N_LINK, Len => Name'Length,
                                    Parent => Into.Current,
                                    Title => Name, Link_Attr => Attributes));
   end Add_Link;

   --  ------------------------------
   --  Add an image.
   --  ------------------------------
   procedure Add_Image (Into       : in out Document;
                        Name       : in Wiki.Strings.WString;
                        Attributes : in out Wiki.Attributes.Attribute_List) is
   begin
      Append (Into, new Node_Type '(Kind => N_IMAGE, Len => Name'Length,
                                    Parent => Into.Current,
                                    Title => Name, Link_Attr => Attributes));
   end Add_Image;

   --  ------------------------------
   --  Add a quote.
   --  ------------------------------
   procedure Add_Quote (Into       : in out Document;
                        Name       : in Wiki.Strings.WString;
                        Attributes : in out Wiki.Attributes.Attribute_List) is
   begin
      Append (Into, new Node_Type '(Kind => N_QUOTE, Len => Name'Length,
                                    Parent => Into.Current,
                                    Title => Name, Link_Attr => Attributes));
   end Add_Quote;

   --  ------------------------------
   --  Add a list item (<li>).  Close the previous paragraph and list item if any.
   --  The list item will be closed at the next list item, next paragraph or next header.
   --  ------------------------------
   procedure Add_List_Item (Into     : in out Document;
                            Level    : in Positive;
                            Ordered  : in Boolean) is
   begin
      if Ordered then
         Append (Into, new Node_Type '(Kind => N_NUM_LIST, Len => 0,
                                       Parent => Into.Current,
                                       Level => Level, others => <>));
      else
         Append (Into, new Node_Type '(Kind => N_LIST, Len => 0,
                                       Parent => Into.Current,
                                       Level => Level, others => <>));
      end if;
   end Add_List_Item;

   --  ------------------------------
   --  Add a blockquote (<blockquote>).  The level indicates the blockquote nested level.
   --  The blockquote must be closed at the next header.
   --  ------------------------------
   procedure Add_Blockquote (Into     : in out Document;
                             Level    : in Natural) is
   begin
      Append (Into, new Node_Type '(Kind => N_BLOCKQUOTE, Len => 0,
                                    Parent => Into.Current,
                                    Level => Level, others => <>));
   end Add_Blockquote;

   --  ------------------------------
   --  Add a text block that is pre-formatted.
   --  ------------------------------
   procedure Add_Preformatted (Into     : in out Document;
                               Text     : in Wiki.Strings.WString;
                               Format   : in Wiki.Strings.WString) is
   begin
      Append (Into, new Node_Type '(Kind => N_PREFORMAT, Len => Text'Length,
                                    Parent => Into.Current,
                                    Preformatted => Text,
                                    Language => Strings.To_UString (Format)));
   end Add_Preformatted;

   --  ------------------------------
   --  Add a new row to the current table.
   --  ------------------------------
   procedure Add_Row (Into : in out Document) is
      Table : Node_Type_Access;
      Row   : Node_Type_Access;
   begin
      --  Identify the current table.
      Table := Into.Current;
      while Table /= null and then Table.Kind /= N_TABLE loop
         Table := Table.Parent;
      end loop;

      --  Create the current table.
      if Table = null then
         Table := new Node_Type '(Kind       => N_TABLE,
                                  Len        => 0,
                                  Tag_Start  => TABLE_TAG,
                                  Children   => null,
                                  Parent     => Into.Current,
                                  others     => <>);
         Append (Into, Table);
      end if;

      --  Add the row.
      Row := new Node_Type '(Kind       => N_ROW,
                             Len        => 0,
                             Tag_Start  => TR_TAG,
                             Children   => null,
                             Parent     => Table,
                             others     => <>);
      Append (Table, Row);
      Into.Current := Row;
   end Add_Row;

   --  ------------------------------
   --  Add a column to the current table row.  The column is configured with the
   --  given attributes.  The column content is provided through calls to Append.
   --  ------------------------------
   procedure Add_Column (Into : in out Document;
                         Attributes : in out Wiki.Attributes.Attribute_List) is
      Row  : Node_Type_Access;
      Col  : Node_Type_Access;
   begin
      --  Identify the current row.
      Row := Into.Current;
      while Row /= null and then Row.Kind /= N_ROW loop
         Row := Row.Parent;
      end loop;

      --  Add the new column.
      Col := new Node_Type '(Kind       => N_COLUMN,
                             Len        => 0,
                             Tag_Start  => TD_TAG,
                             Children   => null,
                             Parent     => Row,
                             Attributes => Attributes);
      Append (Row, Col);
      Into.Current := Col;
   end Add_Column;

   --  ------------------------------
   --  Finish the creation of the table.
   --  ------------------------------
   procedure Finish_Table (Into : in out Document) is
      Table : Node_Type_Access;
   begin
      --  Identify the current table.
      Table := Into.Current;
      while Table /= null and then Table.Kind /= N_TABLE loop
         Table := Table.Parent;
      end loop;
      if Table /= null then
         Into.Current := Table.Parent;
      else
         Into.Current := null;
      end if;
   end Finish_Table;

   --  ------------------------------
   --  Iterate over the nodes of the list and call the <tt>Process</tt> procedure with
   --  each node instance.
   --  ------------------------------
   procedure Iterate (Doc     : in Document;
                      Process : not null access procedure (Node : in Node_Type)) is
   begin
      Iterate (Doc.Nodes, Process);
   end Iterate;

   --  ------------------------------
   --  Returns True if the document is empty.
   --  ------------------------------
   function Is_Empty (Doc : in Document) return Boolean is
   begin
      return Wiki.Nodes.Lists.Is_Empty (Doc.Nodes);
   end Is_Empty;

   --  ------------------------------
   --  Returns True if the document displays the table of contents by itself.
   --  ------------------------------
   function Is_Using_TOC (Doc : in Document) return Boolean is
   begin
      return Doc.Using_TOC;
   end Is_Using_TOC;

   --  ------------------------------
   --  Returns True if the table of contents is visible and must be rendered.
   --  ------------------------------
   function Is_Visible_TOC (Doc : in Document) return Boolean is
   begin
      return Doc.Visible_TOC;
   end Is_Visible_TOC;

   --  ------------------------------
   --  Hide the table of contents.
   --  ------------------------------
   procedure Hide_TOC (Doc : in out Document) is
   begin
      Doc.Visible_TOC := False;
   end Hide_TOC;

   --  ------------------------------
   --  Get the table of content node associated with the document.
   --  ------------------------------
   procedure Get_TOC (Doc : in out Document;
                      TOC : out Wiki.Nodes.Lists.Node_List_Ref) is
   begin
      if Wiki.Nodes.Lists.Is_Empty (Doc.TOC) then
         Append (Doc.TOC, new Node_Type '(Kind => N_TOC, Len => 0, others => <>));
      end if;
      TOC := Doc.TOC;
   end Get_TOC;

   --  ------------------------------
   --  Get the table of content node associated with the document.
   --  ------------------------------
   function Get_TOC (Doc : in Document) return Wiki.Nodes.Lists.Node_List_Ref is
   begin
      return Doc.TOC;
   end Get_TOC;

end Wiki.Documents;

-----------------------------------------------------------------------
--  wiki-nodes -- Wiki Document Internal representation
--  Copyright (C) 2016, 2019, 2020, 2022 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------

package body Wiki.Documents is

   use Wiki.Nodes;
   use Wiki.Nodes.Lists;

   --  ------------------------------
   --  Append a HTML tag start node to the document.
   --  ------------------------------
   procedure Push_Node (Into       : in out Document;
                        Tag        : in Html_Tag;
                        Attributes : in Wiki.Attributes.Attribute_List) is

      Node : constant Node_Type_Access := new Node_Type '(Kind       => N_TAG_START,
                                                          Len        => 0,
                                                          Tag_Start  => Tag,
                                                          Attributes => Attributes,
                                                          Children   => null,
                                                          Parent     => Into.Current);
   begin
      Append (Into, Node);
      Into.Current := Node;
   end Push_Node;

   --  ------------------------------
   --  Pop the HTML tag.
   --  ------------------------------
   procedure Pop_Node (From : in out Document;
                       Tag  : in Html_Tag) is
      pragma Unreferenced (Tag);
   begin
      if From.Current /= null then
         From.Current := From.Current.Parent;
      end if;
   end Pop_Node;

   --  ------------------------------
   --  Returns True if the current node is the root document node.
   --  ------------------------------
   function Is_Root_Node (Doc : in Document) return Boolean is
   begin
      return Doc.Current = null;
   end Is_Root_Node;

   --  ------------------------------
   --  Append a section header at end of the document.
   --  ------------------------------
   procedure Append (Into   : in out Document;
                     Header : in Wiki.Strings.WString;
                     Level  : in Positive) is
   begin
      Append (Into, new Node_Type '(Kind   => N_HEADER,
                                    Len    => Header'Length,
                                    Parent => Into.Current,
                                    Header => Header,
                                    Level  => Level));
   end Append;

   --  ------------------------------
   --  Append a node to the document.
   --  ------------------------------
   procedure Append (Into : in out Document;
                     Node : in Wiki.Nodes.Node_Type_Access) is
   begin
      if Into.Current = null then
         Append (Into.Nodes, Node);
      else
         Append (Into.Current, Node);
      end if;
   end Append;

   --  ------------------------------
   --  Append a simple node such as N_LINE_BREAK, N_HORIZONTAL_RULE or N_PARAGRAPH.
   --  ------------------------------
   procedure Append (Into : in out Document;
                     Kind : in Simple_Node_Kind) is
   begin
      case Kind is
         when N_LINE_BREAK =>
            Append (Into, new Node_Type '(Kind => N_LINE_BREAK, Len => 0,
                                          Parent => Into.Current));

         when N_HORIZONTAL_RULE =>
            Append (Into, new Node_Type '(Kind => N_HORIZONTAL_RULE, Len => 0,
                                          Parent => Into.Current));

         when N_PARAGRAPH =>
            Append (Into, new Node_Type '(Kind => N_PARAGRAPH, Len => 0,
                                          Parent => Into.Current));

         when N_LIST_ITEM =>
            Append (Into, new Node_Type '(Kind => N_LIST_ITEM, Len => 0,
                                          Parent => Into.Current));

         when N_LIST_END =>
            Append (Into, new Node_Type '(Kind => N_LIST_END, Len => 0,
                                          Parent => Into.Current));

         when N_NUM_LIST_END =>
            Append (Into, new Node_Type '(Kind => N_NUM_LIST_END, Len => 0,
                                          Parent => Into.Current));

         when N_LIST_ITEM_END =>
            Append (Into, new Node_Type '(Kind => N_LIST_ITEM_END, Len => 0,
                                          Parent => Into.Current));

         when N_NEWLINE =>
            Append (Into, new Node_Type '(Kind => N_NEWLINE, Len => 0,
                                          Parent => Into.Current));

         when N_TOC_DISPLAY =>
            Append (Into, new Node_Type '(Kind => N_TOC_DISPLAY, Len => 0,
                                          Parent => Into.Current));
            Into.Using_TOC := True;

         when N_NONE =>
            null;

      end  case;
   end Append;

   --  ------------------------------
   --  Append the text with the given format at end of the document.
   --  ------------------------------
   procedure Append (Into   : in out Document;
                     Text   : in Wiki.Strings.WString;
                     Format : in Format_Map) is
   begin
      Append (Into, new Node_Type '(Kind => N_TEXT, Len => Text'Length,
                                    Parent => Into.Current,
                                    Text => Text, Format => Format));
   end Append;

   --  ------------------------------
   --  Add a link.
   --  ------------------------------
   procedure Add_Link (Into       : in out Document;
                       Name       : in Wiki.Strings.WString;
                       Attributes : in out Wiki.Attributes.Attribute_List) is
   begin
      Append (Into, new Node_Type '(Kind => N_LINK, Len => Name'Length,
                                    Parent => Into.Current,
                                    Title => Name, Link_Attr => Attributes));
   end Add_Link;

   --  ------------------------------
   --  Add an image.
   --  ------------------------------
   procedure Add_Image (Into       : in out Document;
                        Name       : in Wiki.Strings.WString;
                        Attributes : in out Wiki.Attributes.Attribute_List) is
   begin
      Append (Into, new Node_Type '(Kind => N_IMAGE, Len => Name'Length,
                                    Parent => Into.Current,
                                    Title => Name, Link_Attr => Attributes));
   end Add_Image;

   --  ------------------------------
   --  Add a quote.
   --  ------------------------------
   procedure Add_Quote (Into       : in out Document;
                        Name       : in Wiki.Strings.WString;
                        Attributes : in out Wiki.Attributes.Attribute_List) is
   begin
      Append (Into, new Node_Type '(Kind => N_QUOTE, Len => Name'Length,
                                    Parent => Into.Current,
                                    Title => Name, Link_Attr => Attributes));
   end Add_Quote;

   --  ------------------------------
   --  Add a list (<ul> or <ol>) starting at the given number.
   --  ------------------------------
   procedure Add_List (Into     : in out Document;
                       Level    : in Positive;
                       Ordered  : in Boolean) is
   begin
      if Ordered then
         Append (Into, new Node_Type '(Kind => N_NUM_LIST_START, Len => 0,
                                       Parent => Into.Current,
                                       Level => Level, others => <>));
      else
         Append (Into, new Node_Type '(Kind => N_LIST_START, Len => 0,
                                       Parent => Into.Current,
                                       Level => Level, others => <>));
      end if;
   end Add_List;

   --  ------------------------------
   --  Add a blockquote (<blockquote>).  The level indicates the blockquote nested level.
   --  The blockquote must be closed at the next header.
   --  ------------------------------
   procedure Add_Blockquote (Into     : in out Document;
                             Level    : in Natural) is
   begin
      Append (Into, new Node_Type '(Kind => N_BLOCKQUOTE, Len => 0,
                                    Parent => Into.Current,
                                    Level => Level, others => <>));
   end Add_Blockquote;

   --  ------------------------------
   --  Add a text block that is pre-formatted.
   --  ------------------------------
   procedure Add_Preformatted (Into     : in out Document;
                               Text     : in Wiki.Strings.WString;
                               Format   : in Wiki.Strings.WString) is
   begin
      Append (Into, new Node_Type '(Kind => N_PREFORMAT, Len => Text'Length,
                                    Parent => Into.Current,
                                    Preformatted => Text,
                                    Language => Strings.To_UString (Format)));
   end Add_Preformatted;

   --  ------------------------------
   --  Add a new row to the current table.
   --  ------------------------------
   procedure Add_Row (Into : in out Document) is
      Table : Node_Type_Access;
      Row   : Node_Type_Access;
   begin
      --  Identify the current table.
      Table := Into.Current;
      while Table /= null and then Table.Kind /= N_TABLE loop
         Table := Table.Parent;
      end loop;

      --  Create the current table.
      if Table = null then
         Table := new Node_Type '(Kind       => N_TABLE,
                                  Len        => 0,
                                  Tag_Start  => TABLE_TAG,
                                  Children   => null,
                                  Parent     => Into.Current,
                                  others     => <>);
         Append (Into, Table);
      end if;

      --  Add the row.
      Row := new Node_Type '(Kind       => N_ROW,
                             Len        => 0,
                             Tag_Start  => TR_TAG,
                             Children   => null,
                             Parent     => Table,
                             others     => <>);
      Append (Table, Row);
      Into.Current := Row;
   end Add_Row;

   --  ------------------------------
   --  Add a column to the current table row.  The column is configured with the
   --  given attributes.  The column content is provided through calls to Append.
   --  ------------------------------
   procedure Add_Column (Into : in out Document;
                         Attributes : in out Wiki.Attributes.Attribute_List) is
      Row  : Node_Type_Access;
      Col  : Node_Type_Access;
   begin
      --  Identify the current row.
      Row := Into.Current;
      while Row /= null and then Row.Kind /= N_ROW loop
         Row := Row.Parent;
      end loop;

      --  Add the new column.
      Col := new Node_Type '(Kind       => N_COLUMN,
                             Len        => 0,
                             Tag_Start  => TD_TAG,
                             Children   => null,
                             Parent     => Row,
                             Attributes => Attributes);
      Append (Row, Col);
      Into.Current := Col;
   end Add_Column;

   --  ------------------------------
   --  Finish the creation of the table.
   --  ------------------------------
   procedure Finish_Table (Into : in out Document) is
      Table : Node_Type_Access;
   begin
      --  Identify the current table.
      Table := Into.Current;
      while Table /= null and then Table.Kind /= N_TABLE loop
         Table := Table.Parent;
      end loop;
      if Table /= null then
         Into.Current := Table.Parent;
      else
         Into.Current := null;
      end if;
   end Finish_Table;

   --  ------------------------------
   --  Iterate over the nodes of the list and call the <tt>Process</tt> procedure with
   --  each node instance.
   --  ------------------------------
   procedure Iterate (Doc     : in Document;
                      Process : not null access procedure (Node : in Node_Type)) is
   begin
      Iterate (Doc.Nodes, Process);
   end Iterate;

   --  ------------------------------
   --  Returns True if the document is empty.
   --  ------------------------------
   function Is_Empty (Doc : in Document) return Boolean is
   begin
      return Wiki.Nodes.Lists.Is_Empty (Doc.Nodes);
   end Is_Empty;

   --  ------------------------------
   --  Returns True if the document displays the table of contents by itself.
   --  ------------------------------
   function Is_Using_TOC (Doc : in Document) return Boolean is
   begin
      return Doc.Using_TOC;
   end Is_Using_TOC;

   --  ------------------------------
   --  Returns True if the table of contents is visible and must be rendered.
   --  ------------------------------
   function Is_Visible_TOC (Doc : in Document) return Boolean is
   begin
      return Doc.Visible_TOC;
   end Is_Visible_TOC;

   --  ------------------------------
   --  Hide the table of contents.
   --  ------------------------------
   procedure Hide_TOC (Doc : in out Document) is
   begin
      Doc.Visible_TOC := False;
   end Hide_TOC;

   --  ------------------------------
   --  Get the table of content node associated with the document.
   --  ------------------------------
   procedure Get_TOC (Doc : in out Document;
                      TOC : out Wiki.Nodes.Lists.Node_List_Ref) is
   begin
      if Wiki.Nodes.Lists.Is_Empty (Doc.TOC) then
         Append (Doc.TOC, new Node_Type '(Kind => N_TOC, Len => 0, others => <>));
      end if;
      TOC := Doc.TOC;
   end Get_TOC;

   --  ------------------------------
   --  Get the table of content node associated with the document.
   --  ------------------------------
   function Get_TOC (Doc : in Document) return Wiki.Nodes.Lists.Node_List_Ref is
   begin
      return Doc.TOC;
   end Get_TOC;

end Wiki.Documents;

Change Add_List_Item into Add_List to better represent lists and items in order to identify the start and end of lists and items


-----------------------------------------------------------------------
--  awa-users-model -- User management module
--  Copyright (C) 2009, 2010, 2011 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------

with ASF.Modules.Beans;
with ASF.Beans;

with AWA.Users.Beans;

with Util.Log.Loggers;
package body AWA.Users.Module is

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("AWA.Users.Module");

   package Register is new ASF.Modules.Beans (Module => User_Module,
                                              Module_Access => User_Module_Access);

   --  ------------------------------
   --  Initialize the user module.
   --  ------------------------------
   overriding
   procedure Initialize (Plugin : in out User_Module;
                         App    : access ASF.Applications.Main.Application'Class) is
   begin
      Log.Info ("Initializing the users module");

      AWA.Modules.Module (Plugin).Initialize (App);

	  --  Setup the verify access key filter.
      App.Add_Filter ("verify-access-key", Plugin.Key_Filter'Access);
      App.Add_Filter_Mapping (Pattern => "/users/validate.html",
                              Name    => "verify-access-key");
      Plugin.Key_Filter.Initialize (App.all);

	  Plugin.Manager := Plugin.Create_User_Manager;
      Register.Register (Plugin  => Plugin,
                         Name    => "login",
                         Handler => AWA.Users.Beans.Create_Authenticate_Bean'Access,
                         Scope   => ASF.Beans.REQUEST_SCOPE);

      Register.Register (Plugin  => Plugin,
                         Name    => "register",
                         Handler => AWA.Users.Beans.Create_Authenticate_Bean'Access,
                         Scope   => ASF.Beans.REQUEST_SCOPE);

      Register.Register (Plugin  => Plugin,
                         Name    => "lostPassword",
                         Handler => AWA.Users.Beans.Create_Authenticate_Bean'Access,
                         Scope   => ASF.Beans.REQUEST_SCOPE);
   end Initialize;

   --  ------------------------------
   --  Get the user manager.
   --  ------------------------------
   function Get_User_Manager (Plugin : in User_Module) return Services.User_Service_Access is
   begin
      return Plugin.Manager;
   end Get_User_Manager;

   --  ------------------------------
   --  Create a user manager.  This operation can be overriden to provide another
   --  user service implementation.
   --  ------------------------------
   function Create_User_Manager (Plugin : in User_Module) return Services.User_Service_Access is
      Result : constant Services.User_Service_Access := new Services.User_Service;
   begin
      Result.Initialize (Plugin);
      return Result;
   end Create_User_Manager;

   --  ------------------------------
   --  Get the user module instance associated with the current application.
   --  ------------------------------
   function Get_User_Module return User_Module_Access is
      function Get is new ASF.Modules.Get (User_Module, User_Module_Access, NAME);
   begin
      return Get;
   end Get_User_Module;

   --  ------------------------------
   --  Get the user manager instance associated with the current application.
   --  ------------------------------
   function Get_User_Manager return Services.User_Service_Access is
      Module : constant User_Module_Access := Get_User_Module;
   begin
      if Module = null then
         Log.Error ("There is no active User_Module");
         return null;
      else
         return Module.Get_User_Manager;
      end if;
   end Get_User_Manager;

end AWA.Users.Module;

-----------------------------------------------------------------------
--  awa-users-model -- User management module
--  Copyright (C) 2009, 2010, 2011 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------

with ASF.Modules.Beans;
with ASF.Beans;
with ASF.Modules.Get;

with AWA.Users.Beans;

with Util.Log.Loggers;
package body AWA.Users.Module is

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("AWA.Users.Module");

   package Register is new ASF.Modules.Beans (Module => User_Module,
                                              Module_Access => User_Module_Access);

   --  ------------------------------
   --  Initialize the user module.
   --  ------------------------------
   overriding
   procedure Initialize (Plugin : in out User_Module;
                         App    : access ASF.Applications.Main.Application'Class) is
   begin
      Log.Info ("Initializing the users module");

      AWA.Modules.Module (Plugin).Initialize (App);

      --  Setup the resource bundles.
      App.Register ("userMsg", "users");

	  --  Setup the verify access key filter.
      App.Add_Filter ("verify-access-key", Plugin.Key_Filter'Access);
      App.Add_Filter_Mapping (Pattern => "/users/validate.html",
                              Name    => "verify-access-key");
      App.Add_Filter_Mapping (Pattern => "/users/reset-password.html",
                              Name    => "verify-access-key");
      Plugin.Key_Filter.Initialize (App.all);

	  Plugin.Manager := Plugin.Create_User_Manager;
      Register.Register (Plugin  => Plugin,
                         Name    => "login",
                         Handler => AWA.Users.Beans.Create_Authenticate_Bean'Access,
                         Scope   => ASF.Beans.REQUEST_SCOPE);

      Register.Register (Plugin  => Plugin,
                         Name    => "register",
                         Handler => AWA.Users.Beans.Create_Authenticate_Bean'Access,
                         Scope   => ASF.Beans.REQUEST_SCOPE);

      Register.Register (Plugin  => Plugin,
                         Name    => "resetPassword",
                         Handler => AWA.Users.Beans.Create_Authenticate_Bean'Access,
                         Scope   => ASF.Beans.REQUEST_SCOPE);

      Register.Register (Plugin  => Plugin,
                         Name    => "lostPassword",
                         Handler => AWA.Users.Beans.Create_Authenticate_Bean'Access,
                         Scope   => ASF.Beans.REQUEST_SCOPE);
   end Initialize;

   --  ------------------------------
   --  Get the user manager.
   --  ------------------------------
   function Get_User_Manager (Plugin : in User_Module) return Services.User_Service_Access is
   begin
      return Plugin.Manager;
   end Get_User_Manager;

   --  ------------------------------
   --  Create a user manager.  This operation can be overriden to provide another
   --  user service implementation.
   --  ------------------------------
   function Create_User_Manager (Plugin : in User_Module) return Services.User_Service_Access is
      Result : constant Services.User_Service_Access := new Services.User_Service;
   begin
      Result.Initialize (Plugin);
      return Result;
   end Create_User_Manager;

   --  ------------------------------
   --  Get the user module instance associated with the current application.
   --  ------------------------------
   function Get_User_Module return User_Module_Access is
      function Get is new ASF.Modules.Get (User_Module, User_Module_Access, NAME);
   begin
      return Get;
   end Get_User_Module;

   --  ------------------------------
   --  Get the user manager instance associated with the current application.
   --  ------------------------------
   function Get_User_Manager return Services.User_Service_Access is
      Module : constant User_Module_Access := Get_User_Module;
   begin
      if Module = null then
         Log.Error ("There is no active User_Module");
         return null;
      else
         return Module.Get_User_Manager;
      end if;
   end Get_User_Manager;

end AWA.Users.Module;

Apply the Verify_Filter on the reset-password link Add the resetPassword bean


-----------------------------------------------------------------------
--  awa-workspaces-module -- Module workspaces
--  Copyright (C) 2011, 2012, 2013 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------

with Ada.Calendar;

with AWA.Users.Models;
with AWA.Modules.Beans;
with AWA.Permissions.Services;

with ADO.SQL;
with Util.Log.Loggers;
with AWA.Workspaces.Beans;
package body AWA.Workspaces.Modules is

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("Awa.Workspaces.Module");

   package Register is new AWA.Modules.Beans (Module => Workspace_Module,
                                              Module_Access => Workspace_Module_Access);

   --  ------------------------------
   --  Initialize the workspaces module.
   --  ------------------------------
   overriding
   procedure Initialize (Plugin : in out Workspace_Module;
                         App    : in AWA.Modules.Application_Access;
                         Props  : in ASF.Applications.Config) is
   begin
      Log.Info ("Initializing the workspaces module");

      --  Register here any bean class, servlet, filter.
      Register.Register (Plugin => Plugin,
                         Name   => "AWA.Workspaces.Beans.Workspaces_Bean",
                         Handler => AWA.Workspaces.Beans.Create_Workspaces_Bean'Access);

      AWA.Modules.Module (Plugin).Initialize (App, Props);

      --  Add here the creation of manager instances.
   end Initialize;

   --  ------------------------------
   --  Get the current workspace associated with the current user.
   --  If the user has not workspace, create one.
   --  ------------------------------
   procedure Get_Workspace (Session   : in out ADO.Sessions.Master_Session;
                            Context   : in AWA.Services.Contexts.Service_Context_Access;
                            Workspace : out AWA.Workspaces.Models.Workspace_Ref) is
      User    : constant AWA.Users.Models.User_Ref := Context.Get_User;
      WS      : AWA.Workspaces.Models.Workspace_Ref;
      Query   : ADO.SQL.Query;
      Found   : Boolean;
   begin
      if User.Is_Null then
         Log.Error ("There is no current user.  The workspace cannot be identified");
         Workspace := AWA.Workspaces.Models.Null_Workspace;
         return;
      end if;

      --  Find the workspace associated with the current user.
      Query.Add_Param (User.Get_Id);
      Query.Set_Filter ("o.owner_id = ?");
      WS.Find (Session, Query, Found);
      if Found then
         Workspace := WS;
         return;
      end if;

      --  Create a workspace for this user.
      WS.Set_Owner (User);
      WS.Set_Create_Date (Ada.Calendar.Clock);
      WS.Save (Session);

      --  And give full control of the workspace for this user
      AWA.Permissions.Services.Add_Permission (Session => Session,
                                               User    => User.Get_Id,
                                               Entity  => WS);

      Workspace := WS;
   end Get_Workspace;

end AWA.Workspaces.Modules;

-----------------------------------------------------------------------
--  awa-workspaces-module -- Module workspaces
--  Copyright (C) 2011, 2012, 2013 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------

with Ada.Calendar;

with AWA.Users.Models;
with AWA.Modules.Beans;
with AWA.Permissions.Services;

with ADO.SQL;
with Util.Log.Loggers;
with AWA.Users.Modules;
with AWA.Workspaces.Beans;
package body AWA.Workspaces.Modules is

   package ASC renames AWA.Services.Contexts;

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("Awa.Workspaces.Module");

   package Register is new AWA.Modules.Beans (Module => Workspace_Module,
                                              Module_Access => Workspace_Module_Access);

   --  ------------------------------
   --  Initialize the workspaces module.
   --  ------------------------------
   overriding
   procedure Initialize (Plugin : in out Workspace_Module;
                         App    : in AWA.Modules.Application_Access;
                         Props  : in ASF.Applications.Config) is
   begin
      Log.Info ("Initializing the workspaces module");

      --  Register here any bean class, servlet, filter.
      Register.Register (Plugin => Plugin,
                         Name   => "AWA.Workspaces.Beans.Workspaces_Bean",
                         Handler => AWA.Workspaces.Beans.Create_Workspaces_Bean'Access);

      AWA.Modules.Module (Plugin).Initialize (App, Props);

      Plugin.User_Manager := AWA.Users.Modules.Get_User_Manager;
      --  Add here the creation of manager instances.
   end Initialize;

   --  ------------------------------
   --  Get the current workspace associated with the current user.
   --  If the user has not workspace, create one.
   --  ------------------------------
   procedure Get_Workspace (Session   : in out ADO.Sessions.Master_Session;
                            Context   : in AWA.Services.Contexts.Service_Context_Access;
                            Workspace : out AWA.Workspaces.Models.Workspace_Ref) is
      User    : constant AWA.Users.Models.User_Ref := Context.Get_User;
      WS      : AWA.Workspaces.Models.Workspace_Ref;
      Query   : ADO.SQL.Query;
      Found   : Boolean;
   begin
      if User.Is_Null then
         Log.Error ("There is no current user.  The workspace cannot be identified");
         Workspace := AWA.Workspaces.Models.Null_Workspace;
         return;
      end if;

      --  Find the workspace associated with the current user.
      Query.Add_Param (User.Get_Id);
      Query.Set_Filter ("o.owner_id = ?");
      WS.Find (Session, Query, Found);
      if Found then
         Workspace := WS;
         return;
      end if;

      --  Create a workspace for this user.
      WS.Set_Owner (User);
      WS.Set_Create_Date (Ada.Calendar.Clock);
      WS.Save (Session);

      --  And give full control of the workspace for this user
      AWA.Permissions.Services.Add_Permission (Session => Session,
                                               User    => User.Get_Id,
                                               Entity  => WS);

      Workspace := WS;
   end Get_Workspace;

   --  ------------------------------
   --  Send the invitation to the user.
   --  ------------------------------
   procedure Send_Invitation (Module     : in Workspace_Module;
                              Invitation : in out AWA.Workspaces.Models.Invitation_Ref'Class) is
      Ctx   : constant ASC.Service_Context_Access := AWA.Services.Contexts.Current;
      DB    : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
      User  : constant AWA.Users.Models.User_Ref := Ctx.Get_User;
      WS    : AWA.Workspaces.Models.Workspace_Ref;
      Query : ADO.SQL.Query;
      Found : Boolean;
      Key   : AWA.Users.Models.Access_Key_Ref;
   begin
      Log.Info ("Sending invitation to {0}", String '(Invitation.Get_Email));

      Ctx.Start;
      if User.Is_Null then
         Log.Error ("There is no current user.  The workspace cannot be identified");
         return;
      end if;

      --  Find the workspace associated with the current user.
      Query.Add_Param (User.Get_Id);
      Query.Set_Filter ("o.owner_id = ?");
      WS.Find (DB, Query, Found);
      if not Found then
         return;
      end if;
      Key := AWA.Users.Models.Access_Key_Ref (Invitation.Get_Access_Key);
      --  Key.Set_Key_Value
      Key.Save (DB);
      Invitation.Set_Inviter (User);
      Invitation.Set_Workspace (WS);
      Invitation.Set_Create_Date (Ada.Calendar.Clock);
      Invitation.Save (DB);
      Ctx.Commit;
   end Send_Invitation;

end AWA.Workspaces.Modules;

Implement the Send_Invitation procedure to make an invitation and send it


-----------------------------------------------------------------------
--  awa-blogs-services -- Blogs and post management
--  Copyright (C) 2011, 2012 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with ADO;

with AWA.Modules;
with AWA.Blogs.Models;

with Security.Permissions;

--  The Blogs.Services package defines the service and operations to
--  create, update and delete a post.
package AWA.Blogs.Services is

   NAME : constant String := "Blog_Service";

   --  Define the permissions.
   package ACL_Create_Blog is new Security.Permissions.Permission_ACL ("blog-create");
   package ACL_Delete_Blog is new Security.Permissions.Permission_ACL ("blog-delete");
   package ACL_Create_Post is new Security.Permissions.Permission_ACL ("blog-create-post");
   package ACL_Delete_Post is new Security.Permissions.Permission_ACL ("blog-delete-post");
   package ACL_Update_Post is new Security.Permissions.Permission_ACL ("blog-update-post");

   --  Exception raised when a post cannot be found.
   Not_Found : exception;

   type Blog_Service is new AWA.Modules.Module_Manager with private;
   type Blog_Service_Access is access all Blog_Service'Class;

   --  Create a new blog for the user workspace.
   procedure Create_Blog (Model        : in Blog_Service;
                          Workspace_Id : in ADO.Identifier;
                          Title        : in String;
                          Result       : out ADO.Identifier);

   --  Create a new post associated with the given blog identifier.
   procedure Create_Post (Model   : in Blog_Service;
                          Blog_Id : in ADO.Identifier;
                          Title   : in String;
                          URI     : in String;
                          Text    : in String;
                          Status  : in AWA.Blogs.Models.Post_Status_Type;
                          Result  : out ADO.Identifier);

   --  Update the post title and text associated with the blog post identified by Post.
   procedure Update_Post (Model   : in Blog_Service;
                          Post_Id : in ADO.Identifier;
                          Title   : in String;
                          Text    : in String;
                          Status  : in AWA.Blogs.Models.Post_Status_Type);

   --  Delete the post identified by the given identifier.
   procedure Delete_Post (Model   : in Blog_Service;
                          Post_Id : in ADO.Identifier);

private

   type Blog_Service is new AWA.Modules.Module_Manager with null record;

end AWA.Blogs.Services;

-----------------------------------------------------------------------
--  awa-blogs-services -- Blogs and post management
--  Copyright (C) 2011, 2012 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with ADO;

with AWA.Modules;
with AWA.Blogs.Models;

with Security.Permissions;

--  The Blogs.Services package defines the service and operations to
--  create, update and delete a post.
package AWA.Blogs.Services is

   NAME : constant String := "Blog_Service";

   --  Define the permissions.
   package ACL_Create_Blog is new Security.Permissions.Definition ("blog-create");
   package ACL_Delete_Blog is new Security.Permissions.Definition ("blog-delete");
   package ACL_Create_Post is new Security.Permissions.Definition ("blog-create-post");
   package ACL_Delete_Post is new Security.Permissions.Definition ("blog-delete-post");
   package ACL_Update_Post is new Security.Permissions.Definition ("blog-update-post");

   --  Exception raised when a post cannot be found.
   Not_Found : exception;

   type Blog_Service is new AWA.Modules.Module_Manager with private;
   type Blog_Service_Access is access all Blog_Service'Class;

   --  Create a new blog for the user workspace.
   procedure Create_Blog (Model        : in Blog_Service;
                          Workspace_Id : in ADO.Identifier;
                          Title        : in String;
                          Result       : out ADO.Identifier);

   --  Create a new post associated with the given blog identifier.
   procedure Create_Post (Model   : in Blog_Service;
                          Blog_Id : in ADO.Identifier;
                          Title   : in String;
                          URI     : in String;
                          Text    : in String;
                          Status  : in AWA.Blogs.Models.Post_Status_Type;
                          Result  : out ADO.Identifier);

   --  Update the post title and text associated with the blog post identified by Post.
   procedure Update_Post (Model   : in Blog_Service;
                          Post_Id : in ADO.Identifier;
                          Title   : in String;
                          Text    : in String;
                          Status  : in AWA.Blogs.Models.Post_Status_Type);

   --  Delete the post identified by the given identifier.
   procedure Delete_Post (Model   : in Blog_Service;
                          Post_Id : in ADO.Identifier);

private

   type Blog_Service is new AWA.Modules.Module_Manager with null record;

end AWA.Blogs.Services;

Use the Permissions.Definition generic package