-----------------------------------------------------------------------
--  wiki-parsers-dotclear -- Dotclear parser operations
--  Copyright (C) 2011 - 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.
-----------------------------------------------------------------------
with Wiki.Nodes;
with Wiki.Helpers;
with Wiki.Parsers.Common;
package body Wiki.Parsers.Dotclear is

   use Wiki.Helpers;
   use Wiki.Nodes;
   use Wiki.Strings;
   use Wiki.Buffers;

   --  Parse an image.
   --  Example:
   --    ((url|alt text))
   --    ((url|alt text|position))
   --    ((url|alt text|position||description))
   procedure Parse_Image (Parser  : in out Parser_Type;
                          Text    : in out Wiki.Buffers.Buffer_Access;
                          From    : in out Positive);

   procedure Parse_Preformatted (Parser : in out Parser_Type;
                                 Text   : in out Wiki.Buffers.Buffer_Access;
                                 From   : in out Positive) is
      Count : constant Natural := Count_Occurence (Text, From, '/');
   begin
      if Count /= 3 then
         return;
      end if;

      --  Extract the format either 'Ada' or '[Ada]'
      declare
         Pos    : Natural := Count + 1;
         Buffer : Wiki.Buffers.Buffer_Access := Text;
      begin
         Wiki.Strings.Clear (Parser.Preformat_Format);
         Common.Skip_Spaces (Buffer, Pos);
         if Buffer /= null and then Pos <= Buffer.Last and then Buffer.Content (Pos) = '[' then
            Next (Buffer, Pos);
            Common.Parse_Token (Buffer, Pos, Parser.Escape_Char, ']', ']',
                                Parser.Preformat_Format);
            if Buffer /= null then
               Next (Buffer, Pos);
            end if;
         else
            Common.Parse_Token (Buffer, Pos, Parser.Escape_Char, CR, LF,
                                Parser.Preformat_Format);
         end if;
         if Buffer /= null then
            Common.Skip_Spaces (Buffer, Pos);
         end if;
         Text := Buffer;
         From := Pos;
      end;

      Parser.Preformat_Indent := 0;
      Parser.Preformat_Fence := ' ';
      Parser.Preformat_Fcount := 0;
      Flush_Text (Parser, Trim => Right);
      Pop_Block (Parser);
      Push_Block (Parser, N_PREFORMAT);
   end Parse_Preformatted;

   --  ------------------------------
   --  Parse an image.
   --  Example:
   --    ((url|alt text))
   --    ((url|alt text|position))
   --    ((url|alt text|position||description))
   --  ------------------------------
   procedure Parse_Image (Parser  : in out Parser_Type;
                          Text    : in out Wiki.Buffers.Buffer_Access;
                          From    : in out Positive) is
      procedure Append_Position (Position : in Wiki.Strings.WString);

      procedure Append_Position (Position : in Wiki.Strings.WString) is
      begin
         if Position = "L" or Position = "G" then
            Wiki.Attributes.Append (Parser.Attributes, String '("align"), "left");
         elsif Position = "R" or Position = "D" then
            Wiki.Attributes.Append (Parser.Attributes, String '("align"), "right");
         elsif Position = "C" then
            Wiki.Attributes.Append (Parser.Attributes, String '("align"), "center");
         end if;
      end Append_Position;

      procedure Append_Position is
         new Wiki.Strings.Wide_Wide_Builders.Get (Append_Position);

      Link     : Wiki.Strings.BString (128);
      Alt      : Wiki.Strings.BString (128);
      Position : Wiki.Strings.BString (128);
      Desc     : Wiki.Strings.BString (128);
      Block    : Wiki.Buffers.Buffer_Access := Text;
      Pos      : Positive := From;
   begin
      Next (Block, Pos);
      if Block = null or else Block.Content (Pos) /= '(' then
         Common.Parse_Text (Parser, Text, From);
         return;
      end if;

      Next (Block, Pos);
      if Block = null then
         Common.Parse_Text (Parser, Text, From, Count => 2);
         return;
      end if;

      Common.Parse_Token (Block, Pos, Parser.Escape_Char, '|', ')', Link);
      if Block /= null and then Block.Content (Pos) = '|' then
         Next (Block, Pos);
         if Block /= null then
            Common.Parse_Token (Block, Pos, Parser.Escape_Char, '|', ')', Alt);
         end if;
         if Block /= null and then Block.Content (Pos) = '|' then
            Next (Block, Pos);
            if Block /= null then
               Common.Parse_Token (Block, Pos, Parser.Escape_Char, '|', ')', Position);
            end if;
            if Block /= null and then Block.Content (Pos) = '|' then
               Next (Block, Pos);
               if Block /= null then
                  Common.Parse_Token (Block, Pos, Parser.Escape_Char, '|', ')', Desc);
               end if;
            end if;
         end if;
      end if;

      --  Check for the first ')'.
      if Block /= null and then Block.Content (Pos) = ')' then
         Next (Block, Pos);
      end if;

      --  Check for the second ')', abort the image and emit the '((' if the '))' is missing.
      if Block = null or else Block.Content (Pos) /= ')' then
         Common.Parse_Text (Parser, Text, From, Count => 2);
         return;
      end if;
      Next (Block, Pos);
      Text := Block;
      From := Pos;

      Flush_Text (Parser);
      if not Parser.Context.Is_Hidden then
         Wiki.Attributes.Clear (Parser.Attributes);
         Wiki.Attributes.Append (Parser.Attributes, "src", Link);
         Append_Position (Position);
         Wiki.Attributes.Append (Parser.Attributes, "longdesc", Desc);
         Parser.Context.Filters.Add_Image (Parser.Document,
                                           Strings.To_WString (Alt),
                                           Parser.Attributes);
      end if;
   end Parse_Image;

   procedure Parse_Line (Parser : in out Parser_Type;
                         Text   : in Wiki.Buffers.Buffer_Access) is
      Pos    : Natural := 1;
      C      : Wiki.Strings.WChar;
      Count  : Natural;
      Buffer : Wiki.Buffers.Buffer_Access := Text;
   begin
      if Parser.Current_Node = N_PREFORMAT then
         if Parser.Preformat_Fcount = 0 then
            Count := Count_Occurence (Buffer, 1, '/');
            if Count /= 3 then
               Common.Append (Parser.Text, Buffer, 1);
               return;
            end if;
            Pop_Block (Parser);
            return;
         end if;
         if Buffer.Content (Pos) = ' ' then
            Common.Append (Parser.Text, Buffer, Pos + 1);
            return;
         end if;
         Pop_Block (Parser);
      end if;

      if Parser.Quote_Level > 0 then
         Count := Count_Occurence (Buffer, 1, '>');
         if Count = 0 then
            loop
               Pop_Block (Parser);
               exit when Parser.Current_Node = Nodes.N_NONE;
            end loop;
         else
            Pos := Pos + Count;
         end if;
      end if;

      if Parser.Current_Node = N_HEADER then
         Pop_Block (Parser);
      end if;

      C := Buffer.Content (Pos);
      case C is
         when CR | LF =>
            Common.Parse_Paragraph (Parser, Buffer, Pos);
            return;

         when '!' =>
            Common.Parse_Header (Parser, Buffer, Pos, '!');
            if Buffer = null then
               return;
            end if;

         when '/' =>
            Parse_Preformatted (Parser, Buffer, Pos);
            if Buffer = null then
               return;
            end if;

         when ' ' =>
            Parser.Preformat_Indent := 1;
            Parser.Preformat_Fence := ' ';
            Parser.Preformat_Fcount := 1;
            Flush_Text (Parser, Trim => Right);
            Pop_Block (Parser);
            Push_Block (Parser, N_PREFORMAT);
            Common.Append (Parser.Text, Buffer, Pos + 1);
            return;

         when '>' =>
            Count := Count_Occurence (Buffer, Pos + 1, '>');
            if Parser.Current_Node /= N_BLOCKQUOTE then
               Flush_Text (Parser, Trim => Right);
               Pop_Block (Parser);
               Parser.Quote_Level := Count + 1;
               Push_Block (Parser, N_BLOCKQUOTE);
            end if;
            if not Parser.Context.Is_Hidden then
               Parser.Context.Filters.Add_Blockquote (Parser.Document, Parser.Quote_Level);
            end if;
            Pos := Pos + Count + 1;

         when '-' =>
            Common.Parse_Horizontal_Rule (Parser, Buffer, Pos, '-');
            if Buffer = null then
               return;
            end if;

         when '*' | '#' =>
            Common.Parse_List (Parser, Buffer, Pos);

         when others =>
            if Parser.Current_Node /= N_PARAGRAPH then
               Pop_List (Parser);
               Push_Block (Parser, N_PARAGRAPH);
            end if;

      end case;

      Main :
      while Buffer /= null loop
         declare
            Last : Natural := Buffer.Last;
         begin
            while Pos <= Last loop
               C := Buffer.Content (Pos);
               case C is
                  when '_' =>
                     Parse_Format_Double (Parser, Buffer, Pos, '_', Wiki.BOLD);
                     exit Main when Buffer = null;

                  when ''' =>
                     Parse_Format_Double (Parser, Buffer, Pos, ''', Wiki.ITALIC);
                     exit Main when Buffer = null;

                  when '-' =>
                     Parse_Format_Double (Parser, Buffer, Pos, '-', Wiki.STRIKEOUT);
                     exit Main when Buffer = null;

                  when '+' =>
                     Parse_Format_Double (Parser, Buffer, Pos, '+', Wiki.INS);
                     exit Main when Buffer = null;

                  when ',' =>
                     Parse_Format_Double (Parser, Buffer, Pos, ',', Wiki.SUBSCRIPT);
                     exit Main when Buffer = null;

                  when '@' =>
                     Parse_Format_Double (Parser, Buffer, Pos, '@', Wiki.CODE);
                     exit Main when Buffer = null;

                  when '^' =>
                     Parse_Format (Parser, Buffer, Pos, '^', Wiki.SUPERSCRIPT);
                     exit Main when Buffer = null;

                  when '{' =>
                     Common.Parse_Quote (Parser, Buffer, Pos, '{');
                     exit Main when Buffer = null;

                  when '(' =>
                     Parse_Image (Parser, Buffer, Pos);
                     exit Main when Buffer = null;

                  when '[' =>
                     Common.Parse_Link (Parser, Buffer, Pos);
                     exit Main when Buffer = null;

                  when '<' =>
                     Common.Parse_Template (Parser, Buffer, Pos, '<');
                     exit Main when Buffer = null;

                  when '%' =>
                     Count := Count_Occurence (Buffer, Pos, '%');
                     if Count >= 3 then
                        Parser.Empty_Line := True;
                        Flush_Text (Parser, Trim => Right);
                        if not Parser.Context.Is_Hidden then
                           Parser.Context.Filters.Add_Node (Parser.Document, Nodes.N_LINE_BREAK);
                        end if;

                        --  Skip 3 '%' characters.
                        for I in 1 .. 3 loop
                           Next (Buffer, Pos);
                        end loop;
                        if Buffer /= null and then Helpers.Is_Newline (Buffer.Content (Pos)) then
                           Next (Buffer, Pos);
                        end if;
                        exit Main when Buffer = null;
                     else
                        Append (Parser.Text, C);
                        Pos := Pos + 1;
                     end if;

                  when CR | LF =>
                     --  if Wiki.Strings.Length (Parser.Text) > 0 then
                        Append (Parser.Text, ' ');
                     --  end if;
                     Pos := Pos + 1;

                  when '\' =>
                     Next (Buffer, Pos);
                     if Buffer = null then
                        Append (Parser.Text, C);
                     else
                        Append (Parser.Text, Buffer.Content (Pos));
                        Pos := Pos + 1;
                        Last := Buffer.Last;
                     end if;

                  when others =>
                     Append (Parser.Text, C);
                     Pos := Pos + 1;

               end case;
            end loop;
         end;
         Buffer := Buffer.Next_Block;
         Pos := 1;
      end loop Main;
   end Parse_Line;

end Wiki.Parsers.Dotclear;

-----------------------------------------------------------------------
--  wiki-parsers-dotclear -- Dotclear parser operations
--  Copyright (C) 2011 - 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.
-----------------------------------------------------------------------
with Wiki.Nodes;
with Wiki.Helpers;
with Wiki.Parsers.Common;
package body Wiki.Parsers.Dotclear is

   use Wiki.Helpers;
   use Wiki.Nodes;
   use Wiki.Strings;
   use Wiki.Buffers;

   --  Parse an image.
   --  Example:
   --    ((url|alt text))
   --    ((url|alt text|position))
   --    ((url|alt text|position||description))
   procedure Parse_Image (Parser  : in out Parser_Type;
                          Text    : in out Wiki.Buffers.Buffer_Access;
                          From    : in out Positive);

   procedure Parse_Preformatted (Parser : in out Parser_Type;
                                 Text   : in out Wiki.Buffers.Buffer_Access;
                                 From   : in out Positive) is
      Count : constant Natural := Count_Occurence (Text, From, '/');
   begin
      if Count /= 3 then
         return;
      end if;

      --  Extract the format either 'Ada' or '[Ada]'
      declare
         Pos    : Natural := Count + 1;
         Buffer : Wiki.Buffers.Buffer_Access := Text;
         Space_Count : Natural;
      begin
         Wiki.Strings.Clear (Parser.Preformat_Format);
         Common.Skip_Spaces (Buffer, Pos, Space_Count);
         if Buffer /= null and then Pos <= Buffer.Last and then Buffer.Content (Pos) = '[' then
            Next (Buffer, Pos);
            Common.Parse_Token (Buffer, Pos, Parser.Escape_Char, ']', ']',
                                Parser.Preformat_Format);
            if Buffer /= null then
               Next (Buffer, Pos);
            end if;
         else
            Common.Parse_Token (Buffer, Pos, Parser.Escape_Char, CR, LF,
                                Parser.Preformat_Format);
         end if;
         if Buffer /= null then
            Common.Skip_Spaces (Buffer, Pos, Space_Count);
         end if;
         Text := Buffer;
         From := Pos;
      end;

      Parser.Preformat_Indent := 0;
      Parser.Preformat_Fence := ' ';
      Parser.Preformat_Fcount := 0;
      Flush_Text (Parser, Trim => Right);
      Pop_Block (Parser);
      Push_Block (Parser, N_PREFORMAT);
   end Parse_Preformatted;

   --  ------------------------------
   --  Parse an image.
   --  Example:
   --    ((url|alt text))
   --    ((url|alt text|position))
   --    ((url|alt text|position||description))
   --  ------------------------------
   procedure Parse_Image (Parser  : in out Parser_Type;
                          Text    : in out Wiki.Buffers.Buffer_Access;
                          From    : in out Positive) is
      procedure Append_Position (Position : in Wiki.Strings.WString);

      procedure Append_Position (Position : in Wiki.Strings.WString) is
      begin
         if Position = "L" or Position = "G" then
            Wiki.Attributes.Append (Parser.Attributes, String '("align"), "left");
         elsif Position = "R" or Position = "D" then
            Wiki.Attributes.Append (Parser.Attributes, String '("align"), "right");
         elsif Position = "C" then
            Wiki.Attributes.Append (Parser.Attributes, String '("align"), "center");
         end if;
      end Append_Position;

      procedure Append_Position is
         new Wiki.Strings.Wide_Wide_Builders.Get (Append_Position);

      Link     : Wiki.Strings.BString (128);
      Alt      : Wiki.Strings.BString (128);
      Position : Wiki.Strings.BString (128);
      Desc     : Wiki.Strings.BString (128);
      Block    : Wiki.Buffers.Buffer_Access := Text;
      Pos      : Positive := From;
   begin
      Next (Block, Pos);
      if Block = null or else Block.Content (Pos) /= '(' then
         Common.Parse_Text (Parser, Text, From);
         return;
      end if;

      Next (Block, Pos);
      if Block = null then
         Common.Parse_Text (Parser, Text, From, Count => 2);
         return;
      end if;

      Common.Parse_Token (Block, Pos, Parser.Escape_Char, '|', ')', Link);
      if Block /= null and then Block.Content (Pos) = '|' then
         Next (Block, Pos);
         if Block /= null then
            Common.Parse_Token (Block, Pos, Parser.Escape_Char, '|', ')', Alt);
         end if;
         if Block /= null and then Block.Content (Pos) = '|' then
            Next (Block, Pos);
            if Block /= null then
               Common.Parse_Token (Block, Pos, Parser.Escape_Char, '|', ')', Position);
            end if;
            if Block /= null and then Block.Content (Pos) = '|' then
               Next (Block, Pos);
               if Block /= null then
                  Common.Parse_Token (Block, Pos, Parser.Escape_Char, '|', ')', Desc);
               end if;
            end if;
         end if;
      end if;

      --  Check for the first ')'.
      if Block /= null and then Block.Content (Pos) = ')' then
         Next (Block, Pos);
      end if;

      --  Check for the second ')', abort the image and emit the '((' if the '))' is missing.
      if Block = null or else Block.Content (Pos) /= ')' then
         Common.Parse_Text (Parser, Text, From, Count => 2);
         return;
      end if;
      Next (Block, Pos);
      Text := Block;
      From := Pos;

      Flush_Text (Parser);
      if not Parser.Context.Is_Hidden then
         Wiki.Attributes.Clear (Parser.Attributes);
         Wiki.Attributes.Append (Parser.Attributes, "src", Link);
         Append_Position (Position);
         Wiki.Attributes.Append (Parser.Attributes, "longdesc", Desc);
         Parser.Context.Filters.Add_Image (Parser.Document,
                                           Strings.To_WString (Alt),
                                           Parser.Attributes);
      end if;
   end Parse_Image;

   procedure Parse_Line (Parser : in out Parser_Type;
                         Text   : in Wiki.Buffers.Buffer_Access) is
      Pos    : Natural := 1;
      C      : Wiki.Strings.WChar;
      Count  : Natural;
      Buffer : Wiki.Buffers.Buffer_Access := Text;
   begin
      if Parser.Current_Node = N_PREFORMAT then
         if Parser.Preformat_Fcount = 0 then
            Count := Count_Occurence (Buffer, 1, '/');
            if Count /= 3 then
               Common.Append (Parser.Text, Buffer, 1);
               return;
            end if;
            Pop_Block (Parser);
            return;
         end if;
         if Buffer.Content (Pos) = ' ' then
            Common.Append (Parser.Text, Buffer, Pos + 1);
            return;
         end if;
         Pop_Block (Parser);
      end if;

      if Parser.Quote_Level > 0 then
         Count := Count_Occurence (Buffer, 1, '>');
         if Count = 0 then
            loop
               Pop_Block (Parser);
               exit when Parser.Current_Node = Nodes.N_NONE;
            end loop;
         else
            Pos := Pos + Count;
         end if;
      end if;

      if Parser.Current_Node = N_HEADER then
         Pop_Block (Parser);
      end if;

      C := Buffer.Content (Pos);
      case C is
         when CR | LF =>
            Common.Parse_Paragraph (Parser, Buffer, Pos);
            return;

         when '!' =>
            Common.Parse_Header (Parser, Buffer, Pos, '!');
            if Buffer = null then
               return;
            end if;

         when '/' =>
            Parse_Preformatted (Parser, Buffer, Pos);
            if Buffer = null then
               return;
            end if;

         when ' ' =>
            Parser.Preformat_Indent := 1;
            Parser.Preformat_Fence := ' ';
            Parser.Preformat_Fcount := 1;
            Flush_Text (Parser, Trim => Right);
            Pop_Block (Parser);
            Push_Block (Parser, N_PREFORMAT);
            Common.Append (Parser.Text, Buffer, Pos + 1);
            return;

         when '>' =>
            Count := Count_Occurence (Buffer, Pos + 1, '>');
            if Parser.Current_Node /= N_BLOCKQUOTE then
               Flush_Text (Parser, Trim => Right);
               Pop_Block (Parser);
               Parser.Quote_Level := Count + 1;
               Push_Block (Parser, N_BLOCKQUOTE);
            end if;
            if not Parser.Context.Is_Hidden then
               Parser.Context.Filters.Add_Blockquote (Parser.Document, Parser.Quote_Level);
            end if;
            Pos := Pos + Count + 1;

         when '-' =>
            Common.Parse_Horizontal_Rule (Parser, Buffer, Pos, '-');
            if Buffer = null then
               return;
            end if;

         when '*' | '#' =>
            Common.Parse_List (Parser, Buffer, Pos);

         when others =>
            if Parser.Current_Node /= N_PARAGRAPH then
               Pop_List (Parser);
               Push_Block (Parser, N_PARAGRAPH);
            end if;

      end case;

      Main :
      while Buffer /= null loop
         declare
            Last : Natural := Buffer.Last;
         begin
            while Pos <= Last loop
               C := Buffer.Content (Pos);
               case C is
                  when '_' =>
                     Parse_Format_Double (Parser, Buffer, Pos, '_', Wiki.BOLD);
                     exit Main when Buffer = null;

                  when ''' =>
                     Parse_Format_Double (Parser, Buffer, Pos, ''', Wiki.ITALIC);
                     exit Main when Buffer = null;

                  when '-' =>
                     Parse_Format_Double (Parser, Buffer, Pos, '-', Wiki.STRIKEOUT);
                     exit Main when Buffer = null;

                  when '+' =>
                     Parse_Format_Double (Parser, Buffer, Pos, '+', Wiki.INS);
                     exit Main when Buffer = null;

                  when ',' =>
                     Parse_Format_Double (Parser, Buffer, Pos, ',', Wiki.SUBSCRIPT);
                     exit Main when Buffer = null;

                  when '@' =>
                     Parse_Format_Double (Parser, Buffer, Pos, '@', Wiki.CODE);
                     exit Main when Buffer = null;

                  when '^' =>
                     Parse_Format (Parser, Buffer, Pos, '^', Wiki.SUPERSCRIPT);
                     exit Main when Buffer = null;

                  when '{' =>
                     Common.Parse_Quote (Parser, Buffer, Pos, '{');
                     exit Main when Buffer = null;

                  when '(' =>
                     Parse_Image (Parser, Buffer, Pos);
                     exit Main when Buffer = null;

                  when '[' =>
                     Common.Parse_Link (Parser, Buffer, Pos);
                     exit Main when Buffer = null;

                  when '<' =>
                     Common.Parse_Template (Parser, Buffer, Pos, '<');
                     exit Main when Buffer = null;

                  when '%' =>
                     Count := Count_Occurence (Buffer, Pos, '%');
                     if Count >= 3 then
                        Parser.Empty_Line := True;
                        Flush_Text (Parser, Trim => Right);
                        if not Parser.Context.Is_Hidden then
                           Parser.Context.Filters.Add_Node (Parser.Document, Nodes.N_LINE_BREAK);
                        end if;

                        --  Skip 3 '%' characters.
                        for I in 1 .. 3 loop
                           Next (Buffer, Pos);
                        end loop;
                        if Buffer /= null and then Helpers.Is_Newline (Buffer.Content (Pos)) then
                           Next (Buffer, Pos);
                        end if;
                        exit Main when Buffer = null;
                     else
                        Append (Parser.Text, C);
                        Pos := Pos + 1;
                     end if;

                  when CR | LF =>
                     --  if Wiki.Strings.Length (Parser.Text) > 0 then
                        Append (Parser.Text, ' ');
                     --  end if;
                     Pos := Pos + 1;

                  when '\' =>
                     Next (Buffer, Pos);
                     if Buffer = null then
                        Append (Parser.Text, C);
                     else
                        Append (Parser.Text, Buffer.Content (Pos));
                        Pos := Pos + 1;
                        Last := Buffer.Last;
                     end if;

                  when others =>
                     Append (Parser.Text, C);
                     Pos := Pos + 1;

               end case;
            end loop;
         end;
         Buffer := Buffer.Next_Block;
         Pos := 1;
      end loop Main;
   end Parse_Line;

end Wiki.Parsers.Dotclear;

Update calls to Skip_Spaces

Update calls to Skip_Spaces


--  Copyright (c) 2017 onox <denkpadje@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 System.Multiprocessors.Dispatching_Domains;

with Ada.Command_Line;
with Ada.Exceptions;
with Ada.Real_Time;
with Ada.Text_IO;

with GL.Buffers;
with GL.Debug.Logs;
with GL.Objects.Textures;
with GL.Types;

with Orka.Behaviors;
with Orka.Contexts;
with Orka.Cameras;
with Orka.Loops;
with Orka.Debug;
with Orka.Futures;
with Orka.Rendering.Framebuffers;
with Orka.Rendering.Programs.Modules;
with Orka.Rendering.Programs.Uniforms;
with Orka.Rendering.Vertex_Formats;
with Orka.Resources.Loaders;
with Orka.Resources.Locations.Directories;
with Orka.Resources.Managers;
with Orka.Resources.Textures.KTX;
with Orka.Windows.GLFW;

with Orka_Test.Package_6_glTF;

procedure Orka_Test.Test_8_KTX is
   Width   : constant := 1280;
   Height  : constant := 720;

   Initialized : constant Orka.Windows.GLFW.Active_GLFW'Class
     := Orka.Windows.GLFW.Initialize (Major => 3, Minor => 2, Debug => True);
   pragma Unreferenced (Initialized);

   W : constant Orka.Windows.Window'Class := Orka.Windows.GLFW.Create_Window
     (Width, Height, Resizable => False);
   W_Ptr : constant Orka.Windows.Window_Ptr := Orka.Windows.Window_Ptr'(W'Unchecked_Access);

   Context : Orka.Contexts.Context;

   package Boss   renames Orka_Test.Package_6_glTF.Boss;
   package Loader renames Orka_Test.Package_6_glTF.Loader;

   use Ada.Exceptions;
begin
   if Ada.Command_Line.Argument_Count /= 2 then
      Ada.Text_IO.Put_Line ("Usage: <path to resources folder> <relative path to .ktx file>");
      Boss.Shutdown;
      Loader.Shutdown;
      return;
   end if;

   System.Multiprocessors.Dispatching_Domains.Set_CPU (1);

   Ada.Text_IO.Put_Line ("Flushing" & GL.Types.Size'Image (GL.Debug.Logs.Logged_Messages) & " messages in the debug log:");
   Orka.Debug.Flush_Log;

   Orka.Debug.Enable_Print_Callback;
   Ada.Text_IO.Put_Line ("Set callback for debug messages");

   --  Enable some features
   Context.Enable (Orka.Contexts.Reversed_Z);

   declare
      Location_Path : constant String := Ada.Command_Line.Argument (1);
      Texture_Path  : constant String := Ada.Command_Line.Argument (2);

      package Textures renames Orka.Resources.Textures;
      package Formats renames Orka.Rendering.Vertex_Formats;

      use Orka.Rendering.Programs;
      use Orka.Rendering.Framebuffers;

      use GL.Types;

      P_1 : Program := Create_Program (Modules.Create_Module
        (VS => "../examples/orka/shaders/test-8-module-1.vert",
         FS => "../examples/orka/shaders/test-8-module-1.frag"));

      Uni_Texture : constant Uniforms.Uniform_Sampler := P_1.Uniform_Sampler ("colorTexture");

      Screen_Size : constant Uniforms.TS.Vector4
        := (Single (Width), Single (Height), 0.0, 0.0);

      Uni_Screen : constant Uniforms.Uniform := P_1.Uniform ("screenSize");

      --  Create an empty vertex format. Vertex shader contains the data needed
      --  to generate a quad
      VF_1 : constant Formats.Vertex_Format
        := Formats.Create_Vertex_Format (GL.Types.Triangles, GL.Types.UInt_Type);

      FB_D : constant Framebuffer_Ptr
        := new Framebuffer'(Create_Default_Framebuffer (Width, Height));

      --  The camera provides a view and projection matrices, but are unused
      --  in the shaders. The object is created because package Loops needs it
      use Orka.Cameras;
      Lens : constant Lens_Ptr
        := new Camera_Lens'Class'(Create_Lens (Width, Height, 45.0, Context));
      Current_Camera : constant Camera_Ptr
        := new Camera'Class'(Create_Camera (Rotate_Around, W.Pointer_Input, Lens, FB_D));

      task Load_Resource;

      use Orka.Resources;
      use Ada.Real_Time;

      Manager : constant Managers.Manager_Ptr := Managers.Create_Manager;

      task body Load_Resource is
         Loader_KTX : constant Loaders.Loader_Ptr := Textures.KTX.Create_Loader (Manager);

         Location_Textures : constant Locations.Location_Ptr
           := Locations.Directories.Create_Location (Location_Path);
      begin
         Loader.Add_Location (Location_Textures, Loader_KTX);
         Ada.Text_IO.Put_Line ("Registered resource locations");

         declare
            T1 : constant Time := Clock;
            T2 : Time;

            Future_Ref : Orka.Futures.Pointers.Reference := Loader.Load (Texture_Path);

            use type Orka.Futures.Status;
            Resource_Status : Orka.Futures.Status;
         begin
            Future_Ref.Wait_Until_Done (Resource_Status);
            T2 := Clock;

            pragma Assert (Resource_Status = Orka.Futures.Done);
            pragma Assert (Manager.Contains (Texture_Path));

            declare
               Loading_Time : constant Duration := 1e3 * To_Duration (T2 - T1);
            begin
               Ada.Text_IO.Put_Line ("Loaded in " & Loading_Time'Image & " ms");
            end;

            --  Here we should either create a GPU job to set the
            --  texture to the uniform or just simply set it in the
            --  render callback below
         end;
      exception
         when Error : others =>
            Ada.Text_IO.Put_Line ("Error loading resource: " & Exception_Information (Error));
      end Load_Resource;
   begin
      Uni_Screen.Set_Vector (Screen_Size);

      declare
         use GL.Objects.Textures;
         Loaded : Boolean := False;

         procedure Render
           (Scene  : not null Orka.Behaviors.Behavior_Array_Access;
            Camera : Orka.Cameras.Camera_Ptr) is
         begin
            GL.Buffers.Clear (GL.Buffers.Buffer_Bits'
              (Color => True, Depth => True, others => False));

            Camera.FB.Use_Framebuffer;
            P_1.Use_Program;

            if not Loaded and then Manager.Contains (Texture_Path) then
               declare
                  T_1 : constant Textures.Texture_Ptr
                    := Textures.Texture_Ptr (Manager.Resource (Texture_Path));

                  T_2 : constant GL.Objects.Textures.Texture_Base'Class := T_1.Element;
                  --  TODO Handle non-Texture_2D textures
               begin
                  T_2.Set_X_Wrapping (Clamp_To_Edge);
                  T_2.Set_X_Wrapping (Clamp_To_Edge);

                  T_2.Set_Minifying_Filter (Nearest);
                  T_2.Set_Magnifying_Filter (Nearest);

                  Uni_Texture.Set_Texture (T_2, 0);
               end;
               Ada.Text_IO.Put_Line ("Set texture");
               Loaded := True;
            end if;

            VF_1.Draw (0, 6);
         end Render;

         package Loops is new Orka.Loops
           (Time_Step   => Ada.Real_Time.Microseconds (2_083),
            Frame_Limit => Ada.Real_Time.Microseconds (2_083),
            Window      => W_Ptr,
            Camera      => Current_Camera,
            Render      => Render'Unrestricted_Access,
            Job_Manager => Boss);
      begin
         Loops.Scene.Add (Orka.Behaviors.Null_Behavior);
         Ada.Text_IO.Put_Line ("Running render loop...");
         Loops.Run_Loop;
      end;
      Ada.Text_IO.Put_Line ("Shutting down...");
      Boss.Shutdown;
      Loader.Shutdown;
      Ada.Text_IO.Put_Line ("Shutdown job system and loader");
   end;
exception
   when Error : others =>
      Ada.Text_IO.Put_Line ("Error: " & Exception_Information (Error));
end Orka_Test.Test_8_KTX;

--  Copyright (c) 2017 onox <denkpadje@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 System.Multiprocessors.Dispatching_Domains;

with Ada.Command_Line;
with Ada.Exceptions;
with Ada.Real_Time;
with Ada.Text_IO;

with GL.Buffers;
with GL.Debug.Logs;
with GL.Objects.Textures;
with GL.Types;

with Orka.Behaviors;
with Orka.Contexts;
with Orka.Cameras;
with Orka.Loops;
with Orka.Debug;
with Orka.Futures;
with Orka.Rendering.Framebuffers;
with Orka.Rendering.Programs.Modules;
with Orka.Rendering.Programs.Uniforms;
with Orka.Rendering.Vertex_Formats;
with Orka.Resources.Loaders;
with Orka.Resources.Locations.Directories;
with Orka.Resources.Managers;
with Orka.Resources.Textures.KTX;
with Orka.Windows.GLFW;

with Orka_Test.Package_6_glTF;

procedure Orka_Test.Test_8_KTX is
   Width   : constant := 1280;
   Height  : constant := 720;

   Initialized : constant Orka.Windows.GLFW.Active_GLFW'Class
     := Orka.Windows.GLFW.Initialize (Major => 3, Minor => 2, Debug => True);
   pragma Unreferenced (Initialized);

   W : constant Orka.Windows.Window'Class := Orka.Windows.GLFW.Create_Window
     (Width, Height, Resizable => False);
   W_Ptr : constant Orka.Windows.Window_Ptr := Orka.Windows.Window_Ptr'(W'Unchecked_Access);

   Context : Orka.Contexts.Context;

   package Boss   renames Orka_Test.Package_6_glTF.Boss;
   package Loader renames Orka_Test.Package_6_glTF.Loader;

   use Ada.Exceptions;
begin
   if Ada.Command_Line.Argument_Count /= 2 then
      Ada.Text_IO.Put_Line ("Usage: <path to resources folder> <relative path to .ktx file>");
      Boss.Shutdown;
      Loader.Shutdown;
      return;
   end if;

   System.Multiprocessors.Dispatching_Domains.Set_CPU (1);

   Ada.Text_IO.Put_Line ("Flushing" & GL.Types.Size'Image (GL.Debug.Logs.Logged_Messages) & " messages in the debug log:");
   Orka.Debug.Flush_Log;

   Orka.Debug.Enable_Print_Callback;
   Ada.Text_IO.Put_Line ("Set callback for debug messages");

   --  Enable some features
   Context.Enable (Orka.Contexts.Reversed_Z);

   declare
      Location_Path : constant String := Ada.Command_Line.Argument (1);
      Texture_Path  : constant String := Ada.Command_Line.Argument (2);

      package Textures renames Orka.Resources.Textures;
      package Formats renames Orka.Rendering.Vertex_Formats;

      use Orka.Rendering.Programs;
      use Orka.Rendering.Framebuffers;

      use GL.Types;

      P_1 : Program := Create_Program (Modules.Create_Module
        (VS => "../examples/orka/shaders/test-8-module-1.vert",
         FS => "../examples/orka/shaders/test-8-module-1.frag"));

      Uni_Texture : constant Uniforms.Uniform_Sampler := P_1.Uniform_Sampler ("colorTexture");

      Screen_Size : constant Uniforms.TS.Vector4
        := (Single (Width), Single (Height), 0.0, 0.0);

      Uni_Screen : constant Uniforms.Uniform := P_1.Uniform ("screenSize");

      --  Create an empty vertex format. Vertex shader contains the data needed
      --  to generate a quad
      VF_1 : constant Formats.Vertex_Format
        := Formats.Create_Vertex_Format (GL.Types.Triangles, GL.Types.UInt_Type);

      FB_D : constant Framebuffer_Ptr
        := new Framebuffer'(Create_Default_Framebuffer (Width, Height));

      --  The camera provides a view and projection matrices, but are unused
      --  in the shaders. The object is created because package Loops needs it
      use Orka.Cameras;
      Lens : constant Lens_Ptr
        := new Camera_Lens'Class'(Create_Lens (Width, Height, 45.0, Context));
      Current_Camera : constant Camera_Ptr
        := new Camera'Class'(Create_Camera (Rotate_Around, W.Pointer_Input, Lens, FB_D));

      task Load_Resource;

      use Orka.Resources;
      use Ada.Real_Time;

      Manager : constant Managers.Manager_Ptr := Managers.Create_Manager;

      task body Load_Resource is
         Loader_KTX : constant Loaders.Loader_Ptr := Textures.KTX.Create_Loader (Manager);

         Location_Textures : constant Locations.Location_Ptr
           := Locations.Directories.Create_Location (Location_Path);
      begin
         Loader.Add_Location (Location_Textures, Loader_KTX);
         Ada.Text_IO.Put_Line ("Registered resource locations");

         declare
            T1 : constant Time := Clock;
            T2 : Time;

            Future_Ref : Orka.Futures.Pointers.Reference := Loader.Load (Texture_Path);

            use type Orka.Futures.Status;
            Resource_Status : Orka.Futures.Status;
         begin
            Future_Ref.Wait_Until_Done (Resource_Status);
            T2 := Clock;

            pragma Assert (Resource_Status = Orka.Futures.Done);
            pragma Assert (Manager.Contains (Texture_Path));

            declare
               Loading_Time : constant Duration := 1e3 * To_Duration (T2 - T1);
            begin
               Ada.Text_IO.Put_Line ("Loaded in " & Loading_Time'Image & " ms");
            end;

            --  Here we should either create a GPU job to set the
            --  texture to the uniform or just simply set it in the
            --  render callback below
         end;
      exception
         when Error : others =>
            Ada.Text_IO.Put_Line ("Error loading resource: " & Exception_Information (Error));
      end Load_Resource;
   begin
      Uni_Screen.Set_Vector (Screen_Size);

      declare
         use GL.Objects.Textures;
         Loaded : Boolean := False;

         procedure Render
           (Scene  : not null Orka.Behaviors.Behavior_Array_Access;
            Camera : Orka.Cameras.Camera_Ptr) is
         begin
            GL.Buffers.Clear (GL.Buffers.Buffer_Bits'
              (Color => True, Depth => True, others => False));

            Camera.FB.Use_Framebuffer;
            P_1.Use_Program;

            if not Loaded and then Manager.Contains (Texture_Path) then
               declare
                  T_1 : constant Textures.Texture_Ptr
                    := Textures.Texture_Ptr (Manager.Resource (Texture_Path));

                  T_2 : constant GL.Objects.Textures.Texture_Base'Class := T_1.Element;
                  --  TODO Handle non-Texture_2D textures
               begin
                  T_2.Set_X_Wrapping (Clamp_To_Edge);
                  T_2.Set_X_Wrapping (Clamp_To_Edge);

                  T_2.Set_Minifying_Filter (Nearest);
                  T_2.Set_Magnifying_Filter (Nearest);

                  Uni_Texture.Set_Texture (T_2, 0);
               end;
               Ada.Text_IO.Put_Line ("Set texture");
               Loaded := True;
            end if;

            VF_1.Draw (0, 6);
         end Render;

         package Loops is new Orka.Loops
           (Time_Step   => Ada.Real_Time.Microseconds (2_083),
            Frame_Limit => Ada.Real_Time.Microseconds (16_667),
            Window      => W_Ptr,
            Camera      => Current_Camera,
            Render      => Render'Unrestricted_Access,
            Job_Manager => Boss);
      begin
         Loops.Scene.Add (Orka.Behaviors.Null_Behavior);
         Ada.Text_IO.Put_Line ("Running render loop...");
         Loops.Run_Loop;
      end;
      Ada.Text_IO.Put_Line ("Shutting down...");
      Boss.Shutdown;
      Loader.Shutdown;
      Ada.Text_IO.Put_Line ("Shutdown job system and loader");
   end;
exception
   when Error : others =>
      Ada.Text_IO.Put_Line ("Error: " & Exception_Information (Error));
end Orka_Test.Test_8_KTX;

examples: Set frame limit to 60 FPS in KTX example

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


-----------------------------------------------------------------------
--  nodes-core -- Core nodes
--  Copyright (C) 2009, 2010 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 Util.Strings.Transforms;
package body ASF.Views.Nodes.Core is

   --  ------------------------------
   --  Set Tag
   --  ------------------------------

   --  ------------------------------
   --  Create the Set Tag
   --  ------------------------------
   function Create_Set_Tag_Node (Name       : Unbounded_String;
                                 Line       : Line_Info;
                                 Parent     : Tag_Node_Access;
                                 Attributes : Tag_Attribute_Array_Access)
                                 return Tag_Node_Access is
      Node : constant Set_Tag_Node_Access := new Set_Tag_Node;
   begin
      Initialize (Node.all'Access, Name, Line, Parent, Attributes);
      Node.Value      := Find_Attribute (Attributes, "value");
      Node.Var        := Find_Attribute (Attributes, "var");
      if Node.Value = null then
         Node.Error ("Missing 'value' attribute");
      end if;
      if Node.Var = null then
         Node.Error ("Missing 'var' attribute");
      end if;
      return Node.all'Access;
   end Create_Set_Tag_Node;

   --  ------------------------------
   --  Build the component tree from the tag node and attach it as
   --  the last child of the given parent.  Calls recursively the
   --  method to create children.
   --  ------------------------------
   overriding
   procedure Build_Components (Node    : access Set_Tag_Node;
                               Parent  : in UIComponent_Access;
                               Context : in out Facelet_Context'Class) is
      pragma Unreferenced (Parent);

      Value  : constant EL.Expressions.Expression
        := Get_Expression (Node.Value.all);
   begin
      Context.Set_Variable (Node.Var.Value, Value);
   end Build_Components;

   --  ------------------------------
   --  If Tag
   --  ------------------------------

   --  ------------------------------
   --  Create the If Tag
   --  ------------------------------
   function Create_If_Tag_Node (Name       : Unbounded_String;
                                Line       : Line_Info;
                                Parent     : Tag_Node_Access;
                                Attributes : Tag_Attribute_Array_Access)
                                return Tag_Node_Access is
      Node : constant If_Tag_Node_Access := new If_Tag_Node;
   begin
      Initialize (Node.all'Access, Name, Line, Parent, Attributes);
      Node.Condition  := Find_Attribute (Attributes, "test");
      Node.Var        := Find_Attribute (Attributes, "var");
      if Node.Condition = null then
         Node.Error ("Missing 'test' attribute");
      end if;
      return Node.all'Access;
   end Create_If_Tag_Node;

   --  ------------------------------
   --  Build the component tree from the tag node and attach it as
   --  the last child of the given parent.  Calls recursively the
   --  method to create children.
   --  ------------------------------
   overriding
   procedure Build_Components (Node    : access If_Tag_Node;
                               Parent  : in UIComponent_Access;
                               Context : in out Facelet_Context'Class) is
      Value : constant EL.Objects.Object := Get_Value (Node.Condition.all, Context);
   begin
      if Node.Var /= null then
         Context.Set_Attribute (Node.Var.Value, Value);
      end if;
      if EL.Objects.To_Boolean (Value) then
         Tag_Node (Node.all).Build_Children (Parent, Context);
      end if;
   end Build_Components;

   --  ------------------------------
   --  Choose Tag
   --  ------------------------------

   --  ------------------------------
   --  Create the Choose Tag
   --  ------------------------------
   function Create_Choose_Tag_Node (Name       : Unbounded_String;
                                    Line       : Line_Info;
                                    Parent     : Tag_Node_Access;
                                    Attributes : Tag_Attribute_Array_Access)
                                    return Tag_Node_Access is
      Node : constant Choose_Tag_Node_Access := new Choose_Tag_Node;
   begin
      Initialize (Node.all'Access, Name, Line, Parent, Attributes);
      return Node.all'Access;
   end Create_Choose_Tag_Node;

   --  ------------------------------
   --  Freeze the tag node tree and perform any initialization steps
   --  necessary to build the components efficiently.
   --  Prepare the evaluation of choices by identifying the <c:when> and
   --  <c:otherwise> conditions.
   --  ------------------------------
   overriding
   procedure Freeze (Node : access Choose_Tag_Node) is
      Child  : Tag_Node_Access := Node.First_Child;
      Choice : When_Tag_Node_Access := null;
   begin
      while Child /= null loop
         if Child.all in Otherwise_Tag_Node'Class then
            Node.Otherwise := Child;

         elsif Child.all in When_Tag_Node'Class then
            if Choice = null then
               Node.Choices := When_Tag_Node (Child.all)'Access;
            else
               Choice.Next_Choice := When_Tag_Node (Child.all)'Access;
            end if;
            Choice := When_Tag_Node (Child.all)'Access;

         else
            null;
            --  @todo: report a warning in a log
            --  @todo: clean the sub-tree and remove what is not necessary
         end if;
         Child := Child.Next;
      end loop;
   end Freeze;

   --  ------------------------------
   --  Build the component tree from the tag node and attach it as
   --  the last child of the given parent.  Calls recursively the
   --  method to create children.
   --  ------------------------------
   overriding
   procedure Build_Components (Node    : access Choose_Tag_Node;
                               Parent  : in UIComponent_Access;
                               Context : in out Facelet_Context'Class) is
      Choice : When_Tag_Node_Access := Node.Choices;
   begin
      --  Evaluate the choices and stop at the first which succeeds
      while Choice /= null loop
         if Choice.Is_Selected (Context) then
            Choice.Build_Children (Parent, Context);
            return;
         end if;
         Choice := Choice.Next_Choice;
      end loop;

      --  No choice matched, build the otherwise clause.
      if Node.Otherwise /= null then
         Node.Otherwise.Build_Children (Parent, Context);
      end if;
   end Build_Components;

   --  ------------------------------
   --  Create the When Tag
   --  ------------------------------
   function Create_When_Tag_Node (Name       : Unbounded_String;
                                  Line       : Line_Info;
                                  Parent     : Tag_Node_Access;
                                  Attributes : Tag_Attribute_Array_Access)
                                  return Tag_Node_Access is
      Node : constant When_Tag_Node_Access := new When_Tag_Node;
   begin
      Initialize (Node.all'Access, Name, Line, Parent, Attributes);
      Node.Condition  := Find_Attribute (Attributes, "test");
      if Node.Condition = null then
         Node.Error ("Missing 'test' attribute");
      end if;
      --        Node.Var        := Find_Attribute (Attributes, "var");
      return Node.all'Access;
   end Create_When_Tag_Node;

   --  ------------------------------
   --  Check whether the node condition is selected.
   --  ------------------------------
   function Is_Selected (Node    : When_Tag_Node;
                         Context : Facelet_Context'Class) return Boolean is
   begin
      return EL.Objects.To_Boolean (Get_Value (Node.Condition.all, Context));
   end Is_Selected;

   --  ------------------------------
   --  Create the Otherwise Tag
   --  ------------------------------
   function Create_Otherwise_Tag_Node (Name       : Unbounded_String;
                                       Line       : Line_Info;
                                       Parent     : Tag_Node_Access;
                                       Attributes : Tag_Attribute_Array_Access)
                                       return Tag_Node_Access is
      Node : constant Otherwise_Tag_Node_Access := new Otherwise_Tag_Node;
   begin
      Initialize (Node.all'Access, Name, Line, Parent, Attributes);
      return Node.all'Access;
   end Create_Otherwise_Tag_Node;

   --  Tag names
   CHOOSE_TAG    : aliased constant String := "choose";
   IF_TAG        : aliased constant String := "if";
   OTHERWISE_TAG : aliased constant String := "otherwise";
   SET_TAG       : aliased constant String := "set";
   WHEN_TAG      : aliased constant String := "when";

   --  Name-space URI.  Use the JSTL name-space to make the XHTML views compatible
   --  the JSF.
   URI           : aliased constant String := "http://java.sun.com/jstl/core";

   --  Tag library definition.  Names must be sorted.
   Tag_Bindings  : aliased constant ASF.Factory.Binding_Array
     := ((Name => CHOOSE_TAG'Access,
          Component => null,
          Tag => Create_Choose_Tag_Node'Access),
       (Name => IF_TAG'Access,
        Component => null,
        Tag => Create_If_Tag_Node'Access),
       (Name => OTHERWISE_TAG'Access,
        Component => null,
        Tag => Create_Otherwise_Tag_Node'Access),
       (Name => SET_TAG'Access,
        Component => null,
        Tag => Create_Set_Tag_Node'Access),
       (Name => WHEN_TAG'Access,
        Component => null,
        Tag => Create_When_Tag_Node'Access));

   Tag_Factory   : aliased constant ASF.Factory.Factory_Bindings
     := (URI => URI'Access, Bindings => Tag_Bindings'Access);

   --  ------------------------------
   --  Tag factory for nodes defined in this package.
   --  ------------------------------
   function Definition return ASF.Factory.Factory_Bindings_Access is
   begin
      return Tag_Factory'Access;
   end Definition;

   --  Function names
   CAPITALIZE_FN    : aliased constant String := "capitalize";
   TO_UPPER_CASE_FN : aliased constant String := "toUpperCase";
   TO_LOWER_CASE_FN : aliased constant String := "toLowerCase";

   function Capitalize (Value : EL.Objects.Object) return EL.Objects.Object;
   function To_Upper_Case (Value : EL.Objects.Object) return EL.Objects.Object;
   function To_Lower_Case (Value : EL.Objects.Object) return EL.Objects.Object;

   function Capitalize (Value : EL.Objects.Object) return EL.Objects.Object is
      S : constant String := EL.Objects.To_String (Value);
   begin
      return EL.Objects.To_Object (Util.Strings.Transforms.Capitalize (S));
   end Capitalize;

   function To_Upper_Case (Value : EL.Objects.Object) return EL.Objects.Object is
      S : constant String := EL.Objects.To_String (Value);
   begin
      return EL.Objects.To_Object (Util.Strings.Transforms.To_Upper_Case (S));
   end To_Upper_Case;

   function To_Lower_Case (Value : EL.Objects.Object) return EL.Objects.Object is
      S : constant String := EL.Objects.To_String (Value);
   begin
      return EL.Objects.To_Object (Util.Strings.Transforms.To_Lower_Case (S));
   end To_Lower_Case;

   --  ------------------------------
   --  Register a set of functions in the namespace
   --  xmlns:fn="http://java.sun.com/jsp/jstl/functions"
   --  Functions:
   --    capitalize, toUpperCase, toLowerCase
   --  ------------------------------
   procedure Set_Functions (Mapper : in out EL.Functions.Function_Mapper'Class) is
      URI : constant String := "http://java.sun.com/jsp/jstl/functions";
   begin
      Mapper.Set_Function (Name      => CAPITALIZE_FN,
                           Namespace => URI,
                           Func      => Capitalize'Access);
      Mapper.Set_Function (Name      => TO_LOWER_CASE_FN,
                           Namespace => URI,
                           Func      => To_Lower_Case'Access);
      Mapper.Set_Function (Name      => TO_UPPER_CASE_FN,
                           Namespace => URI,
                           Func      => To_Upper_Case'Access);
   end Set_Functions;

end ASF.Views.Nodes.Core;

-----------------------------------------------------------------------
--  nodes-core -- Core nodes
--  Copyright (C) 2009, 2010 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 Util.Strings.Transforms;
with Ada.Strings.Fixed;
package body ASF.Views.Nodes.Core is

   --  ------------------------------
   --  Set Tag
   --  ------------------------------

   --  ------------------------------
   --  Create the Set Tag
   --  ------------------------------
   function Create_Set_Tag_Node (Name       : Unbounded_String;
                                 Line       : Line_Info;
                                 Parent     : Tag_Node_Access;
                                 Attributes : Tag_Attribute_Array_Access)
                                 return Tag_Node_Access is
      Node : constant Set_Tag_Node_Access := new Set_Tag_Node;
   begin
      Initialize (Node.all'Access, Name, Line, Parent, Attributes);
      Node.Value      := Find_Attribute (Attributes, "value");
      Node.Var        := Find_Attribute (Attributes, "var");
      if Node.Value = null then
         Node.Error ("Missing 'value' attribute");
      end if;
      if Node.Var = null then
         Node.Error ("Missing 'var' attribute");
      end if;
      return Node.all'Access;
   end Create_Set_Tag_Node;

   --  ------------------------------
   --  Build the component tree from the tag node and attach it as
   --  the last child of the given parent.  Calls recursively the
   --  method to create children.
   --  ------------------------------
   overriding
   procedure Build_Components (Node    : access Set_Tag_Node;
                               Parent  : in UIComponent_Access;
                               Context : in out Facelet_Context'Class) is
      pragma Unreferenced (Parent);

      Value  : constant EL.Expressions.Expression
        := Get_Expression (Node.Value.all);
   begin
      Context.Set_Variable (Node.Var.Value, Value);
   end Build_Components;

   --  ------------------------------
   --  If Tag
   --  ------------------------------

   --  ------------------------------
   --  Create the If Tag
   --  ------------------------------
   function Create_If_Tag_Node (Name       : Unbounded_String;
                                Line       : Line_Info;
                                Parent     : Tag_Node_Access;
                                Attributes : Tag_Attribute_Array_Access)
                                return Tag_Node_Access is
      Node : constant If_Tag_Node_Access := new If_Tag_Node;
   begin
      Initialize (Node.all'Access, Name, Line, Parent, Attributes);
      Node.Condition  := Find_Attribute (Attributes, "test");
      Node.Var        := Find_Attribute (Attributes, "var");
      if Node.Condition = null then
         Node.Error ("Missing 'test' attribute");
      end if;
      return Node.all'Access;
   end Create_If_Tag_Node;

   --  ------------------------------
   --  Build the component tree from the tag node and attach it as
   --  the last child of the given parent.  Calls recursively the
   --  method to create children.
   --  ------------------------------
   overriding
   procedure Build_Components (Node    : access If_Tag_Node;
                               Parent  : in UIComponent_Access;
                               Context : in out Facelet_Context'Class) is
      Value : constant EL.Objects.Object := Get_Value (Node.Condition.all, Context);
   begin
      if Node.Var /= null then
         Context.Set_Attribute (Node.Var.Value, Value);
      end if;
      if EL.Objects.To_Boolean (Value) then
         Tag_Node (Node.all).Build_Children (Parent, Context);
      end if;
   end Build_Components;

   --  ------------------------------
   --  Choose Tag
   --  ------------------------------

   --  ------------------------------
   --  Create the Choose Tag
   --  ------------------------------
   function Create_Choose_Tag_Node (Name       : Unbounded_String;
                                    Line       : Line_Info;
                                    Parent     : Tag_Node_Access;
                                    Attributes : Tag_Attribute_Array_Access)
                                    return Tag_Node_Access is
      Node : constant Choose_Tag_Node_Access := new Choose_Tag_Node;
   begin
      Initialize (Node.all'Access, Name, Line, Parent, Attributes);
      return Node.all'Access;
   end Create_Choose_Tag_Node;

   --  ------------------------------
   --  Freeze the tag node tree and perform any initialization steps
   --  necessary to build the components efficiently.
   --  Prepare the evaluation of choices by identifying the <c:when> and
   --  <c:otherwise> conditions.
   --  ------------------------------
   overriding
   procedure Freeze (Node : access Choose_Tag_Node) is
      Child  : Tag_Node_Access := Node.First_Child;
      Choice : When_Tag_Node_Access := null;
   begin
      while Child /= null loop
         if Child.all in Otherwise_Tag_Node'Class then
            Node.Otherwise := Child;

         elsif Child.all in When_Tag_Node'Class then
            if Choice = null then
               Node.Choices := When_Tag_Node (Child.all)'Access;
            else
               Choice.Next_Choice := When_Tag_Node (Child.all)'Access;
            end if;
            Choice := When_Tag_Node (Child.all)'Access;

         else
            null;
            --  @todo: report a warning in a log
            --  @todo: clean the sub-tree and remove what is not necessary
         end if;
         Child := Child.Next;
      end loop;
   end Freeze;

   --  ------------------------------
   --  Build the component tree from the tag node and attach it as
   --  the last child of the given parent.  Calls recursively the
   --  method to create children.
   --  ------------------------------
   overriding
   procedure Build_Components (Node    : access Choose_Tag_Node;
                               Parent  : in UIComponent_Access;
                               Context : in out Facelet_Context'Class) is
      Choice : When_Tag_Node_Access := Node.Choices;
   begin
      --  Evaluate the choices and stop at the first which succeeds
      while Choice /= null loop
         if Choice.Is_Selected (Context) then
            Choice.Build_Children (Parent, Context);
            return;
         end if;
         Choice := Choice.Next_Choice;
      end loop;

      --  No choice matched, build the otherwise clause.
      if Node.Otherwise /= null then
         Node.Otherwise.Build_Children (Parent, Context);
      end if;
   end Build_Components;

   --  ------------------------------
   --  Create the When Tag
   --  ------------------------------
   function Create_When_Tag_Node (Name       : Unbounded_String;
                                  Line       : Line_Info;
                                  Parent     : Tag_Node_Access;
                                  Attributes : Tag_Attribute_Array_Access)
                                  return Tag_Node_Access is
      Node : constant When_Tag_Node_Access := new When_Tag_Node;
   begin
      Initialize (Node.all'Access, Name, Line, Parent, Attributes);
      Node.Condition  := Find_Attribute (Attributes, "test");
      if Node.Condition = null then
         Node.Error ("Missing 'test' attribute");
      end if;
      --        Node.Var        := Find_Attribute (Attributes, "var");
      return Node.all'Access;
   end Create_When_Tag_Node;

   --  ------------------------------
   --  Check whether the node condition is selected.
   --  ------------------------------
   function Is_Selected (Node    : When_Tag_Node;
                         Context : Facelet_Context'Class) return Boolean is
   begin
      return EL.Objects.To_Boolean (Get_Value (Node.Condition.all, Context));
   end Is_Selected;

   --  ------------------------------
   --  Create the Otherwise Tag
   --  ------------------------------
   function Create_Otherwise_Tag_Node (Name       : Unbounded_String;
                                       Line       : Line_Info;
                                       Parent     : Tag_Node_Access;
                                       Attributes : Tag_Attribute_Array_Access)
                                       return Tag_Node_Access is
      Node : constant Otherwise_Tag_Node_Access := new Otherwise_Tag_Node;
   begin
      Initialize (Node.all'Access, Name, Line, Parent, Attributes);
      return Node.all'Access;
   end Create_Otherwise_Tag_Node;

   --  Tag names
   CHOOSE_TAG    : aliased constant String := "choose";
   IF_TAG        : aliased constant String := "if";
   OTHERWISE_TAG : aliased constant String := "otherwise";
   SET_TAG       : aliased constant String := "set";
   WHEN_TAG      : aliased constant String := "when";

   --  Name-space URI.  Use the JSTL name-space to make the XHTML views compatible
   --  the JSF.
   URI           : aliased constant String := "http://java.sun.com/jstl/core";

   --  Tag library definition.  Names must be sorted.
   Tag_Bindings  : aliased constant ASF.Factory.Binding_Array
     := ((Name => CHOOSE_TAG'Access,
          Component => null,
          Tag => Create_Choose_Tag_Node'Access),
       (Name => IF_TAG'Access,
        Component => null,
        Tag => Create_If_Tag_Node'Access),
       (Name => OTHERWISE_TAG'Access,
        Component => null,
        Tag => Create_Otherwise_Tag_Node'Access),
       (Name => SET_TAG'Access,
        Component => null,
        Tag => Create_Set_Tag_Node'Access),
       (Name => WHEN_TAG'Access,
        Component => null,
        Tag => Create_When_Tag_Node'Access));

   Tag_Factory   : aliased constant ASF.Factory.Factory_Bindings
     := (URI => URI'Access, Bindings => Tag_Bindings'Access);

   --  ------------------------------
   --  Tag factory for nodes defined in this package.
   --  ------------------------------
   function Definition return ASF.Factory.Factory_Bindings_Access is
   begin
      return Tag_Factory'Access;
   end Definition;

   --  Function names
   CAPITALIZE_FN       : aliased constant String := "capitalize";
   TO_UPPER_CASE_FN    : aliased constant String := "toUpperCase";
   TO_LOWER_CASE_FN    : aliased constant String := "toLowerCase";
   SUBSTRING_AFTER_FN  : aliased constant String := "substringAfter";
   SUBSTRING_BEFORE_FN : aliased constant String := "substringBefore";

   function Capitalize (Value : EL.Objects.Object) return EL.Objects.Object;
   function To_Upper_Case (Value : EL.Objects.Object) return EL.Objects.Object;
   function To_Lower_Case (Value : EL.Objects.Object) return EL.Objects.Object;
   function Substring_Before (Value : in EL.Objects.Object;
                              Token : in EL.Objects.Object) return EL.Objects.Object;
   function Substring_After (Value : in EL.Objects.Object;
                             Token : in EL.Objects.Object) return EL.Objects.Object;

   function Capitalize (Value : EL.Objects.Object) return EL.Objects.Object is
      S : constant String := EL.Objects.To_String (Value);
   begin
      return EL.Objects.To_Object (Util.Strings.Transforms.Capitalize (S));
   end Capitalize;

   function To_Upper_Case (Value : EL.Objects.Object) return EL.Objects.Object is
      S : constant String := EL.Objects.To_String (Value);
   begin
      return EL.Objects.To_Object (Util.Strings.Transforms.To_Upper_Case (S));
   end To_Upper_Case;

   function To_Lower_Case (Value : EL.Objects.Object) return EL.Objects.Object is
      S : constant String := EL.Objects.To_String (Value);
   begin
      return EL.Objects.To_Object (Util.Strings.Transforms.To_Lower_Case (S));
   end To_Lower_Case;

   --  ------------------------------
   --  Return the substring before the token string
   --  ------------------------------
   function Substring_Before (Value : in EL.Objects.Object;
                              Token : in EL.Objects.Object) return EL.Objects.Object is
      S   : constant String := EL.Objects.To_String (Value);
      T   : constant String := EL.Objects.To_String (Token);
      Pos : constant Natural := Ada.Strings.Fixed.Index (S, T);
   begin
      if Pos = 0 then
         return EL.Objects.Null_Object;
      else
         return EL.Objects.To_Object (S (S'First .. Pos - 1));
      end if;
   end Substring_Before;

   --  ------------------------------
   --  Return the substring after the token string
   --  ------------------------------
   function Substring_After (Value : in EL.Objects.Object;
                              Token : in EL.Objects.Object) return EL.Objects.Object is
      S   : constant String := EL.Objects.To_String (Value);
      T   : constant String := EL.Objects.To_String (Token);
      Pos : constant Natural := Ada.Strings.Fixed.Index (S, T);
   begin
      if Pos = 0 then
         return EL.Objects.Null_Object;
      else
         return EL.Objects.To_Object (S (Pos + T'Length .. S'Last));
      end if;
   end Substring_After;

   --  ------------------------------
   --  Register a set of functions in the namespace
   --  xmlns:fn="http://java.sun.com/jsp/jstl/functions"
   --  Functions:
   --    capitalize, toUpperCase, toLowerCase
   --  ------------------------------
   procedure Set_Functions (Mapper : in out EL.Functions.Function_Mapper'Class) is
      URI : constant String := "http://java.sun.com/jsp/jstl/functions";
   begin
      Mapper.Set_Function (Name      => CAPITALIZE_FN,
                           Namespace => URI,
                           Func      => Capitalize'Access);
      Mapper.Set_Function (Name      => TO_LOWER_CASE_FN,
                           Namespace => URI,
                           Func      => To_Lower_Case'Access);
      Mapper.Set_Function (Name      => TO_UPPER_CASE_FN,
                           Namespace => URI,
                           Func      => To_Upper_Case'Access);
      Mapper.Set_Function (Name      => SUBSTRING_BEFORE_FN,
                           Namespace => URI,
                           Func      => Substring_Before'Access);
      Mapper.Set_Function (Name      => SUBSTRING_AFTER_FN,
                           Namespace => URI,
                           Func      => Substring_After'Access);
   end Set_Functions;

end ASF.Views.Nodes.Core;

Add substring before and substring after EL functions


-----------------------------------------------------------------------
--  gen-model-operations -- Operation declarations
--  Copyright (C) 2012, 2016, 2017 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 Gen.Model.Operations is

   --  ------------------------------
   --  Get the value identified by the name.
   --  If the name cannot be found, the method should return the Null object.
   --  ------------------------------
   overriding
   function Get_Value (From : in Operation_Definition;
                       Name : in String) return Util.Beans.Objects.Object is
   begin
      if Name = "parameters" or Name = "columns" then
         return From.Parameters_Bean;

      elsif Name = "return" then
         return Util.Beans.Objects.To_Object (From.Return_Type);

      elsif Name = "type" then
         return Util.Beans.Objects.To_Object (Operation_Type'Image (From.Kind));

      else
         return Definition (From).Get_Value (Name);
      end if;
   end Get_Value;

   --  Prepare the generation of the model.
   overriding
   procedure Prepare (O : in out Operation_Definition) is
   begin
      null;
   end Prepare;

   --  ------------------------------
   --  Initialize the operation definition instance.
   --  ------------------------------
   overriding
   procedure Initialize (O : in out Operation_Definition) is
   begin
      O.Parameters_Bean := Util.Beans.Objects.To_Object (O.Parameters'Unchecked_Access,
                                                         Util.Beans.Objects.STATIC);

   end Initialize;

   --  ------------------------------
   --  Add an operation parameter with the given name and type.
   --  ------------------------------
   procedure Add_Parameter (Into      : in out Operation_Definition;
                            Name      : in Unbounded_String;
                            Of_Type   : in Unbounded_String;
                            Parameter : out Parameter_Definition_Access) is
   begin
      Parameter := new Parameter_Definition;
      Parameter.Name := Name;
      Parameter.Type_Name := Of_Type;
      Into.Parameters.Append (Parameter);
      if Into.Kind = UNKNOWN and then Of_Type = "ASF.Parts.Part" then
         Into.Kind := ASF_UPLOAD;
      elsif Into.Kind = UNKNOWN and then Of_Type = "AWA.Events.Module_Event" then
         Into.Kind := AWA_EVENT;
      elsif Into.Kind = UNKNOWN then
         Into.Kind := ASF_ACTION;
      end if;
   end Add_Parameter;

   --  ------------------------------
   --  Get the operation type.
   --  ------------------------------
   function Get_Type (From : in Operation_Definition) return Operation_Type is
   begin
      return From.Kind;
   end Get_Type;

   --  ------------------------------
   --  Create an operation with the given name.
   --  ------------------------------
   function Create_Operation (Name : in Unbounded_String) return Operation_Definition_Access is
      pragma Unreferenced (Name);

      Result : constant Operation_Definition_Access := new Operation_Definition;
   begin
      return Result;
   end Create_Operation;

end Gen.Model.Operations;

-----------------------------------------------------------------------
--  gen-model-operations -- Operation declarations
--  Copyright (C) 2012, 2016, 2017, 2018 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 Gen.Model.Operations is

   --  ------------------------------
   --  Get the value identified by the name.
   --  If the name cannot be found, the method should return the Null object.
   --  ------------------------------
   overriding
   function Get_Value (From : in Operation_Definition;
                       Name : in String) return Util.Beans.Objects.Object is
   begin
      if Name = "parameters" or Name = "columns" then
         return From.Parameters_Bean;

      elsif Name = "return" then
         return Util.Beans.Objects.To_Object (From.Return_Type);

      elsif Name = "type" then
         return Util.Beans.Objects.To_Object (Operation_Type'Image (From.Kind));

      else
         return Definition (From).Get_Value (Name);
      end if;
   end Get_Value;

   --  Prepare the generation of the model.
   overriding
   procedure Prepare (O : in out Operation_Definition) is
   begin
      null;
   end Prepare;

   --  ------------------------------
   --  Initialize the operation definition instance.
   --  ------------------------------
   overriding
   procedure Initialize (O : in out Operation_Definition) is
   begin
      O.Parameters_Bean := Util.Beans.Objects.To_Object (O.Parameters'Unchecked_Access,
                                                         Util.Beans.Objects.STATIC);

   end Initialize;

   --  ------------------------------
   --  Add an operation parameter with the given name and type.
   --  ------------------------------
   procedure Add_Parameter (Into      : in out Operation_Definition;
                            Name      : in Unbounded_String;
                            Of_Type   : in Unbounded_String;
                            Parameter : out Parameter_Definition_Access) is
   begin
      Parameter := new Parameter_Definition;
      Parameter.Set_Name (Name);
      Parameter.Type_Name := Of_Type;
      Into.Parameters.Append (Parameter);
      if Into.Kind = UNKNOWN and then Of_Type = "ASF.Parts.Part" then
         Into.Kind := ASF_UPLOAD;
      elsif Into.Kind = UNKNOWN and then Of_Type = "AWA.Events.Module_Event" then
         Into.Kind := AWA_EVENT;
      elsif Into.Kind = UNKNOWN then
         Into.Kind := ASF_ACTION;
      end if;
   end Add_Parameter;

   --  ------------------------------
   --  Get the operation type.
   --  ------------------------------
   function Get_Type (From : in Operation_Definition) return Operation_Type is
   begin
      return From.Kind;
   end Get_Type;

   --  ------------------------------
   --  Create an operation with the given name.
   --  ------------------------------
   function Create_Operation (Name : in Unbounded_String) return Operation_Definition_Access is
      pragma Unreferenced (Name);

      Result : constant Operation_Definition_Access := new Operation_Definition;
   begin
      return Result;
   end Create_Operation;

end Gen.Model.Operations;

Update to use Get_Location and Set_Name

Update to use Get_Location and Set_Name


-----------------------------------------------------------------------
--  awa-permissions-controllers -- Permission controllers
--  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 Security.Contexts;
with Security.Controllers;

package AWA.Permissions.Controllers is

   --  ------------------------------
   --  Security Controller
   --  ------------------------------
   --  The Entity_Controller implements an entity based permission check.
   --  The controller is configured through an XML description.  It uses an SQL statement
   --  to verify that a permission is granted.
   --
   --  The SQL query can use the following query parameters:
   --
   --

   --
entity_type

   --
The entity type identifier defined by the entity permission

   --
entity_id

   --
The entity identifier which is associated with an ACL entry to check

   --
user_id

   --
The user identifier

   --

   type Entity_Controller (Len : Positive) is
   limited new Security.Controllers.Controller with record
      SQL    : String (1 .. Len);
      Entity : ADO.Entity_Type;
   end record;
   type Entity_Controller_Access is access all Entity_Controller'Class;

   --  Returns true if the user associated with the security context Context has
   --  the permission to access a database entity.  The security context contains some
   --  information about the entity to check and the permission controller will use an
   --  SQL statement to verify the permission.
   overriding
   function Has_Permission (Handler : in Entity_Controller;
                            Context : in Security.Contexts.Security_Context'Class;
                            Permission : in Security.Permissions.Permission'Class)
                            return Boolean;

end AWA.Permissions.Controllers;

-----------------------------------------------------------------------
--  awa-permissions-controllers -- Permission controllers
--  Copyright (C) 2011, 2012, 2013, 2014 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 Security.Contexts;
with Security.Controllers;

package AWA.Permissions.Controllers is

   --  ------------------------------
   --  Security Controller
   --  ------------------------------
   --  The Entity_Controller implements an entity based permission check.
   --  The controller is configured through an XML description.  It uses an SQL statement
   --  to verify that a permission is granted.
   --
   --  The SQL query can use the following query parameters:
   --
   --

   --
entity_type

   --
The entity type identifier defined by the entity permission

   --
entity_id

   --
The entity identifier which is associated with an ACL entry to check

   --
user_id

   --
The user identifier

   --

   type Entity_Controller (Len : Positive) is
   limited new Security.Controllers.Controller with record
      Entities : Entity_Type_Array;
      SQL      : String (1 .. Len);
   end record;
   type Entity_Controller_Access is access all Entity_Controller'Class;

   --  Returns true if the user associated with the security context Context has
   --  the permission to access a database entity.  The security context contains some
   --  information about the entity to check and the permission controller will use an
   --  SQL statement to verify the permission.
   overriding
   function Has_Permission (Handler : in Entity_Controller;
                            Context : in Security.Contexts.Security_Context'Class;
                            Permission : in Security.Permissions.Permission'Class)
                            return Boolean;

end AWA.Permissions.Controllers;

Store several entity types in the entity permission definition