-----------------------------------------------------------------------
--  html-factory -- Factory for HTML UI Components
--  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 ASF.Components.Base;
with ASF.Components.Html.Text;
with ASF.Components.Html.Lists;
with ASF.Components.Html.Links;
with ASF.Components.Html.Panels;
with ASF.Components.Html.Forms;
with ASF.Views.Nodes;
package body ASF.Components.Html.Factory is

   use ASF.Components.Base;

   function Create_Output return UIComponent_Access;
   function Create_Output_Link return UIComponent_Access;
   function Create_Output_Format return UIComponent_Access;
   function Create_Label return UIComponent_Access;
   function Create_List return UIComponent_Access;
   function Create_PanelGroup return UIComponent_Access;
   function Create_Form return UIComponent_Access;
   function Create_Input return UIComponent_Access;
   function Create_Command return UIComponent_Access;

   --  ------------------------------
   --  Create an UIOutput component
   --  ------------------------------
   function Create_Output return UIComponent_Access is
   begin
      return new ASF.Components.Html.Text.UIOutput;
   end Create_Output;

   --  ------------------------------
   --  Create an UIOutputLink component
   --  ------------------------------
   function Create_Output_Link return UIComponent_Access is
   begin
      return new ASF.Components.Html.Links.UIOutputLink;
   end Create_Output_Link;

   --  ------------------------------
   --  Create an UIOutput component
   --  ------------------------------
   function Create_Output_Format return UIComponent_Access is
   begin
      return new ASF.Components.Html.Text.UIOutputFormat;
   end Create_Output_Format;

   --  ------------------------------
   --  Create a label component
   --  ------------------------------
   function Create_Label return UIComponent_Access is
   begin
      return new ASF.Components.Html.Text.UILabel;
   end Create_Label;

   --  ------------------------------
   --  Create an UIList component
   --  ------------------------------
   function Create_List return UIComponent_Access is
   begin
      return new ASF.Components.Html.Lists.UIList;
   end Create_List;

   --  ------------------------------
   --  Create an UIPanelGroup component
   --  ------------------------------
   function Create_PanelGroup return UIComponent_Access is
   begin
      return new ASF.Components.Html.Panels.UIPanelGroup;
   end Create_PanelGroup;

   --  ------------------------------
   --  Create an UIForm component
   --  ------------------------------
   function Create_Form return UIComponent_Access is
   begin
      return new ASF.Components.Html.Forms.UIForm;
   end Create_Form;

   --  ------------------------------
   --  Create an UIInput component
   --  ------------------------------
   function Create_Input return UIComponent_Access is
   begin
      return new ASF.Components.Html.Forms.UIInput;
   end Create_Input;

   --  ------------------------------
   --  Create an UICommand component
   --  ------------------------------
   function Create_Command return UIComponent_Access is
   begin
      return new ASF.Components.Html.Forms.UICommand;
   end Create_Command;

   use ASF.Views.Nodes;

   URI                : aliased constant String := "http://java.sun.com/jsf/html";
   COMMAND_BUTTON_TAG : aliased constant String := "commandButton";
   FORM_TAG           : aliased constant String := "form";
   INPUT_TAG          : aliased constant String := "input";
   LABEL_TAG          : aliased constant String := "label";
   LIST_TAG           : aliased constant String := "list";
   OUTPUT_FORMAT_TAG  : aliased constant String := "outputFormat";
   OUTPUT_LINK_TAG    : aliased constant String := "outputLink";
   OUTPUT_TEXT_TAG    : aliased constant String := "outputText";
   PANEL_GROUP_TAG    : aliased constant String := "panelGroup";

   Html_Bindings : aliased constant ASF.Factory.Binding_Array
     := (1 => (Name      => COMMAND_BUTTON_TAG'Access,
               Component => Create_Command'Access,
               Tag       => Create_Component_Node'Access),
         2 => (Name      => FORM_TAG'Access,
               Component => Create_Form'Access,
               Tag       => Create_Component_Node'Access),
         3 => (Name      => INPUT_TAG'Access,
               Component => Create_Input'Access,
               Tag       => Create_Component_Node'Access),
         4 => (Name      => LABEL_TAG'Access,
               Component => Create_Label'Access,
               Tag       => Create_Component_Node'Access),
         5 => (Name      => LIST_TAG'Access,
               Component => Create_List'Access,
               Tag       => Create_Component_Node'Access),
         6 => (Name      => OUTPUT_FORMAT_TAG'Access,
               Component => Create_Output_Format'Access,
               Tag       => Create_Component_Node'Access),
         7 => (Name      => OUTPUT_LINK_TAG'Access,
               Component => Create_Output_Link'Access,
               Tag       => Create_Component_Node'Access),
         8 => (Name      => OUTPUT_TEXT_TAG'Access,
               Component => Create_Output'Access,
               Tag       => Create_Component_Node'Access),
         9 => (Name      => PANEL_GROUP_TAG'Access,
               Component => Create_PanelGroup'Access,
               Tag       => Create_Component_Node'Access)
        );

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

   --  ------------------------------
   --  Get the HTML component factory.
   --  ------------------------------
   function Definition return ASF.Factory.Factory_Bindings_Access is
   begin
      return Html_Factory'Access;
   end Definition;

end ASF.Components.Html.Factory;

-----------------------------------------------------------------------
--  html-factory -- Factory for HTML UI Components
--  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.Components.Base;
with ASF.Components.Html.Text;
with ASF.Components.Html.Lists;
with ASF.Components.Html.Links;
with ASF.Components.Html.Panels;
with ASF.Components.Html.Forms;
with ASF.Views.Nodes;
package body ASF.Components.Html.Factory is

   use ASF.Components.Base;

   function Create_Output return UIComponent_Access;
   function Create_Output_Link return UIComponent_Access;
   function Create_Output_Format return UIComponent_Access;
   function Create_Label return UIComponent_Access;
   function Create_List return UIComponent_Access;
   function Create_PanelGroup return UIComponent_Access;
   function Create_Form return UIComponent_Access;
   function Create_Input return UIComponent_Access;
   function Create_Command return UIComponent_Access;

   --  ------------------------------
   --  Create an UIOutput component
   --  ------------------------------
   function Create_Output return UIComponent_Access is
   begin
      return new ASF.Components.Html.Text.UIOutput;
   end Create_Output;

   --  ------------------------------
   --  Create an UIOutputLink component
   --  ------------------------------
   function Create_Output_Link return UIComponent_Access is
   begin
      return new ASF.Components.Html.Links.UIOutputLink;
   end Create_Output_Link;

   --  ------------------------------
   --  Create an UIOutput component
   --  ------------------------------
   function Create_Output_Format return UIComponent_Access is
   begin
      return new ASF.Components.Html.Text.UIOutputFormat;
   end Create_Output_Format;

   --  ------------------------------
   --  Create a label component
   --  ------------------------------
   function Create_Label return UIComponent_Access is
   begin
      return new ASF.Components.Html.Text.UILabel;
   end Create_Label;

   --  ------------------------------
   --  Create an UIList component
   --  ------------------------------
   function Create_List return UIComponent_Access is
   begin
      return new ASF.Components.Html.Lists.UIList;
   end Create_List;

   --  ------------------------------
   --  Create an UIPanelGroup component
   --  ------------------------------
   function Create_PanelGroup return UIComponent_Access is
   begin
      return new ASF.Components.Html.Panels.UIPanelGroup;
   end Create_PanelGroup;

   --  ------------------------------
   --  Create an UIForm component
   --  ------------------------------
   function Create_Form return UIComponent_Access is
   begin
      return new ASF.Components.Html.Forms.UIForm;
   end Create_Form;

   --  ------------------------------
   --  Create an UIInput component
   --  ------------------------------
   function Create_Input return UIComponent_Access is
   begin
      return new ASF.Components.Html.Forms.UIInput;
   end Create_Input;

   --  ------------------------------
   --  Create an UICommand component
   --  ------------------------------
   function Create_Command return UIComponent_Access is
   begin
      return new ASF.Components.Html.Forms.UICommand;
   end Create_Command;

   use ASF.Views.Nodes;

   URI                : aliased constant String := "http://java.sun.com/jsf/html";
   COMMAND_BUTTON_TAG : aliased constant String := "commandButton";
   FORM_TAG           : aliased constant String := "form";
   INPUT_SECRET_TAG   : aliased constant String := "inputSecret";
   INPUT_TEXT_TAG     : aliased constant String := "inputText";
   LABEL_TAG          : aliased constant String := "label";
   LIST_TAG           : aliased constant String := "list";
   OUTPUT_FORMAT_TAG  : aliased constant String := "outputFormat";
   OUTPUT_LINK_TAG    : aliased constant String := "outputLink";
   OUTPUT_TEXT_TAG    : aliased constant String := "outputText";
   PANEL_GROUP_TAG    : aliased constant String := "panelGroup";

   Html_Bindings : aliased constant ASF.Factory.Binding_Array
     := (1 => (Name      => COMMAND_BUTTON_TAG'Access,
               Component => Create_Command'Access,
               Tag       => Create_Component_Node'Access),
         2 => (Name      => FORM_TAG'Access,
               Component => Create_Form'Access,
               Tag       => Create_Component_Node'Access),
         3 => (Name      => INPUT_SECRET_TAG'Access,
               Component => Create_Input'Access,
               Tag       => Create_Component_Node'Access),
         4 => (Name      => INPUT_TEXT_TAG'Access,
               Component => Create_Input'Access,
               Tag       => Create_Component_Node'Access),
         5 => (Name      => LABEL_TAG'Access,
               Component => Create_Label'Access,
               Tag       => Create_Component_Node'Access),
         6 => (Name      => LIST_TAG'Access,
               Component => Create_List'Access,
               Tag       => Create_Component_Node'Access),
         7 => (Name      => OUTPUT_FORMAT_TAG'Access,
               Component => Create_Output_Format'Access,
               Tag       => Create_Component_Node'Access),
         8 => (Name      => OUTPUT_LINK_TAG'Access,
               Component => Create_Output_Link'Access,
               Tag       => Create_Component_Node'Access),
         9 => (Name      => OUTPUT_TEXT_TAG'Access,
               Component => Create_Output'Access,
               Tag       => Create_Component_Node'Access),
        10 => (Name      => PANEL_GROUP_TAG'Access,
               Component => Create_PanelGroup'Access,
               Tag       => Create_Component_Node'Access)
        );

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

   --  ------------------------------
   --  Get the HTML component factory.
   --  ------------------------------
   function Definition return ASF.Factory.Factory_Bindings_Access is
   begin
      return Html_Factory'Access;
   end Definition;

end ASF.Components.Html.Factory;

Rename h:input into h:inputText and add h:inputSecret


------------------------------------------------------------------------------
-- Copyright (c) 2017, Natacha Porté                                        --
--                                                                          --
-- 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 Natools.S_Expressions.Atom_Buffers;
with Natools.S_Expressions.Atom_Ref_Constructors;
with Natools.S_Expressions.Interpreter_Loop;
with Natools.S_Expressions.Printers.Pretty;

package body Natools.Web.Comment_Cookies is

   Parameters : constant Natools.S_Expressions.Printers.Pretty.Parameters
     := (Width         => 0,
         Newline_At    => (others => (others => False)),
         Space_At      => (others => (others => False)),
         Tab_Stop      => <>,
         Indentation   => 0,
         Indent        => <>,
         Quoted        => S_Expressions.Printers.Pretty.No_Quoted,
         Token         => S_Expressions.Printers.Pretty.Extended_Token,
         Hex_Casing    => <>,
         Quoted_Escape => <>,
         Char_Encoding => <>,
         Fallback      => S_Expressions.Printers.Pretty.Verbatim,
         Newline       => S_Expressions.Printers.Pretty.LF);

   function Create (A : S_Expressions.Atom)
     return S_Expressions.Atom_Refs.Immutable_Reference
     renames S_Expressions.Atom_Ref_Constructors.Create;

   procedure Set_Atom
     (Info : in out Comment_Info;
      Context : in Meaningless_Type;
      Name : in S_Expressions.Atom;
      Arguments : in out S_Expressions.Lockable.Descriptor'Class);

   function To_Atom (Kind : in Atom_Kind) return S_Expressions.Atom;

   procedure Initialize is new S_Expressions.Interpreter_Loop
     (Comment_Info, Meaningless_Type, Set_Atom);

   ------------------------------
   -- Local Helper Subprograms --
   ------------------------------

   procedure Set_Atom
     (Info : in out Comment_Info;
      Context : in Meaningless_Type;
      Name : in S_Expressions.Atom;
      Arguments : in out S_Expressions.Lockable.Descriptor'Class)
   is
      pragma Unreferenced (Context);
      use type S_Expressions.Events.Event;
      Kind : Atom_Kind;
   begin
      if Arguments.Current_Event /= S_Expressions.Events.Add_Atom then
         return;
      end if;

      declare
         S_Name : constant String := S_Expressions.To_String (Name);
      begin
         Kind := Atom_Kind'Value (S_Name);
      exception
         when Constraint_Error =>
            Log (Severities.Error, "Unknown comment atom kind """
              & S_Name & '"');
      end;

      Info.Refs (Kind) := Create (Arguments.Current_Atom);
   end Set_Atom;

   function To_Atom (Kind : in Atom_Kind) return S_Expressions.Atom is
   begin
      case Kind is
         when Name =>
            return (Character'Pos ('N'), Character'Pos ('a'),
                    Character'Pos ('m'), Character'Pos ('e'));
         when Mail =>
            return (Character'Pos ('M'), Character'Pos ('a'),
                    Character'Pos ('i'), Character'Pos ('l'));
         when Link =>
            return (Character'Pos ('L'), Character'Pos ('n'),
                    Character'Pos ('n'), Character'Pos ('k'));
         when Filter =>
            return (Character'Pos ('F'), Character'Pos ('i'),
                    Character'Pos ('l'), Character'Pos ('t'),
                    Character'Pos ('e'), Character'Pos ('r'));
      end case;
   end To_Atom;

   -----------------------------------
   -- Comment Info Public Interface --
   -----------------------------------

   function Create
     (Name : in S_Expressions.Atom_Refs.Immutable_Reference;
      Mail : in S_Expressions.Atom_Refs.Immutable_Reference;
      Link : in S_Expressions.Atom_Refs.Immutable_Reference;
      Filter : in S_Expressions.Atom_Refs.Immutable_Reference)
     return Comment_Info is
   begin
      return (Refs =>
        (Comment_Cookies.Name => Name,
         Comment_Cookies.Mail => Mail,
         Comment_Cookies.Link => Link,
         Comment_Cookies.Filter => Filter));
   end Create;

   function Create
     (Expression : in out S_Expressions.Lockable.Descriptor'Class)
     return Comment_Info
   is
      use type S_Expressions.Events.Event;
      Result : Comment_Info := Null_Info;
      Event : S_Expressions.Events.Event;
   begin
      case Expression.Current_Event is
         when S_Expressions.Events.Add_Atom =>
            for Kind in Result.Refs'Range loop
               Result.Refs (Kind) := Create (Expression.Current_Atom);
               Expression.Next (Event);
               exit when Event /= S_Expressions.Events.Add_Atom;
            end loop;

         when S_Expressions.Events.Open_List =>
            Initialize (Expression, Result, Meaningless_Value);

         when S_Expressions.Events.Close_List
           | S_Expressions.Events.End_Of_Input
           | S_Expressions.Events.Error
         =>
            null;
      end case;

      return Result;
   end Create;

   function Named_Serialization (Info : in Comment_Info)
     return S_Expressions.Atom
   is
      Buffer : aliased S_Expressions.Atom_Buffers.Atom_Buffer;
      Printer : S_Expressions.Printers.Pretty.Stream_Printer (Buffer'Access);
   begin
      Printer.Set_Parameters (Parameters);
      Buffer.Preallocate (120);

      for Kind in Atom_Kind loop
         if not Info.Refs (Kind).Is_Empty then
            Printer.Open_List;
            Printer.Append_Atom (To_Atom (Kind));
            Printer.Append_Atom (Info.Refs (Kind).Query);
            Printer.Close_List;
         end if;
      end loop;

      return Buffer.Data;
   end Named_Serialization;

   function Positional_Serialization (Info : in Comment_Info)
     return S_Expressions.Atom
   is
      Buffer : aliased S_Expressions.Atom_Buffers.Atom_Buffer;
      Printer : S_Expressions.Printers.Pretty.Stream_Printer (Buffer'Access);
      Last : Atom_Kind;
   begin
      Printer.Set_Parameters (Parameters);
      Buffer.Preallocate (120);

      Last := Atom_Kind'Last;
      while Info.Refs (Last).Is_Empty loop
         if Last = Atom_Kind'First then
            return S_Expressions.Null_Atom;
         else
            Last := Atom_Kind'Pred (Last);
         end if;
      end loop;

      for Kind in Atom_Kind'First .. Last loop
         if Info.Refs (Kind).Is_Empty then
            Printer.Append_Atom (S_Expressions.Null_Atom);
         else
            Printer.Append_Atom (Info.Refs (Kind).Query);
         end if;
      end loop;

      return Buffer.Data;
   end Positional_Serialization;

   -------------------------------
   -- Codec DB Public Interface --
   -------------------------------

   function Decode
     (DB : in Codec_DB;
      Cookie : in String)
     return Comment_Info
   is
      pragma Unreferenced (DB);
      pragma Unreferenced (Cookie);
   begin
      raise Program_Error with "Not Implemented yet";
      return Null_Info;
   end Decode;

   function Encode
     (DB : in Codec_DB;
      Info : in Comment_Info)
     return String is
   begin
      if DB.Enc = null then
         raise Program_Error
           with "Comment_Cookie.Encode called before Set_Encoder";
      end if;

      case DB.Serialization is
         when Named =>
            return DB.Enc.all (Named_Serialization (Info));

         when Positional =>
            return DB.Enc.all (Positional_Serialization (Info));
      end case;
   end Encode;

   procedure Register
     (DB : in out Codec_DB;
      Key : in Character;
      Filter : in not null Decoder) is
   begin
      DB.Dec := Decoder_Maps.Include (DB.Dec, Key, Filter);
   end Register;

   procedure Set_Encoder
     (DB : in out Codec_DB;
      Filter : in not null Encoder;
      Serialization : in Serialization_Kind) is
   begin
      DB.Enc := Filter;
      DB.Serialization := Serialization;
   end Set_Encoder;

end Natools.Web.Comment_Cookies;

------------------------------------------------------------------------------
-- Copyright (c) 2017, Natacha Porté                                        --
--                                                                          --
-- 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 Natools.S_Expressions.Atom_Buffers;
with Natools.S_Expressions.Atom_Ref_Constructors;
with Natools.S_Expressions.Interpreter_Loop;
with Natools.S_Expressions.Parsers;
with Natools.S_Expressions.Printers.Pretty;

package body Natools.Web.Comment_Cookies is

   Parameters : constant Natools.S_Expressions.Printers.Pretty.Parameters
     := (Width         => 0,
         Newline_At    => (others => (others => False)),
         Space_At      => (others => (others => False)),
         Tab_Stop      => <>,
         Indentation   => 0,
         Indent        => <>,
         Quoted        => S_Expressions.Printers.Pretty.No_Quoted,
         Token         => S_Expressions.Printers.Pretty.Extended_Token,
         Hex_Casing    => <>,
         Quoted_Escape => <>,
         Char_Encoding => <>,
         Fallback      => S_Expressions.Printers.Pretty.Verbatim,
         Newline       => S_Expressions.Printers.Pretty.LF);

   function Create (A : S_Expressions.Atom)
     return S_Expressions.Atom_Refs.Immutable_Reference
     renames S_Expressions.Atom_Ref_Constructors.Create;

   procedure Set_Atom
     (Info : in out Comment_Info;
      Context : in Meaningless_Type;
      Name : in S_Expressions.Atom;
      Arguments : in out S_Expressions.Lockable.Descriptor'Class);

   function To_Atom (Kind : in Atom_Kind) return S_Expressions.Atom;

   procedure Initialize is new S_Expressions.Interpreter_Loop
     (Comment_Info, Meaningless_Type, Set_Atom);

   ------------------------------
   -- Local Helper Subprograms --
   ------------------------------

   procedure Set_Atom
     (Info : in out Comment_Info;
      Context : in Meaningless_Type;
      Name : in S_Expressions.Atom;
      Arguments : in out S_Expressions.Lockable.Descriptor'Class)
   is
      pragma Unreferenced (Context);
      use type S_Expressions.Events.Event;
      Kind : Atom_Kind;
   begin
      if Arguments.Current_Event /= S_Expressions.Events.Add_Atom then
         return;
      end if;

      declare
         S_Name : constant String := S_Expressions.To_String (Name);
      begin
         Kind := Atom_Kind'Value (S_Name);
      exception
         when Constraint_Error =>
            Log (Severities.Error, "Unknown comment atom kind """
              & S_Name & '"');
      end;

      Info.Refs (Kind) := Create (Arguments.Current_Atom);
   end Set_Atom;

   function To_Atom (Kind : in Atom_Kind) return S_Expressions.Atom is
   begin
      case Kind is
         when Name =>
            return (Character'Pos ('N'), Character'Pos ('a'),
                    Character'Pos ('m'), Character'Pos ('e'));
         when Mail =>
            return (Character'Pos ('M'), Character'Pos ('a'),
                    Character'Pos ('i'), Character'Pos ('l'));
         when Link =>
            return (Character'Pos ('L'), Character'Pos ('n'),
                    Character'Pos ('n'), Character'Pos ('k'));
         when Filter =>
            return (Character'Pos ('F'), Character'Pos ('i'),
                    Character'Pos ('l'), Character'Pos ('t'),
                    Character'Pos ('e'), Character'Pos ('r'));
      end case;
   end To_Atom;

   -----------------------------------
   -- Comment Info Public Interface --
   -----------------------------------

   function Create
     (Name : in S_Expressions.Atom_Refs.Immutable_Reference;
      Mail : in S_Expressions.Atom_Refs.Immutable_Reference;
      Link : in S_Expressions.Atom_Refs.Immutable_Reference;
      Filter : in S_Expressions.Atom_Refs.Immutable_Reference)
     return Comment_Info is
   begin
      return (Refs =>
        (Comment_Cookies.Name => Name,
         Comment_Cookies.Mail => Mail,
         Comment_Cookies.Link => Link,
         Comment_Cookies.Filter => Filter));
   end Create;

   function Create
     (Expression : in out S_Expressions.Lockable.Descriptor'Class)
     return Comment_Info
   is
      use type S_Expressions.Events.Event;
      Result : Comment_Info := Null_Info;
      Event : S_Expressions.Events.Event;
   begin
      case Expression.Current_Event is
         when S_Expressions.Events.Add_Atom =>
            for Kind in Result.Refs'Range loop
               Result.Refs (Kind) := Create (Expression.Current_Atom);
               Expression.Next (Event);
               exit when Event /= S_Expressions.Events.Add_Atom;
            end loop;

         when S_Expressions.Events.Open_List =>
            Initialize (Expression, Result, Meaningless_Value);

         when S_Expressions.Events.Close_List
           | S_Expressions.Events.End_Of_Input
           | S_Expressions.Events.Error
         =>
            null;
      end case;

      return Result;
   end Create;

   function Named_Serialization (Info : in Comment_Info)
     return S_Expressions.Atom
   is
      Buffer : aliased S_Expressions.Atom_Buffers.Atom_Buffer;
      Printer : S_Expressions.Printers.Pretty.Stream_Printer (Buffer'Access);
   begin
      Printer.Set_Parameters (Parameters);
      Buffer.Preallocate (120);

      for Kind in Atom_Kind loop
         if not Info.Refs (Kind).Is_Empty then
            Printer.Open_List;
            Printer.Append_Atom (To_Atom (Kind));
            Printer.Append_Atom (Info.Refs (Kind).Query);
            Printer.Close_List;
         end if;
      end loop;

      return Buffer.Data;
   end Named_Serialization;

   function Positional_Serialization (Info : in Comment_Info)
     return S_Expressions.Atom
   is
      Buffer : aliased S_Expressions.Atom_Buffers.Atom_Buffer;
      Printer : S_Expressions.Printers.Pretty.Stream_Printer (Buffer'Access);
      Last : Atom_Kind;
   begin
      Printer.Set_Parameters (Parameters);
      Buffer.Preallocate (120);

      Last := Atom_Kind'Last;
      while Info.Refs (Last).Is_Empty loop
         if Last = Atom_Kind'First then
            return S_Expressions.Null_Atom;
         else
            Last := Atom_Kind'Pred (Last);
         end if;
      end loop;

      for Kind in Atom_Kind'First .. Last loop
         if Info.Refs (Kind).Is_Empty then
            Printer.Append_Atom (S_Expressions.Null_Atom);
         else
            Printer.Append_Atom (Info.Refs (Kind).Query);
         end if;
      end loop;

      return Buffer.Data;
   end Positional_Serialization;

   -------------------------------
   -- Codec DB Public Interface --
   -------------------------------

   function Decode
     (DB : in Codec_DB;
      Cookie : in String)
     return Comment_Info
   is
      Cursor : Decoder_Maps.Cursor;
   begin
      if Cookie'Length = 0 then
         return Null_Info;
      end if;

      Cursor := DB.Dec.Find (Cookie (Cookie'First));

      if not Decoder_Maps.Has_Element (Cursor) then
         return Null_Info;
      end if;

      declare
         Parser : S_Expressions.Parsers.Memory_Parser
           := S_Expressions.Parsers.Create
              (Decoder_Maps.Element (Cursor).all (Cookie));
      begin
         return Create (Parser);
      end;
   end Decode;

   function Encode
     (DB : in Codec_DB;
      Info : in Comment_Info)
     return String is
   begin
      if DB.Enc = null then
         raise Program_Error
           with "Comment_Cookie.Encode called before Set_Encoder";
      end if;

      case DB.Serialization is
         when Named =>
            return DB.Enc.all (Named_Serialization (Info));

         when Positional =>
            return DB.Enc.all (Positional_Serialization (Info));
      end case;
   end Encode;

   procedure Register
     (DB : in out Codec_DB;
      Key : in Character;
      Filter : in not null Decoder) is
   begin
      DB.Dec := Decoder_Maps.Include (DB.Dec, Key, Filter);
   end Register;

   procedure Set_Encoder
     (DB : in out Codec_DB;
      Filter : in not null Encoder;
      Serialization : in Serialization_Kind) is
   begin
      DB.Enc := Filter;
      DB.Serialization := Serialization;
   end Set_Encoder;

end Natools.Web.Comment_Cookies;

implement the Decode function

comment_cookies: implement the Decode function


--  bkp-files -- File and directories
-----------------------------------------------------------------------
--  Copyright (C) 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 Util.Log.Loggers;
with Util.Files;
with Util.Encoders.Base16;
package body Babel.Files is

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("Bkp.Files");

   Hex_Encoder : Util.Encoders.Base16.Encoder;

   --  ------------------------------
   --  Allocate a File_Type entry with the given name for the directory.
   --  ------------------------------
   function Allocate (Name : in String;
                      Dir  : in Directory_Type) return File_Type is
      Result : constant File_Type := new File '(Len    => Name'Length,
                                                Id     => NO_IDENTIFIER,
                                                Dir    => Dir,
                                                Name   => Name,
                                                others => <>);
   begin
      return Result;
   end Allocate;

   --  ------------------------------
   --  Allocate a Directory_Type entry with the given name for the directory.
   --  ------------------------------
   function Allocate (Name : in String;
                      Dir  : in Directory_Type) return Directory_Type is
      use Ada.Strings.Unbounded;

      Result : constant Directory_Type := new Directory '(Len    => Name'Length,
                                                          Id     => NO_IDENTIFIER,
                                                          Parent => Dir,
                                                          Name   => Name,
                                                          others => <>);
   begin
      if Dir /= null then
         Result.Path := To_Unbounded_String
           (Util.Files.Compose (To_String (Dir.Path), Name));
      end if;
      return Result;
   end Allocate;

   --  ------------------------------
   --  Return true if the file was modified and need a backup.
   --  ------------------------------
   function Is_Modified (Element : in File_Type) return Boolean is
      use type ADO.Identifier;
   begin
      if Element.Id = NO_IDENTIFIER then
         return True;
      elsif (Element.Status and FILE_MODIFIED) /= 0 then
         return True;
      else
         return False;
      end if;
   end Is_Modified;

   --  ------------------------------
   --  Set the file as modified.
   --  ------------------------------
   procedure Set_Modified (Element : in File_Type) is
   begin
      Element.Status := Element.Status or FILE_MODIFIED;
   end Set_Modified;

   --  ------------------------------
   --  Set the SHA1 signature that was computed for this file.
   --  If the computed signature is different from the current signature,
   --  the FILE_MODIFIED flag is set on the file.  The FILE_HAS_SHA1 flag
   --  is set on the file.
   --  ------------------------------
   procedure Set_Signature (Element   : in File_Type;
                            Signature : in Util.Encoders.SHA1.Hash_Array) is
      use type Util.Encoders.SHA1.Hash_Array;
   begin
      if (Element.Status and FILE_HAS_SHA1) /= 0 and then Element.SHA1 /= Signature then
         Element.Status := Element.Status or FILE_MODIFIED;
      end if;
      Element.Status := Element.Status or FILE_HAS_SHA1;
      Element.SHA1   := Signature;
   end Set_Signature;

   --  ------------------------------
   --  Set the file size.  If the new size is different, the FILE_MODIFIED
   --  flag is set on the file.
   --  ------------------------------
   procedure Set_Size (Element : in File_Type;
                       Size    : in File_Size) is
   begin
      if Element.Size /= Size then
         Element.Size := Size;
         Element.Status := Element.Status or FILE_MODIFIED;
      end if;
   end Set_Size;

   --  ------------------------------
   --  Return the path for the file.
   --  ------------------------------
   function Get_Path (Element : in File_Type) return String is
   begin
      if Element.Dir = null then
         return Element.Name;
      else
         return Util.Files.Compose (Get_Path (Element.Dir), Element.Name);
      end if;
   end Get_Path;

   --  ------------------------------
   --  Return the path for the directory.
   --  ------------------------------
   function Get_Path (Element : in Directory_Type) return String is
   begin
      return Ada.Strings.Unbounded.To_String (Element.Path);
   end Get_Path;

   --  ------------------------------
   --  Return the SHA1 signature computed for the file.
   --  ------------------------------
   function Get_SHA1 (Element : in File_Type) return String is
   begin
      return Hex_Encoder.Transform (Element.SHA1);
   end Get_SHA1;

   --  ------------------------------
   --  Add the file with the given name in the container.
   --  ------------------------------
   overriding
   procedure Add_File (Into    : in out Default_Container;
                       Element : in File_Type) is
   begin
      Into.Files.Append (Element);
   end Add_File;

   --  ------------------------------
   --  Add the directory with the given name in the container.
   --  ------------------------------
   overriding
   procedure Add_Directory (Into    : in out Default_Container;
                            Element : in Directory_Type) is
   begin
      Into.Dirs.Append (Element);
   end Add_Directory;

   --  ------------------------------
   --  Create a new file instance with the given name in the container.
   --  ------------------------------
   overriding
   function Create (Into : in Default_Container;
                    Name : in String) return File_Type is
   begin
      return Allocate (Name => Name,
                       Dir  => Into.Current);
   end Create;

   --  ------------------------------
   --  Create a new directory instance with the given name in the container.
   --  ------------------------------
   overriding
   function Create (Into : in Default_Container;
                    Name : in String) return Directory_Type is
   begin
      return Allocate (Name => Name,
                       Dir  => Into.Current);
   end Create;

   --  ------------------------------
   --  Find the file with the given name in this file container.
   --  Returns NO_FILE if the file was not found.
   --  ------------------------------
   overriding
   function Find (From : in Default_Container;
                  Name : in String) return File_Type is
      pragma Unreferenced (From, Name);
   begin
      return NO_FILE;
   end Find;

   --  ------------------------------
   --  Find the directory with the given name in this file container.
   --  Returns NO_DIRECTORY if the directory was not found.
   --  ------------------------------
   overriding
   function Find (From : in Default_Container;
                  Name : in String) return Directory_Type is
      pragma Unreferenced (From, Name);
   begin
      return NO_DIRECTORY;
   end Find;

end Babel.Files;

--  bkp-files -- File and directories
-----------------------------------------------------------------------
--  Copyright (C) 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 Util.Log.Loggers;
with Util.Files;
with Util.Encoders.Base16;
package body Babel.Files is

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("Bkp.Files");

   Hex_Encoder : Util.Encoders.Base16.Encoder;

   --  ------------------------------
   --  Allocate a File_Type entry with the given name for the directory.
   --  ------------------------------
   function Allocate (Name : in String;
                      Dir  : in Directory_Type) return File_Type is
      Result : constant File_Type := new File '(Len    => Name'Length,
                                                Id     => NO_IDENTIFIER,
                                                Dir    => Dir,
                                                Name   => Name,
                                                others => <>);
   begin
      return Result;
   end Allocate;

   --  ------------------------------
   --  Allocate a Directory_Type entry with the given name for the directory.
   --  ------------------------------
   function Allocate (Name : in String;
                      Dir  : in Directory_Type) return Directory_Type is
      use Ada.Strings.Unbounded;

      Result : constant Directory_Type := new Directory '(Len    => Name'Length,
                                                          Id     => NO_IDENTIFIER,
                                                          Parent => Dir,
                                                          Name   => Name,
                                                          others => <>);
   begin
      if Dir /= null then
         Result.Path := To_Unbounded_String
           (Util.Files.Compose (To_String (Dir.Path), Name));
      end if;
      return Result;
   end Allocate;

   --  ------------------------------
   --  Return true if the file was modified and need a backup.
   --  ------------------------------
   function Is_Modified (Element : in File_Type) return Boolean is
      use type ADO.Identifier;
   begin
      if Element.Id = NO_IDENTIFIER then
         return True;
      elsif (Element.Status and FILE_MODIFIED) /= 0 then
         return True;
      else
         return False;
      end if;
   end Is_Modified;

   --  ------------------------------
   --  Set the file as modified.
   --  ------------------------------
   procedure Set_Modified (Element : in File_Type) is
   begin
      Element.Status := Element.Status or FILE_MODIFIED;
   end Set_Modified;

   --  ------------------------------
   --  Set the SHA1 signature that was computed for this file.
   --  If the computed signature is different from the current signature,
   --  the FILE_MODIFIED flag is set on the file.  The FILE_HAS_SHA1 flag
   --  is set on the file.
   --  ------------------------------
   procedure Set_Signature (Element   : in File_Type;
                            Signature : in Util.Encoders.SHA1.Hash_Array) is
      use type Util.Encoders.SHA1.Hash_Array;
   begin
      if (Element.Status and FILE_HAS_SHA1) /= 0 and then Element.SHA1 /= Signature then
         Element.Status := Element.Status or FILE_MODIFIED;
      end if;
      Element.Status := Element.Status or FILE_HAS_SHA1;
      Element.SHA1   := Signature;
   end Set_Signature;

   --  ------------------------------
   --  Set the file size.  If the new size is different, the FILE_MODIFIED
   --  flag is set on the file.
   --  ------------------------------
   procedure Set_Size (Element : in File_Type;
                       Size    : in File_Size) is
   begin
      if Element.Size /= Size then
         Element.Size := Size;
         Element.Status := Element.Status or FILE_MODIFIED;
      end if;
   end Set_Size;

   --  ------------------------------
   --  Return the path for the file.
   --  ------------------------------
   function Get_Path (Element : in File_Type) return String is
   begin
      if Element.Dir = null then
         return Element.Name;
      else
         return Util.Files.Compose (Get_Path (Element.Dir), Element.Name);
      end if;
   end Get_Path;

   --  ------------------------------
   --  Return the path for the directory.
   --  ------------------------------
   function Get_Path (Element : in Directory_Type) return String is
   begin
      return Ada.Strings.Unbounded.To_String (Element.Path);
   end Get_Path;

   --  ------------------------------
   --  Return the SHA1 signature computed for the file.
   --  ------------------------------
   function Get_SHA1 (Element : in File_Type) return String is
   begin
      return Hex_Encoder.Transform (Element.SHA1);
   end Get_SHA1;

   --  ------------------------------
   --  Add the file with the given name in the container.
   --  ------------------------------
   overriding
   procedure Add_File (Into    : in out Default_Container;
                       Element : in File_Type) is
   begin
      Into.Files.Append (Element);
   end Add_File;

   --  ------------------------------
   --  Add the directory with the given name in the container.
   --  ------------------------------
   overriding
   procedure Add_Directory (Into    : in out Default_Container;
                            Element : in Directory_Type) is
   begin
      Into.Dirs.Append (Element);
   end Add_Directory;

   --  ------------------------------
   --  Create a new file instance with the given name in the container.
   --  ------------------------------
   overriding
   function Create (Into : in Default_Container;
                    Name : in String) return File_Type is
   begin
      return Allocate (Name => Name,
                       Dir  => Into.Current);
   end Create;

   --  ------------------------------
   --  Create a new directory instance with the given name in the container.
   --  ------------------------------
   overriding
   function Create (Into : in Default_Container;
                    Name : in String) return Directory_Type is
   begin
      return Allocate (Name => Name,
                       Dir  => Into.Current);
   end Create;

   --  ------------------------------
   --  Find the file with the given name in this file container.
   --  Returns NO_FILE if the file was not found.
   --  ------------------------------
   overriding
   function Find (From : in Default_Container;
                  Name : in String) return File_Type is
      pragma Unreferenced (From, Name);
   begin
      return NO_FILE;
   end Find;

   --  ------------------------------
   --  Find the directory with the given name in this file container.
   --  Returns NO_DIRECTORY if the directory was not found.
   --  ------------------------------
   overriding
   function Find (From : in Default_Container;
                  Name : in String) return Directory_Type is
      pragma Unreferenced (From, Name);
   begin
      return NO_DIRECTORY;
   end Find;

   --  ------------------------------
   --  Set the directory object associated with the container.
   --  ------------------------------
   procedure Set_Directory (Into      : in out Default_Container;
                            Directory : in Directory_Type) is
   begin
      Into.Current := Directory;
      Into.Files.Clear;
      Into.Dirs.Clear;
   end Set_Directory;

end Babel.Files;

Implement the Set_Directory operation

Implement the Set_Directory operation


-----------------------------------------------------------------------
--  EL.Contexts -- Default contexts for evaluating an expression
--  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 EL.Variables;
with EL.Variables.Default;
package body EL.Contexts.Default is

   --  ------------------------------
   --  Retrieves the ELResolver associated with this ELcontext.
   --  ------------------------------
   overriding
   function Get_Resolver (Context : Default_Context) return ELResolver_Access is
   begin
      return Context.Resolver;
   end Get_Resolver;

   --  ------------------------------
   --  Set the ELResolver associated with this ELcontext.
   --  ------------------------------
   procedure Set_Resolver (Context  : in out Default_Context;
                           Resolver : in ELResolver_Access) is
   begin
      Context.Resolver := Resolver;
   end Set_Resolver;

   --  ------------------------------
   --  Retrieves the VariableMapper associated with this ELContext.
   --  ------------------------------
   overriding
   function Get_Variable_Mapper (Context : Default_Context)
                                 return access EL.Variables.VariableMapper'Class is
   begin
      return Context.Var_Mapper;
   end Get_Variable_Mapper;

   --  ------------------------------
   --  Retrieves the FunctionMapper associated with this ELContext.
   --  The FunctionMapper is only used when parsing an expression.
   --  ------------------------------
   overriding
   function Get_Function_Mapper (Context : Default_Context)
                                 return EL.Functions.Function_Mapper_Access is
   begin
      return Context.Function_Mapper;
   end Get_Function_Mapper;

   --  ------------------------------
   --  Set the function mapper to be used when parsing an expression.
   --  ------------------------------
   overriding
   procedure Set_Function_Mapper (Context : in out Default_Context;
                                  Mapper  : access EL.Functions.Function_Mapper'Class) is
   begin
      Context.Function_Mapper := Mapper.all'Unchecked_Access;
   end Set_Function_Mapper;

   --  ------------------------------
   --  Set the VariableMapper associated with this ELContext.
   --  ------------------------------
   overriding
   procedure Set_Variable_Mapper (Context : in out Default_Context;
                                  Mapper  : access EL.Variables.VariableMapper'Class) is
      use EL.Variables;
   begin
      if Mapper = null then
         Context.Var_Mapper := null;
      else
         Context.Var_Mapper := Mapper.all'Unchecked_Access;
      end if;
   end Set_Variable_Mapper;

   procedure Set_Variable (Context : in out Default_Context;
                           Name    : in String;
                           Value   : access EL.Beans.Readonly_Bean'Class) is
      use EL.Variables;
   begin
      if Context.Var_Mapper = null then
         Context.Var_Mapper := new EL.Variables.Default.Default_Variable_Mapper;
      end if;
      Context.Var_Mapper.Bind (Name, EL.Objects.To_Object (Value));
   end Set_Variable;

   --  ------------------------------
   --  Get the value associated with a base object and a given property.
   --  ------------------------------
   overriding
   function Get_Value (Resolver : Default_ELResolver;
                       Context  : ELContext'Class;
                       Base     : access EL.Beans.Readonly_Bean'Class;
                       Name     : Unbounded_String) return Object is
      pragma Unreferenced (Context);

      R : Object;
   begin
      if Base /= null then
         return Base.Get_Value (To_String (Name));
      end if;

      declare
         Pos : constant Bean_Maps.Cursor := Resolver.Map.Find (Name);
      begin
         if Bean_Maps.Has_Element (Pos) then
            return Bean_Maps.Element (Pos);
         end if;
      end;
      return R;
   end Get_Value;

   --  ------------------------------
   --  Set the value associated with a base object and a given property.
   --  ------------------------------
   overriding
   procedure Set_Value (Resolver : in Default_ELResolver;
                        Context  : in ELContext'Class;
                        Base     : access EL.Beans.Bean'Class;
                        Name     : in Unbounded_String;
                        Value    : in Object) is
   begin
      null;
   end Set_Value;

   --  ------------------------------
   --  Register the value under the given name.
   --  ------------------------------
   procedure Register (Resolver : in out Default_ELResolver;
                       Name     : in Unbounded_String;
                       Value    : access EL.Beans.Readonly_Bean'Class) is
   begin
      Resolver.Register (Name, To_Object (Value));
   end Register;

   --  ------------------------------
   --  Register the value under the given name.
   --  ------------------------------
   procedure Register (Resolver : in out Default_ELResolver;
                       Name     : in Unbounded_String;
                       Value    : in EL.Objects.Object) is
   begin
      Bean_Maps.Include (Resolver.Map, Name, Value);
   end Register;

end EL.Contexts.Default;

-----------------------------------------------------------------------
--  EL.Contexts -- Default contexts for evaluating an expression
--  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 EL.Variables;
with EL.Variables.Default;
package body EL.Contexts.Default is

   --  ------------------------------
   --  Retrieves the ELResolver associated with this ELcontext.
   --  ------------------------------
   overriding
   function Get_Resolver (Context : Default_Context) return ELResolver_Access is
   begin
      return Context.Resolver;
   end Get_Resolver;

   --  ------------------------------
   --  Set the ELResolver associated with this ELcontext.
   --  ------------------------------
   procedure Set_Resolver (Context  : in out Default_Context;
                           Resolver : in ELResolver_Access) is
   begin
      Context.Resolver := Resolver;
   end Set_Resolver;

   --  ------------------------------
   --  Retrieves the VariableMapper associated with this ELContext.
   --  ------------------------------
   overriding
   function Get_Variable_Mapper (Context : Default_Context)
                                 return access EL.Variables.VariableMapper'Class is
   begin
      return Context.Var_Mapper;
   end Get_Variable_Mapper;

   --  ------------------------------
   --  Retrieves the FunctionMapper associated with this ELContext.
   --  The FunctionMapper is only used when parsing an expression.
   --  ------------------------------
   overriding
   function Get_Function_Mapper (Context : Default_Context)
                                 return EL.Functions.Function_Mapper_Access is
   begin
      return Context.Function_Mapper;
   end Get_Function_Mapper;

   --  ------------------------------
   --  Set the function mapper to be used when parsing an expression.
   --  ------------------------------
   overriding
   procedure Set_Function_Mapper (Context : in out Default_Context;
                                  Mapper  : access EL.Functions.Function_Mapper'Class) is
   begin
      if Mapper = null then
         Context.Function_Mapper := null;
      else
         Context.Function_Mapper := Mapper.all'Unchecked_Access;
      end if;
   end Set_Function_Mapper;

   --  ------------------------------
   --  Set the VariableMapper associated with this ELContext.
   --  ------------------------------
   overriding
   procedure Set_Variable_Mapper (Context : in out Default_Context;
                                  Mapper  : access EL.Variables.VariableMapper'Class) is
      use EL.Variables;
   begin
      if Mapper = null then
         Context.Var_Mapper := null;
      else
         Context.Var_Mapper := Mapper.all'Unchecked_Access;
      end if;
   end Set_Variable_Mapper;

   procedure Set_Variable (Context : in out Default_Context;
                           Name    : in String;
                           Value   : access EL.Beans.Readonly_Bean'Class) is
      use EL.Variables;
   begin
      if Context.Var_Mapper = null then
         Context.Var_Mapper := new EL.Variables.Default.Default_Variable_Mapper;
      end if;
      Context.Var_Mapper.Bind (Name, EL.Objects.To_Object (Value));
   end Set_Variable;

   --  ------------------------------
   --  Get the value associated with a base object and a given property.
   --  ------------------------------
   overriding
   function Get_Value (Resolver : Default_ELResolver;
                       Context  : ELContext'Class;
                       Base     : access EL.Beans.Readonly_Bean'Class;
                       Name     : Unbounded_String) return Object is
      pragma Unreferenced (Context);

      R : Object;
   begin
      if Base /= null then
         return Base.Get_Value (To_String (Name));
      end if;

      declare
         Pos : constant Bean_Maps.Cursor := Resolver.Map.Find (Name);
      begin
         if Bean_Maps.Has_Element (Pos) then
            return Bean_Maps.Element (Pos);
         end if;
      end;
      return R;
   end Get_Value;

   --  ------------------------------
   --  Set the value associated with a base object and a given property.
   --  ------------------------------
   overriding
   procedure Set_Value (Resolver : in Default_ELResolver;
                        Context  : in ELContext'Class;
                        Base     : access EL.Beans.Bean'Class;
                        Name     : in Unbounded_String;
                        Value    : in Object) is
   begin
      null;
   end Set_Value;

   --  ------------------------------
   --  Register the value under the given name.
   --  ------------------------------
   procedure Register (Resolver : in out Default_ELResolver;
                       Name     : in Unbounded_String;
                       Value    : access EL.Beans.Readonly_Bean'Class) is
   begin
      Resolver.Register (Name, To_Object (Value));
   end Register;

   --  ------------------------------
   --  Register the value under the given name.
   --  ------------------------------
   procedure Register (Resolver : in out Default_ELResolver;
                       Name     : in Unbounded_String;
                       Value    : in EL.Objects.Object) is
   begin
      Bean_Maps.Include (Resolver.Map, Name, Value);
   end Register;

end EL.Contexts.Default;

Fix Set_Variable_Mapper to allow to set a null function mapper.


-----------------------------------------------------------------------
--  util-http-rest -- REST API support
--  Copyright (C) 2012, 2013, 2015 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.Serialize.IO.JSON;
package body Util.Http.Rest is

   --  -----------------------
   --  Execute an HTTP GET operation using the Http client on the given URI.
   --  Upon successful reception of the response, parse the JSON result and populate the
   --  serialization context associated with the parser.
   --  -----------------------
   procedure Get (Http   : in out Client;
                  URI    : in String;
                  Parser : in out Util.Serialize.IO.Parser'Class) is
      Response : Util.Http.Clients.Response;
   begin
      Http.Get (URI, Response);
      Http.Status := Response.Get_Status;
      declare
         Content      : constant String := Response.Get_Body;
      begin
         Parser.Parse_String (Content);
      end;
   end Get;

   --  -----------------------
   --  Execute an HTTP GET operation on the given URI and parse the JSON response
   --  into the target object refered to by Into by using the mapping described
   --  in Mapping.
   --  -----------------------
   procedure Rest_Get (URI     : in String;
                       Mapping : in Util.Serialize.Mappers.Mapper_Access;
                       Path    : in String := "";
                       Into    : in Element_Mapper.Element_Type_Access) is
      Http     : Util.Http.Rest.Client;
      Reader   : Util.Serialize.IO.JSON.Parser;
   begin
      Reader.Add_Mapping (Path, Mapping.all'Access);
      Element_Mapper.Set_Context (Reader, Into);
      Http.Get (URI, Reader);
   end Rest_Get;

end Util.Http.Rest;

-----------------------------------------------------------------------
--  util-http-rest -- REST API support
--  Copyright (C) 2012, 2013, 2015 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.Serialize.IO.JSON;
with Util.Serialize.Mappers;
package body Util.Http.Rest is

   --  -----------------------
   --  Execute an HTTP GET operation using the Http client on the given URI.
   --  Upon successful reception of the response, parse the JSON result and populate the
   --  serialization context associated with the parser.
   --  -----------------------
   procedure Get (Http   : in out Client;
                  URI    : in String;
                  Parser : in out Util.Serialize.IO.Parser'Class;
                  Sink   : in out Util.Serialize.IO.Reader'Class) is
      Response : Util.Http.Clients.Response;
   begin
      Http.Get (URI, Response);
      Http.Status := Response.Get_Status;
      declare
         Content      : constant String := Response.Get_Body;
      begin
         Parser.Parse_String (Content, Sink);
      end;
   end Get;

   --  -----------------------
   --  Execute an HTTP GET operation on the given URI and parse the JSON response
   --  into the target object refered to by Into by using the mapping described
   --  in Mapping.
   --  -----------------------
   procedure Rest_Get (URI     : in String;
                       Mapping : in Util.Serialize.Mappers.Mapper_Access;
                       Path    : in String := "";
                       Into    : in Element_Mapper.Element_Type_Access) is
      Http     : Util.Http.Rest.Client;
      Reader   : Util.Serialize.IO.JSON.Parser;
      Mapper   : Util.Serialize.Mappers.Processing;
   begin
      Mapper.Add_Mapping (Path, Mapping.all'Access);
      Element_Mapper.Set_Context (Mapper, Into);
      Http.Get (URI, Reader, Mapper);
   end Rest_Get;

end Util.Http.Rest;

Add parameter to the Get procedure Update the Rest procedure to use the new parser/mapper interfaces


--  This file is covered by the Internet Software Consortium (ISC) License
--  Reference: ../License.txt

package Definitions is

   pragma Pure;

   raven_version_major : constant String := "1";
   raven_version_minor : constant String := "12";
   copyright_years     : constant String := "2015-2018";

   raven_tool        : constant String := "ravenadm";
   variant_standard  : constant String := "standard";
   contact_nobody    : constant String := "nobody";
   contact_automaton : constant String := "automaton";
   dlgroup_main      : constant String := "main";
   dlgroup_none      : constant String := "none";
   options_none      : constant String := "none";
   options_all       : constant String := "all";
   broken_all        : constant String := "all";
   boolean_yes       : constant String := "yes";
   homepage_none     : constant String := "none";
   spkg_complete     : constant String := "complete";
   spkg_docs         : constant String := "docs";
   spkg_examples     : constant String := "examples";
   ports_default     : constant String := "floating";
   default_ssl       : constant String := "libressl";
   default_mysql     : constant String := "oracle-5.7";
   default_lua       : constant String := "5.3";
   default_perl      : constant String := "5.28";
   default_pgsql     : constant String := "10";
   default_php       : constant String := "7.2";
   default_python3   : constant String := "3.7";
   default_ruby      : constant String := "2.5";
   default_tcltk     : constant String := "8.6";
   default_firebird  : constant String := "2.5";
   default_compiler  : constant String := "gcc8";
   compiler_version  : constant String := "8.2.0";
   previous_compiler : constant String := "7.3.0";
   binutils_version  : constant String := "2.31.1";
   previous_binutils : constant String := "2.30";
   arc_ext           : constant String := ".tzst";
   jobs_per_cpu      : constant := 2;

   type supported_opsys is (dragonfly, freebsd, netbsd, openbsd, sunos, linux, macos);
   type supported_arch  is (x86_64, i386, aarch64);

   type cpu_range is range 1 .. 32;
   type scanners  is range cpu_range'First .. cpu_range'Last;
   type builders  is range cpu_range'First .. cpu_range'Last * jobs_per_cpu;
   type count_type is (total, success, failure, ignored, skipped);

   --  Modify following with post-patch sed accordingly
   platform_type  : constant supported_opsys := dragonfly;
   host_localbase : constant String := "/raven";
   raven_var      : constant String := "/var/ravenports";
   host_pkg8      : constant String := host_localbase & "/sbin/pkg-static";
   ravenexec      : constant String := host_localbase & "/libexec/ravenexec";

end Definitions;

--  This file is covered by the Internet Software Consortium (ISC) License
--  Reference: ../License.txt

package Definitions is

   pragma Pure;

   raven_version_major : constant String := "1";
   raven_version_minor : constant String := "13";
   copyright_years     : constant String := "2015-2018";

   raven_tool        : constant String := "ravenadm";
   variant_standard  : constant String := "standard";
   contact_nobody    : constant String := "nobody";
   contact_automaton : constant String := "automaton";
   dlgroup_main      : constant String := "main";
   dlgroup_none      : constant String := "none";
   options_none      : constant String := "none";
   options_all       : constant String := "all";
   broken_all        : constant String := "all";
   boolean_yes       : constant String := "yes";
   homepage_none     : constant String := "none";
   spkg_complete     : constant String := "complete";
   spkg_docs         : constant String := "docs";
   spkg_examples     : constant String := "examples";
   ports_default     : constant String := "floating";
   default_ssl       : constant String := "libressl";
   default_mysql     : constant String := "oracle-5.7";
   default_lua       : constant String := "5.3";
   default_perl      : constant String := "5.28";
   default_pgsql     : constant String := "10";
   default_php       : constant String := "7.2";
   default_python3   : constant String := "3.7";
   default_ruby      : constant String := "2.5";
   default_tcltk     : constant String := "8.6";
   default_firebird  : constant String := "2.5";
   default_compiler  : constant String := "gcc8";
   compiler_version  : constant String := "8.2.0";
   previous_compiler : constant String := "7.3.0";
   binutils_version  : constant String := "2.31.1";
   previous_binutils : constant String := "2.30";
   arc_ext           : constant String := ".tzst";
   jobs_per_cpu      : constant := 2;

   type supported_opsys is (dragonfly, freebsd, netbsd, openbsd, sunos, linux, macos);
   type supported_arch  is (x86_64, i386, aarch64);

   type cpu_range is range 1 .. 32;
   type scanners  is range cpu_range'First .. cpu_range'Last;
   type builders  is range cpu_range'First .. cpu_range'Last * jobs_per_cpu;
   type count_type is (total, success, failure, ignored, skipped);

   --  Modify following with post-patch sed accordingly
   platform_type  : constant supported_opsys := dragonfly;
   host_localbase : constant String := "/raven";
   raven_var      : constant String := "/var/ravenports";
   host_pkg8      : constant String := host_localbase & "/sbin/pkg-static";
   ravenexec      : constant String := host_localbase & "/libexec/ravenexec";

end Definitions;

Bump version (not done yet though)

Bump version (not done yet though)


--  This file is covered by the Internet Software Consortium (ISC) License
--  Reference: ../License.txt

package Definitions is

   pragma Pure;

   synth_version_major : constant String := "1";
   synth_version_minor : constant String := "32";
   copyright_years     : constant String := "2015-2016";
   host_localbase      : constant String := "/usr/local";
   host_pkg8           : constant String := host_localbase & "/sbin/pkg";
   jobs_per_cpu        : constant := 2;

   type cpu_range is range 1 .. 32;
   type scanners  is range cpu_range'First .. cpu_range'Last;
   type builders  is range cpu_range'First .. cpu_range'Last * jobs_per_cpu;

end Definitions;

--  This file is covered by the Internet Software Consortium (ISC) License
--  Reference: ../License.txt

package Definitions is

   pragma Pure;

   synth_version_major : constant String := "1";
   synth_version_minor : constant String := "33";
   copyright_years     : constant String := "2015-2016";
   host_localbase      : constant String := "/usr/local";
   host_pkg8           : constant String := host_localbase & "/sbin/pkg";
   jobs_per_cpu        : constant := 2;

   type cpu_range is range 1 .. 32;
   type scanners  is range cpu_range'First .. cpu_range'Last;
   type builders  is range cpu_range'First .. cpu_range'Last * jobs_per_cpu;

end Definitions;

Set to version 1.33

Set to version 1.33


-----------------------------------------------------------------------
--  util-beans -- Interface Definition with Getter and Setters
--  Copyright (C) 2009, 2010, 2018, 2019 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.
-----------------------------------------------------------------------

--  = Ada Beans =
--  A [Java Bean](http://en.wikipedia.org/wiki/JavaBean) is an object that
--  allows to access its properties through getters and setters. Java Beans
--  rely on the use of Java introspection to discover the Java Bean object properties.
--
--  An Ada Bean has some similarities with the Java Bean as it tries to expose
--  an object through a set of common interfaces.  Since Ada does not have introspection,
--  some developer work is necessary. The Ada Bean framework consists of:
--
--    * An `Object` concrete type that allows to hold any data type such
--      as boolean, integer, floats, strings, dates and Ada bean objects.
--    * A `Bean` interface that exposes a `Get_Value` and `Set_Value`
--      operation through which the object properties can be obtained and modified.
--    * A `Method_Bean` interface that exposes a set of method bindings
--      that gives access to the methods provided by the Ada Bean object.
--
--  The benefit of Ada beans comes when you need to get a value or invoke
--  a method on an object but you don't know at compile time the object or method.
--  That step being done later through some external configuration or presentation file.
--
--  The Ada Bean framework is the basis for the implementation of
--  Ada Server Faces and Ada EL.  It allows the presentation layer to
--  access information provided by Ada beans.
--
--  To use the packages described here, use the following GNAT project:
--
--    with "utilada_base";
--
--  @include util-beans-objects.ads
--  @include util-beans-objects-datasets.ads
--  @include util-beans-basic.ads
package Util.Beans is

   pragma Preelaborate;

end Util.Beans;

-----------------------------------------------------------------------
--  util-beans -- Interface Definition with Getter and Setters
--  Copyright (C) 2009, 2010, 2018, 2019, 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.
-----------------------------------------------------------------------

--  = Ada Beans =
--  A [Java Bean](http://en.wikipedia.org/wiki/JavaBean) is an object that
--  allows to access its properties through getters and setters. Java Beans
--  rely on the use of Java introspection to discover the Java Bean object properties.
--
--  An Ada Bean has some similarities with the Java Bean as it tries to expose
--  an object through a set of common interfaces.  Since Ada does not have introspection,
--  some developer work is necessary. The Ada Bean framework consists of:
--
--    * An `Object` concrete type that allows to hold any data type such
--      as boolean, integer, floats, strings, dates and Ada bean objects.
--    * A `Bean` interface that exposes a `Get_Value` and `Set_Value`
--      operation through which the object properties can be obtained and modified.
--    * A `Method_Bean` interface that exposes a set of method bindings
--      that gives access to the methods provided by the Ada Bean object.
--
--  The benefit of Ada beans comes when you need to get a value or invoke
--  a method on an object but you don't know at compile time the object or method.
--  That step being done later through some external configuration or presentation file.
--
--  The Ada Bean framework is the basis for the implementation of
--  Ada Server Faces and Ada EL.  It allows the presentation layer to
--  access information provided by Ada beans.
--
--  To use the packages described here, use the following GNAT project:
--
--    with "utilada_base";
--
--  @include util-beans-objects.ads
--  @include util-beans-objects-maps.ads
--  @include util-beans-objects-vectors.ads
--  @include util-beans-objects-datasets.ads
--  @include util-beans-basic.ads
package Util.Beans is

   pragma Preelaborate;

end Util.Beans;

Add some documentation

Add some documentation


-----------------------------------------------------------------------
--  wiki-render -- Wiki renderer
--  Copyright (C) 2015 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.Strings.Wide_Wide_Unbounded;
package Wiki.Render is

   pragma Preelaborate;

   use Ada.Strings.Wide_Wide_Unbounded;

   type Link_Renderer is limited interface;
   type Link_Renderer_Access is access all Link_Renderer'Class;

   --  Get the image link that must be rendered from the wiki image link.
   procedure Make_Image_Link (Renderer : in Link_Renderer;
                              Link     : in Unbounded_Wide_Wide_String;
                              URI      : out Unbounded_Wide_Wide_String;
                              Width    : out Natural;
                              Height   : out Natural) is abstract;

   --  Get the page link that must be rendered from the wiki page link.
   procedure Make_Page_Link (Renderer : in Link_Renderer;
                             Link     : in Unbounded_Wide_Wide_String;
                             URI      : out Unbounded_Wide_Wide_String;
                             Exists   : out Boolean) is abstract;

   type Default_Link_Renderer is new Link_Renderer with null record;

   --  Get the image link that must be rendered from the wiki image link.
   overriding
   procedure Make_Image_Link (Renderer : in Default_Link_Renderer;
                              Link     : in Unbounded_Wide_Wide_String;
                              URI      : out Unbounded_Wide_Wide_String;
                              Width    : out Natural;
                              Height   : out Natural);

   --  Get the page link that must be rendered from the wiki page link.
   overriding
   procedure Make_Page_Link (Renderer : in Default_Link_Renderer;
                             Link     : in Unbounded_Wide_Wide_String;
                             URI      : out Unbounded_Wide_Wide_String;
                             Exists   : out Boolean);

end Wiki.Render;

-----------------------------------------------------------------------
--  wiki-render -- Wiki renderer
--  Copyright (C) 2015 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.Strings.Wide_Wide_Unbounded;
with Wiki.Documents;
with Wiki.Attributes;
with Wiki.Nodes;
package Wiki.Render is

   pragma Preelaborate;

   use Ada.Strings.Wide_Wide_Unbounded;

   type Link_Renderer is limited interface;
   type Link_Renderer_Access is access all Link_Renderer'Class;

   --  Get the image link that must be rendered from the wiki image link.
   procedure Make_Image_Link (Renderer : in Link_Renderer;
                              Link     : in Unbounded_Wide_Wide_String;
                              URI      : out Unbounded_Wide_Wide_String;
                              Width    : out Natural;
                              Height   : out Natural) is abstract;

   --  Get the page link that must be rendered from the wiki page link.
   procedure Make_Page_Link (Renderer : in Link_Renderer;
                             Link     : in Unbounded_Wide_Wide_String;
                             URI      : out Unbounded_Wide_Wide_String;
                             Exists   : out Boolean) is abstract;

   type Default_Link_Renderer is new Link_Renderer with null record;

   --  Get the image link that must be rendered from the wiki image link.
   overriding
   procedure Make_Image_Link (Renderer : in Default_Link_Renderer;
                              Link     : in Unbounded_Wide_Wide_String;
                              URI      : out Unbounded_Wide_Wide_String;
                              Width    : out Natural;
                              Height   : out Natural);

   --  Get the page link that must be rendered from the wiki page link.
   overriding
   procedure Make_Page_Link (Renderer : in Default_Link_Renderer;
                             Link     : in Unbounded_Wide_Wide_String;
                             URI      : out Unbounded_Wide_Wide_String;
                             Exists   : out Boolean);

   --  ------------------------------
   --  Document renderer
   --  ------------------------------
   type Renderer is limited interface;
   type Renderer_Access is access all Renderer'Class;

   --  Render the node instance from the document.
   procedure Render (Engine : in out Renderer;
                     Doc    : in Wiki.Nodes.Document;
                     Node   : in Wiki.Nodes.Node_Type) is abstract;

   --  Finish the rendering after complete wiki document nodes are rendered.
   procedure Finish (Document : in out Renderer) is abstract;

end Wiki.Render;

Declare the Renderer interface with the Render and Finish operations