--  SPDX-License-Identifier: Apache-2.0
--
--  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 Ada.Strings.Unbounded;

with Glfw.Input.Joysticks;

with Orka.Inputs.Joysticks.Default;
with Orka.Inputs.Joysticks.Gamepads;

package body Orka.Inputs.GLFW is

   overriding
   procedure Set_Cursor_Mode
     (Object  : in out GLFW_Pointer_Input;
      Mode    : Pointers.Default.Cursor_Mode)
   is
      package Mouse renames Standard.Glfw.Input.Mouse;

      use all type Pointers.Default.Cursor_Mode;
   begin
      case Mode is
         when Normal =>
            Object.Window.Set_Cursor_Mode (Mouse.Normal);
         when Hidden =>
            Object.Window.Set_Cursor_Mode (Mouse.Hidden);
         when Disabled =>
            Object.Window.Set_Cursor_Mode (Mouse.Disabled);
      end case;
   end Set_Cursor_Mode;

   procedure Set_Button_State
     (Object  : in out GLFW_Pointer_Input;
      Subject : Standard.Glfw.Input.Mouse.Button;
      State   : Standard.Glfw.Input.Button_State)
   is
      use Standard.Glfw.Input;
      use all type Inputs.Pointers.Button;
      use all type Inputs.Pointers.Button_State;

      Pointer_State : constant Pointers.Button_State
        := (case State is
              when Pressed  => Pressed,
              when Released => Released);
   begin
      case Subject is
         when Mouse.Left_Button =>
            Object.Set_Button_State (Left, Pointer_State);
         when Mouse.Right_Button =>
            Object.Set_Button_State (Right, Pointer_State);
         when Mouse.Middle_Button =>
            Object.Set_Button_State (Middle, Pointer_State);
         when others =>
            raise Program_Error with "Invalid mouse button";
      end case;
   end Set_Button_State;

   procedure Set_Window
     (Object  : in out GLFW_Pointer_Input;
      Window  : Standard.Glfw.Windows.Window_Reference) is
   begin
      Object.Window := Window;
   end Set_Window;

   function Create_Pointer_Input return Inputs.Pointers.Pointer_Input_Ptr is
   begin
      return new GLFW_Pointer_Input'
        (Pointers.Default.Abstract_Pointer_Input with others => <>);
   end Create_Pointer_Input;

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

   use Inputs.Joysticks;

   procedure Copy_Buttons
     (From :     Standard.Glfw.Input.Joysticks.Joystick_Button_States;
      To   : out Inputs.Joysticks.Button_States)
   is
      use all type Standard.Glfw.Input.Joysticks.Joystick_Button_State;
   begin
      for Index in From'Range loop
         To (Index) := (case From (Index) is
                          when Pressed  => Pressed,
                          when Released => Released);
      end loop;
   end Copy_Buttons;

   procedure Copy_Axes
     (From :     Standard.Glfw.Input.Joysticks.Axis_Positions;
      To   : out Inputs.Joysticks.Axis_Positions) is
   begin
      for Index in From'Range loop
         To (Index) := Axis_Position (From (Index));
      end loop;
   end Copy_Axes;

   procedure Copy_Hats
     (From :     Standard.Glfw.Input.Joysticks.Joystick_Hat_States;
      To   : out Inputs.Joysticks.Hat_States)
   is
      use all type Standard.Glfw.Input.Joysticks.Joystick_Hat_State;
   begin
      for Index in From'Range loop
         To (Index) := (case From (Index) is
                          when Centered   => Centered,
                          when Up         => Up,
                          when Right      => Right,
                          when Right_Up   => Right_Up,
                          when Down       => Down,
                          when Right_Down => Right_Down,
                          when Left       => Left,
                          when Left_Up    => Left_Up,
                          when Left_Down  => Left_Down);
      end loop;
   end Copy_Hats;

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

   package SU renames Ada.Strings.Unbounded;

   type Abstract_GLFW_Joystick_Input is abstract
     new Joysticks.Default.Abstract_Joystick_Input with
   record
      Joystick   : Standard.Glfw.Input.Joysticks.Joystick;
      Name, GUID : SU.Unbounded_String;
      Present    : Boolean;
   end record;

   overriding
   function Is_Present (Object : Abstract_GLFW_Joystick_Input) return Boolean is
     (Object.Present and then Object.Joystick.Is_Present);

   overriding
   function Name (Object : Abstract_GLFW_Joystick_Input) return String is
     (SU.To_String (Object.Name));

   overriding
   function GUID (Object : Abstract_GLFW_Joystick_Input) return String is
     (SU.To_String (Object.GUID));

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

   type GLFW_Gamepad_Input  is new Abstract_GLFW_Joystick_Input with null record;

   overriding
   function Is_Gamepad (Object : GLFW_Gamepad_Input) return Boolean is (True);

   overriding
   function State (Object : in out GLFW_Gamepad_Input) return Inputs.Joysticks.Joystick_State is
      use type SU.Unbounded_String;
   begin
      if not Object.Joystick.Is_Present then
         Object.Present := False;
         raise Disconnected_Error with Object.Joystick.Index'Image & " is not connected";
      elsif Object.Joystick.Joystick_GUID = Object.GUID then
         Object.Present := True;
      end if;

      declare
         State : constant Standard.Glfw.Input.Joysticks.Joystick_Gamepad_State :=
           Object.Joystick.Gamepad_State;
      begin
         return Result : Joystick_State
           (Button_Count => State.Buttons'Length,
            Axis_Count   => State.Axes'Length,
            Hat_Count    => 0)
         do
            Copy_Buttons (State.Buttons, Result.Buttons);
            Copy_Axes (State.Axes, Result.Axes);

            Inputs.Joysticks.Gamepads.Normalize_Axes (Result.Axes);
         end return;
      end;
   end State;

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

   type GLFW_Joystick_Input is new Abstract_GLFW_Joystick_Input with null record;

   overriding
   function Is_Gamepad (Object : GLFW_Joystick_Input) return Boolean is (False);

   overriding
   function State (Object : in out GLFW_Joystick_Input) return Inputs.Joysticks.Joystick_State is
      use type SU.Unbounded_String;
   begin
      if not Object.Joystick.Is_Present then
         Object.Present := False;
         raise Disconnected_Error with Object.Joystick.Index'Image & " is not connected";
      elsif Object.Joystick.Joystick_GUID = Object.GUID then
         Object.Present := True;
      end if;

      declare
         Buttons : constant Standard.Glfw.Input.Joysticks.Joystick_Button_States :=
           Object.Joystick.Button_States;
         Axes : constant Standard.Glfw.Input.Joysticks.Axis_Positions :=
           Object.Joystick.Positions;
         Hats : constant Standard.Glfw.Input.Joysticks.Joystick_Hat_States :=
           Object.Joystick.Hat_States;
      begin
         return Result : Joystick_State
           (Button_Count => Buttons'Length,
            Axis_Count   => Axes'Length,
            Hat_Count    => Hats'Length)
         do
            Copy_Buttons (Buttons, Result.Buttons);
            Copy_Axes (Axes, Result.Axes);
            Copy_Hats (Hats, Result.Hats);
         end return;
      end;
   end State;

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

   function Create_Joystick_Input
     (Index : Standard.Glfw.Input.Joysticks.Joystick_Index)
     return Inputs.Joysticks.Joystick_Input_Ptr
   is
      Joystick : constant Standard.Glfw.Input.Joysticks.Joystick :=
        Standard.Glfw.Input.Joysticks.Get_Joystick (Index);
   begin
      if not Joystick.Is_Present then
         raise Disconnected_Error with Index'Image & " is not connected";
      end if;

      if Joystick.Is_Gamepad then
         return new GLFW_Gamepad_Input'
           (Joysticks.Default.Abstract_Joystick_Input with Joystick => Joystick,
            Present  => True,
            Name => SU.To_Unbounded_String (Joystick.Gamepad_Name),
            GUID => SU.To_Unbounded_String (Joystick.Joystick_GUID));
      else
         return new GLFW_Joystick_Input'
           (Joysticks.Default.Abstract_Joystick_Input with Joystick => Joystick,
            Present  => True,
            Name => SU.To_Unbounded_String (Joystick.Gamepad_Name),
            GUID => SU.To_Unbounded_String (Joystick.Joystick_GUID));
      end if;
   end Create_Joystick_Input;

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

   subtype Slot_Index is Standard.Glfw.Input.Joysticks.Joystick_Index range 1 .. 16;

   type Boolean_Array is array (Slot_Index) of Boolean;

   protected type Joystick_Manager is new Inputs.Joysticks.Joystick_Manager with
      procedure Set_Present
        (Index : Slot_Index;
         Value : Boolean);

      procedure Initialize
        with Post => Is_Initialized;

      function Is_Initialized return Boolean;

      overriding
      procedure Acquire (Joystick : out Inputs.Joysticks.Joystick_Input_Access);

      overriding
      procedure Release (Joystick : Inputs.Joysticks.Joystick_Input_Access);
   private
      Acquired, Present : Boolean_Array := (others => False);
      Initialized : Boolean := False;
   end Joystick_Manager;

   package Joysticks renames Standard.Glfw.Input.Joysticks;

   protected body Joystick_Manager is
      procedure Set_Present
        (Index : Slot_Index;
         Value : Boolean) is
      begin
         Present (Index) := Value;
      end Set_Present;

      procedure Initialize is
      begin
         for Index in Present'Range loop
            Present (Index) := Joysticks.Get_Joystick (Index).Is_Present;
         end loop;

         Initialized := True;
      end Initialize;

      function Is_Initialized return Boolean is (Initialized);

      procedure Acquire (Joystick : out Inputs.Joysticks.Joystick_Input_Access) is
      begin
         for Index in Acquired'Range loop
            if not Acquired (Index) and Present (Index) then
               Joystick := Create_Joystick_Input (Index);
               Acquired (Index) := True;
               return;
            end if;
         end loop;

         Joystick := null;
      end Acquire;

      procedure Release (Joystick : Inputs.Joysticks.Joystick_Input_Access) is
         Index : constant Slot_Index :=
           Abstract_GLFW_Joystick_Input (Joystick.all).Joystick.Index;
      begin
         if not Acquired (Index) then
            raise Program_Error;
         end if;

         Acquired (Index) := False;
      end Release;
   end Joystick_Manager;

   Default_Manager : aliased Joystick_Manager;

   procedure On_Connected
     (Source : Joysticks.Joystick;
      State  : Joysticks.Connect_State)
   is
      use type Joysticks.Connect_State;
   begin
      Default_Manager.Set_Present (Source.Index, State = Joysticks.Connected);
   end On_Connected;

   function Create_Joystick_Manager return Inputs.Joysticks.Joystick_Manager_Ptr is
   begin
      if not Default_Manager.Is_Initialized then
         Default_Manager.Initialize;
         Joysticks.Set_Callback (On_Connected'Access);
      end if;

      return Default_Manager'Access;
   end Create_Joystick_Manager;

end Orka.Inputs.GLFW;

--  SPDX-License-Identifier: Apache-2.0
--
--  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 Ada.Strings.Unbounded;

with Glfw.Input.Joysticks;

with Orka.Inputs.Joysticks.Default;
with Orka.Inputs.Joysticks.Gamepads;

package body Orka.Inputs.GLFW is

   overriding
   procedure Set_Cursor_Mode
     (Object  : in out GLFW_Pointer_Input;
      Mode    : Pointers.Default.Cursor_Mode)
   is
      package Mouse renames Standard.Glfw.Input.Mouse;

      use all type Pointers.Default.Cursor_Mode;
   begin
      case Mode is
         when Normal =>
            Object.Window.Set_Cursor_Mode (Mouse.Normal);
         when Hidden =>
            Object.Window.Set_Cursor_Mode (Mouse.Hidden);
         when Disabled =>
            Object.Window.Set_Cursor_Mode (Mouse.Disabled);
      end case;
   end Set_Cursor_Mode;

   procedure Set_Button_State
     (Object  : in out GLFW_Pointer_Input;
      Subject : Standard.Glfw.Input.Mouse.Button;
      State   : Standard.Glfw.Input.Button_State)
   is
      use Standard.Glfw.Input;
      use all type Inputs.Pointers.Button;
      use all type Inputs.Pointers.Button_State;

      Pointer_State : constant Pointers.Button_State
        := (case State is
              when Pressed  => Pressed,
              when Released => Released);
   begin
      case Subject is
         when Mouse.Left_Button =>
            Object.Set_Button_State (Left, Pointer_State);
         when Mouse.Right_Button =>
            Object.Set_Button_State (Right, Pointer_State);
         when Mouse.Middle_Button =>
            Object.Set_Button_State (Middle, Pointer_State);
         when others =>
            raise Program_Error with "Invalid mouse button";
      end case;
   end Set_Button_State;

   procedure Set_Window
     (Object  : in out GLFW_Pointer_Input;
      Window  : Standard.Glfw.Windows.Window_Reference) is
   begin
      Object.Window := Window;
   end Set_Window;

   function Create_Pointer_Input return Inputs.Pointers.Pointer_Input_Ptr is
   begin
      return new GLFW_Pointer_Input'
        (Pointers.Default.Abstract_Pointer_Input with others => <>);
   end Create_Pointer_Input;

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

   use Inputs.Joysticks;

   procedure Copy_Buttons
     (From :     Standard.Glfw.Input.Joysticks.Joystick_Button_States;
      To   : out Inputs.Joysticks.Button_States)
   is
      use all type Standard.Glfw.Input.Joysticks.Joystick_Button_State;
   begin
      for Index in From'Range loop
         To (Index) := (case From (Index) is
                          when Pressed  => Pressed,
                          when Released => Released);
      end loop;
   end Copy_Buttons;

   procedure Copy_Axes
     (From :     Standard.Glfw.Input.Joysticks.Axis_Positions;
      To   : out Inputs.Joysticks.Axis_Positions) is
   begin
      for Index in From'Range loop
         To (Index) := Axis_Position (From (Index));
      end loop;
   end Copy_Axes;

   procedure Copy_Hats
     (From :     Standard.Glfw.Input.Joysticks.Joystick_Hat_States;
      To   : out Inputs.Joysticks.Hat_States)
   is
      use all type Standard.Glfw.Input.Joysticks.Joystick_Hat_State;
   begin
      for Index in From'Range loop
         To (Index) := (case From (Index) is
                          when Centered   => Centered,
                          when Up         => Up,
                          when Right      => Right,
                          when Right_Up   => Right_Up,
                          when Down       => Down,
                          when Right_Down => Right_Down,
                          when Left       => Left,
                          when Left_Up    => Left_Up,
                          when Left_Down  => Left_Down);
      end loop;
   end Copy_Hats;

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

   package SU renames Ada.Strings.Unbounded;

   type Abstract_GLFW_Joystick_Input is abstract
     new Joysticks.Default.Abstract_Joystick_Input with
   record
      Joystick   : Standard.Glfw.Input.Joysticks.Joystick;
      Name, GUID : SU.Unbounded_String;
      Present    : Boolean;
   end record;

   overriding
   function Is_Present (Object : Abstract_GLFW_Joystick_Input) return Boolean is
     (Object.Present and then Object.Joystick.Is_Present);

   overriding
   function Name (Object : Abstract_GLFW_Joystick_Input) return String is
     (SU.To_String (Object.Name));

   overriding
   function GUID (Object : Abstract_GLFW_Joystick_Input) return String is
     (SU.To_String (Object.GUID));

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

   type GLFW_Gamepad_Input  is new Abstract_GLFW_Joystick_Input with null record;

   overriding
   function Is_Gamepad (Object : GLFW_Gamepad_Input) return Boolean is (True);

   overriding
   function State (Object : in out GLFW_Gamepad_Input) return Inputs.Joysticks.Joystick_State is
      use type SU.Unbounded_String;
   begin
      if not Object.Joystick.Is_Present then
         Object.Present := False;
         raise Disconnected_Error with Object.Joystick.Index'Image & " is not connected";
      elsif Object.Joystick.Joystick_GUID = Object.GUID then
         Object.Present := True;
      end if;

      declare
         State : constant Standard.Glfw.Input.Joysticks.Joystick_Gamepad_State :=
           Object.Joystick.Gamepad_State;
      begin
         return Result : Joystick_State
           (Button_Count => State.Buttons'Length,
            Axis_Count   => State.Axes'Length,
            Hat_Count    => 0)
         do
            Copy_Buttons (State.Buttons, Result.Buttons);
            Copy_Axes (State.Axes, Result.Axes);

            Inputs.Joysticks.Gamepads.Normalize_Axes (Result.Axes);
         end return;
      end;
   end State;

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

   type GLFW_Joystick_Input is new Abstract_GLFW_Joystick_Input with null record;

   overriding
   function Is_Gamepad (Object : GLFW_Joystick_Input) return Boolean is (False);

   overriding
   function State (Object : in out GLFW_Joystick_Input) return Inputs.Joysticks.Joystick_State is
      use type SU.Unbounded_String;
   begin
      if not Object.Joystick.Is_Present then
         Object.Present := False;
         raise Disconnected_Error with Object.Joystick.Index'Image & " is not connected";
      elsif Object.Joystick.Joystick_GUID = Object.GUID then
         Object.Present := True;
      end if;

      declare
         Buttons : constant Standard.Glfw.Input.Joysticks.Joystick_Button_States :=
           Object.Joystick.Button_States;
         Axes : constant Standard.Glfw.Input.Joysticks.Axis_Positions :=
           Object.Joystick.Positions;
         Hats : constant Standard.Glfw.Input.Joysticks.Joystick_Hat_States :=
           Object.Joystick.Hat_States;
      begin
         return Result : Joystick_State
           (Button_Count => Buttons'Length,
            Axis_Count   => Axes'Length,
            Hat_Count    => Hats'Length)
         do
            Copy_Buttons (Buttons, Result.Buttons);
            Copy_Axes (Axes, Result.Axes);
            Copy_Hats (Hats, Result.Hats);
         end return;
      end;
   end State;

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

   function Create_Joystick_Input
     (Index : Standard.Glfw.Input.Joysticks.Joystick_Index)
     return Inputs.Joysticks.Joystick_Input_Ptr
   is
      Joystick : constant Standard.Glfw.Input.Joysticks.Joystick :=
        Standard.Glfw.Input.Joysticks.Get_Joystick (Index);
   begin
      if not Joystick.Is_Present then
         raise Disconnected_Error with Index'Image & " is not connected";
      end if;

      if Joystick.Is_Gamepad then
         return new GLFW_Gamepad_Input'
           (Joysticks.Default.Abstract_Joystick_Input with Joystick => Joystick,
            Present  => True,
            Name => SU.To_Unbounded_String (Joystick.Gamepad_Name),
            GUID => SU.To_Unbounded_String (Joystick.Joystick_GUID));
      else
         return new GLFW_Joystick_Input'
           (Joysticks.Default.Abstract_Joystick_Input with Joystick => Joystick,
            Present  => True,
            Name => SU.To_Unbounded_String (Joystick.Joystick_Name),
            GUID => SU.To_Unbounded_String (Joystick.Joystick_GUID));
      end if;
   end Create_Joystick_Input;

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

   subtype Slot_Index is Standard.Glfw.Input.Joysticks.Joystick_Index range 1 .. 16;

   type Boolean_Array is array (Slot_Index) of Boolean;

   protected type Joystick_Manager is new Inputs.Joysticks.Joystick_Manager with
      procedure Set_Present
        (Index : Slot_Index;
         Value : Boolean);

      procedure Initialize
        with Post => Is_Initialized;

      function Is_Initialized return Boolean;

      overriding
      procedure Acquire (Joystick : out Inputs.Joysticks.Joystick_Input_Access);

      overriding
      procedure Release (Joystick : Inputs.Joysticks.Joystick_Input_Access);
   private
      Acquired, Present : Boolean_Array := (others => False);
      Initialized : Boolean := False;
   end Joystick_Manager;

   package Joysticks renames Standard.Glfw.Input.Joysticks;

   protected body Joystick_Manager is
      procedure Set_Present
        (Index : Slot_Index;
         Value : Boolean) is
      begin
         Present (Index) := Value;
      end Set_Present;

      procedure Initialize is
      begin
         for Index in Present'Range loop
            Present (Index) := Joysticks.Get_Joystick (Index).Is_Present;
         end loop;

         Initialized := True;
      end Initialize;

      function Is_Initialized return Boolean is (Initialized);

      procedure Acquire (Joystick : out Inputs.Joysticks.Joystick_Input_Access) is
      begin
         for Index in Acquired'Range loop
            if not Acquired (Index) and Present (Index) then
               Joystick := Create_Joystick_Input (Index);
               Acquired (Index) := True;
               return;
            end if;
         end loop;

         Joystick := null;
      end Acquire;

      procedure Release (Joystick : Inputs.Joysticks.Joystick_Input_Access) is
         Index : constant Slot_Index :=
           Abstract_GLFW_Joystick_Input (Joystick.all).Joystick.Index;
      begin
         if not Acquired (Index) then
            raise Program_Error;
         end if;

         Acquired (Index) := False;
      end Release;
   end Joystick_Manager;

   Default_Manager : aliased Joystick_Manager;

   procedure On_Connected
     (Source : Joysticks.Joystick;
      State  : Joysticks.Connect_State)
   is
      use type Joysticks.Connect_State;
   begin
      Default_Manager.Set_Present (Source.Index, State = Joysticks.Connected);
   end On_Connected;

   function Create_Joystick_Manager return Inputs.Joysticks.Joystick_Manager_Ptr is
   begin
      if not Default_Manager.Is_Initialized then
         Default_Manager.Initialize;
         Joysticks.Set_Callback (On_Connected'Access);
      end if;

      return Default_Manager'Access;
   end Create_Joystick_Manager;

end Orka.Inputs.GLFW;

orka: Call Joystick_Name if not a gamepad to avoid null dereference

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


with Ada.Text_IO;
package body Trie is
   package IO renames Ada.Text_IO;

   procedure Add_Word(node : in out Trie_Node; word, partial : String; node_count : in out Natural) is
      first : Character;
   begin
   if partial'Length = 0 then
   node.is_terminal := true;
         node.word := BoundedString.To_Bounded_String(word);
      else
         first := partial(partial'First);
         if node.children(first) = null then
            node_count := node_count + 1;
            node.children(first) := new Trie_Node;
         end if;
         Add_Word(node.children(first).all, word, partial(partial'First + 1 .. partial'Last), node_count);
      end if;
   end Add_Word;

   function Find_Partial(node : in Trie_Node_Access; word : String) return Trie_Node_Access is
   begin
      if node = null or else word'Length = 0 then
         return node;
      else
         return Find_Partial(node.all.children(word(word'First)), word(word'First + 1 .. word'Last));
      end if;
   end Find_Partial;

   function Make_Trie(filename : String) return Trie is
      input : IO.File_Type;
      result : Trie;
      word : String (1 .. 32);
      last : Natural;
   begin
      IO.Open(input, IO.In_File, filename);
      result.node_count := 0;
      result.root := new Trie_Node;
      while not IO.End_Of_File(input) loop
         IO.Get_Line(input, word, last);
         if last = word'Last then
            raise Constraint_Error;
         elsif last > 3 and last < BoundedString.Max_Length then
            Add_Word(result.root.all, word(1 .. last), word(1 .. last), result.node_count);
         end if;
      end loop;
      return result;
   end Make_Trie;

   procedure Find_Words(words : Trie; fragments: String; endpoints: Fragment_Endpoint_Array) is
      taken : Array (fragments'Range) of Boolean := (others => False);
      procedure Find_Words_Helper(node : Trie_Node_Access ) is
         new_node : Trie_Node_Access;
      begin
         for index in endpoints'Range loop
            if not taken(index) then
               new_node := Find_Partial(node, fragments(endpoints(index).first .. endpoints(index).last));
               if new_node /= null then
                  taken(index) := True;
                  if new_node.all.is_terminal then
                     IO.Put_Line(BoundedString.To_String(new_node.all.word));
                  end if;
                  Find_Words_Helper(new_node);
                  taken(index) := False;
               end if;
            end if;
         end loop;
      end Find_Words_Helper;
   begin
      IO.Put_Line(fragments);
      Find_Words_Helper(words.root);
   end Find_Words;
end Trie;

Fix indentation.

Fix indentation.


-----------------------------------------------------------------------
--  factory -- Session Factory
--  Copyright (C) 2009, 2010, 2011, 2012, 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.
-----------------------------------------------------------------------

with ADO.Sequences.Hilo;
with ADO.Schemas.Entities;
with ADO.Queries.Loaders;

package body ADO.Sessions.Factory is

   --  ------------------------------
   --  Open a session
   --  ------------------------------
   procedure Open_Session (Factory  : in out Session_Factory;
                           Database : out Session) is
      S  : constant Session_Record_Access := new Session_Record;
   begin
      Factory.Source.Create_Connection (S.Database);
      S.Entities := Factory.Entities;
      S.Values   := Factory.Cache_Values;
      S.Queries  := Factory.Queries;
      Database.Impl := S;
   end Open_Session;

   --  ------------------------------
   --  Get a read-only session from the factory.
   --  ------------------------------
   function Get_Session (Factory : in Session_Factory) return Session is
      R  : Session;
      S  : constant Session_Record_Access := new Session_Record;
   begin
      Factory.Source.Create_Connection (S.Database);
      S.Entities := Factory.Entities;
      S.Values   := Factory.Cache_Values;
      S.Queries  := Factory.Queries;
      R.Impl := S;
      return R;
   end Get_Session;

   --  ------------------------------
   --  Get a read-only session from the session proxy.
   --  If the session has been invalidated, raise the SESSION_EXPIRED exception.
   --  ------------------------------
   function Get_Session (Proxy : in Session_Record_Access) return Session is
      R : Session;
   begin
      if Proxy = null then
         raise ADO.Objects.SESSION_EXPIRED;
      end if;
      R.Impl := Proxy;
      Util.Concurrent.Counters.Increment (R.Impl.Counter);
      return R;
   end Get_Session;

   --  ------------------------------
   --  Get a read-write session from the factory.
   --  ------------------------------
   function Get_Master_Session (Factory : in Session_Factory) return Master_Session is
      R  : Master_Session;
      S  : constant Session_Record_Access   := new Session_Record;
   begin
      R.Impl := S;
      R.Sequences := Factory.Sequences;
      Factory.Source.Create_Connection (S.Database);
      S.Entities := Factory.Entities;
      S.Values   := Factory.Cache_Values;
      S.Queries  := Factory.Queries;
      return R;
   end Get_Master_Session;

   --  ------------------------------
   --  Open a session
   --  ------------------------------
   procedure Open_Session (Factory : in Session_Factory;
                           Database : out Master_Session) is
   begin
      null;
   end Open_Session;

   --  ------------------------------
   --  Initialize the sequence factory associated with the session factory.
   --  ------------------------------
   procedure Initialize_Sequences (Factory : in out Session_Factory) is
      use ADO.Sequences;
   begin
      Factory.Sequences := Factory.Seq_Factory'Unchecked_Access;
      Set_Default_Generator (Factory.Seq_Factory,
                             ADO.Sequences.Hilo.Create_HiLo_Generator'Access,
                             Factory'Unchecked_Access);
   end Initialize_Sequences;

   --  ------------------------------
   --  Create the session factory to connect to the database represented
   --  by the data source.
   --  ------------------------------
   procedure Create (Factory : out Session_Factory;
                     Source  : in ADO.Sessions.Sources.Data_Source) is
   begin
      Factory.Source := Source;
      Factory.Entities := new ADO.Schemas.Entities.Entity_Cache;
      Factory.Cache_Values := Factory.Cache'Unchecked_Access;
      Factory.Cache.Add_Cache (ENTITY_CACHE_NAME, Factory.Entities.all'Access);
      ADO.Queries.Loaders.Initialize (Factory.Queries, Source);
      Initialize_Sequences (Factory);

      if Factory.Source.Get_Database /= "" then
         declare
            S : Session := Factory.Get_Session;
         begin
            ADO.Schemas.Entities.Initialize (Factory.Entities.all, S);
         end;
      end if;
   end Create;

   --  ------------------------------
   --  Create the session factory to connect to the database identified
   --  by the URI.
   --  ------------------------------
   procedure Create (Factory : out Session_Factory;
                     URI     : in String) is
   begin
      Factory.Source.Set_Connection (URI);
      Factory.Entities := new ADO.Schemas.Entities.Entity_Cache;
      Factory.Cache_Values := Factory.Cache'Unchecked_Access;
      Factory.Cache.Add_Cache (ENTITY_CACHE_NAME, Factory.Entities.all'Access);
      Initialize_Sequences (Factory);

      if Factory.Source.Get_Database /= "" then
         declare
            S : Session := Factory.Get_Session;
         begin
            ADO.Schemas.Entities.Initialize (Factory.Entities.all, S);
         end;
      end if;
   end Create;

end ADO.Sessions.Factory;

-----------------------------------------------------------------------
--  factory -- Session Factory
--  Copyright (C) 2009, 2010, 2011, 2012, 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.
-----------------------------------------------------------------------

with ADO.Sequences.Hilo;
with ADO.Schemas.Entities;
with ADO.Queries.Loaders;

package body ADO.Sessions.Factory is

   --  ------------------------------
   --  Open a session
   --  ------------------------------
   procedure Open_Session (Factory  : in out Session_Factory;
                           Database : out Session) is
      S  : constant Session_Record_Access := new Session_Record;
   begin
      Factory.Source.Create_Connection (S.Database);
      S.Entities := Factory.Entities;
      S.Values   := Factory.Cache_Values;
      S.Queries  := Factory.Queries'Unchecked_Access;
      Database.Impl := S;
   end Open_Session;

   --  ------------------------------
   --  Get a read-only session from the factory.
   --  ------------------------------
   function Get_Session (Factory : in Session_Factory) return Session is
      R  : Session;
      S  : constant Session_Record_Access := new Session_Record;
   begin
      Factory.Source.Create_Connection (S.Database);
      S.Entities := Factory.Entities;
      S.Values   := Factory.Cache_Values;
      S.Queries  := Factory.Queries'Unrestricted_Access;
      R.Impl := S;
      return R;
   end Get_Session;

   --  ------------------------------
   --  Get a read-only session from the session proxy.
   --  If the session has been invalidated, raise the SESSION_EXPIRED exception.
   --  ------------------------------
   function Get_Session (Proxy : in Session_Record_Access) return Session is
      R : Session;
   begin
      if Proxy = null then
         raise ADO.Objects.SESSION_EXPIRED;
      end if;
      R.Impl := Proxy;
      Util.Concurrent.Counters.Increment (R.Impl.Counter);
      return R;
   end Get_Session;

   --  ------------------------------
   --  Get a read-write session from the factory.
   --  ------------------------------
   function Get_Master_Session (Factory : in Session_Factory) return Master_Session is
      R  : Master_Session;
      S  : constant Session_Record_Access   := new Session_Record;
   begin
      R.Impl := S;
      R.Sequences := Factory.Sequences;
      Factory.Source.Create_Connection (S.Database);
      S.Entities := Factory.Entities;
      S.Values   := Factory.Cache_Values;
      S.Queries  := Factory.Queries'Unrestricted_Access;
      return R;
   end Get_Master_Session;

   --  ------------------------------
   --  Open a session
   --  ------------------------------
   procedure Open_Session (Factory : in Session_Factory;
                           Database : out Master_Session) is
   begin
      null;
   end Open_Session;

   --  ------------------------------
   --  Initialize the sequence factory associated with the session factory.
   --  ------------------------------
   procedure Initialize_Sequences (Factory : in out Session_Factory) is
      use ADO.Sequences;
   begin
      Factory.Sequences := Factory.Seq_Factory'Unchecked_Access;
      Set_Default_Generator (Factory.Seq_Factory,
                             ADO.Sequences.Hilo.Create_HiLo_Generator'Access,
                             Factory'Unchecked_Access);
   end Initialize_Sequences;

   --  ------------------------------
   --  Create the session factory to connect to the database represented
   --  by the data source.
   --  ------------------------------
   procedure Create (Factory : out Session_Factory;
                     Source  : in ADO.Sessions.Sources.Data_Source) is
   begin
      Factory.Source := Source;
      Factory.Entities := new ADO.Schemas.Entities.Entity_Cache;
      Factory.Cache_Values := Factory.Cache'Unchecked_Access;
      Factory.Cache.Add_Cache (ENTITY_CACHE_NAME, Factory.Entities.all'Access);
      ADO.Queries.Loaders.Initialize (Factory.Queries, Factory.Source);
      Initialize_Sequences (Factory);

      if Factory.Source.Get_Database /= "" then
         declare
            S : Session := Factory.Get_Session;
         begin
            ADO.Schemas.Entities.Initialize (Factory.Entities.all, S);
         end;
      end if;
   end Create;

   --  ------------------------------
   --  Create the session factory to connect to the database identified
   --  by the URI.
   --  ------------------------------
   procedure Create (Factory : out Session_Factory;
                     URI     : in String) is
   begin
      Factory.Source.Set_Connection (URI);
      Factory.Entities := new ADO.Schemas.Entities.Entity_Cache;
      Factory.Cache_Values := Factory.Cache'Unchecked_Access;
      Factory.Cache.Add_Cache (ENTITY_CACHE_NAME, Factory.Entities.all'Access);
      ADO.Queries.Loaders.Initialize (Factory.Queries, Factory.Source);
      Initialize_Sequences (Factory);

      if Factory.Source.Get_Database /= "" then
         declare
            S : Session := Factory.Get_Session;
         begin
            ADO.Schemas.Entities.Initialize (Factory.Entities.all, S);
         end;
      end if;
   end Create;

end ADO.Sessions.Factory;

Replace the Query_Manager_Access by a Query_Manager


-----------------------------------------------------------------------
--  components-util -- ASF Util 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.Views;
with ASF.Views.Nodes;
package body ASF.Components.Utils is

   function Get_Line_Info (UI : in Base.UIComponent'Class) return Views.Line_Info;

   --  ------------------------------
   --  Get the line information where the component is defined.
   --  ------------------------------
   function Get_Line_Info (UI : in Base.UIComponent'Class) return Views.Line_Info is
      Tag : constant access ASF.Views.Nodes.Tag_Node'Class := UI.Get_Tag;
   begin
      if Tag /= null then
         return Tag.Get_Line_Info;
      else
         return Tag.Get_Line_Info;
      end if;
   end Get_Line_Info;
   pragma Unreferenced (Get_Line_Info);

   --  ------------------------------
   --  Get the line information where the component is defined.
   --  ------------------------------
   function Get_Line_Info (UI : in Base.UIComponent'Class) return String is
      Tag : constant access ASF.Views.Nodes.Tag_Node'Class := UI.Get_Tag;
   begin
      if Tag /= null then
         return Tag.Get_Line_Info;
      else
         return Tag.Get_Line_Info;
      end if;
   end Get_Line_Info;

end ASF.Components.Utils;

-----------------------------------------------------------------------
--  components-util -- ASF Util 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.Views;
with ASF.Views.Nodes;
package body ASF.Components.Utils is

   function Get_Line_Info (UI : in Base.UIComponent'Class) return Views.Line_Info;

   --  ------------------------------
   --  Get the line information where the component is defined.
   --  ------------------------------
   function Get_Line_Info (UI : in Base.UIComponent'Class) return Views.Line_Info is
      Tag : constant access ASF.Views.Nodes.Tag_Node'Class := UI.Get_Tag;
   begin
      if Tag /= null then
         return Tag.Get_Line_Info;
      else
         return Tag.Get_Line_Info;
      end if;
   end Get_Line_Info;
   pragma Unreferenced (Get_Line_Info);

   --  ------------------------------
   --  Get the line information where the component is defined.
   --  ------------------------------
   function Get_Line_Info (UI : in Base.UIComponent'Class) return String is
      Tag : constant access ASF.Views.Nodes.Tag_Node'Class := UI.Get_Tag;
   begin
      if Tag /= null then
         return Tag.Get_Line_Info;
      else
         return "?";
      end if;
   end Get_Line_Info;

end ASF.Components.Utils;

Fix exception in case the component has no associated tag


-----------------------------------------------------------------------
--  gen-commands-plugins -- Plugin creation and management commands for dynamo
--  Copyright (C) 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 Ada.Directories;
with Ada.Text_IO;
with Gen.Artifacts;
with Gen.Model.Projects;
with GNAT.Command_Line;

with Util.Files;
with Util.Log.Loggers;
with Util.Strings.Transforms;
package body Gen.Commands.Plugins is

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("Gen.Commands.Project");

   --  ------------------------------
   --  Generator Command
   --  ------------------------------

   --  Execute the command with the arguments.
   procedure Execute (Cmd       : in Command;
                      Generator : in out Gen.Generator.Handler) is
      pragma Unreferenced (Cmd);
      use GNAT.Command_Line;

      Result_Dir : constant String := Generator.Get_Result_Directory;
   begin
      --  If a dynamo.xml file exists, read it.
      if Ada.Directories.Exists ("dynamo.xml") then
         Generator.Read_Project ("dynamo.xml");
      else
         Generator.Set_Project_Property ("license", "apache");
         Generator.Set_Project_Property ("author", "unknown");
         Generator.Set_Project_Property ("author_email", "unknown@company.com");
      end if;
      --  Parse the command line
      loop
         case Getopt ("l:") is
         when ASCII.NUL => exit;

         when 'l' =>
            declare
               L : constant String := Util.Strings.Transforms.To_Lower_Case (Parameter);
            begin
               Log.Info ("License {0}", L);

               if L = "apache" then
                  Generator.Set_Project_Property ("license", "apache");
               elsif L = "gpl" then
                  Generator.Set_Project_Property ("license", "gpl");
               elsif L = "proprietary" then
                  Generator.Set_Project_Property ("license", "proprietary");
               else
                  Generator.Error ("Invalid license: {0}", L);
                  Generator.Error ("Valid licenses: apache, gpl, proprietary");
                  return;
               end if;
            end;

         when others =>
            null;
         end case;
      end loop;
      declare
         Name  : constant String := Get_Argument;
         Kind  : constant String := Get_Argument;
         Dir   : constant String := Generator.Get_Plugin_Directory;
         Path  : constant String := Util.Files.Compose (Dir, Name);
      begin
         if Name'Length = 0 then
            Generator.Error ("Missing plugin name");
            Gen.Commands.Usage;
            return;
         end if;
         if Kind /= "ada" and Kind /= "web" and Kind /= "" then
            Generator.Error ("Invalid plugin type (must be 'ada' or 'web')");
            return;
         end if;

         if Ada.Directories.Exists (Path) then
            Generator.Error ("Plugin {0} exists already", Name);
            return;
         end if;
         if not Ada.Directories.Exists (Dir) then
            Ada.Directories.Create_Directory (Dir);
         end if;
         Ada.Directories.Create_Directory (Path);

         Generator.Set_Result_Directory (Path);

         --  Create the plugin project instance and generate its dynamo.xml file.
         --  The new plugin is added to the current project so that it will be referenced.
         declare
            procedure Create_Plugin (Project : in out Model.Projects.Root_Project_Definition);

            procedure Create_Plugin (Project : in out Model.Projects.Root_Project_Definition) is
               Plugin : Gen.Model.Projects.Project_Definition_Access;
               File   : constant String := Util.Files.Compose (Path, "dynamo.xml");
            begin
               Project.Create_Project (Name    => Name,
                                       Path    => File,
                                       Project => Plugin);
               Project.Add_Module (Plugin);

               Plugin.Props.Set ("license", Project.Props.Get ("license", "none"));
               Plugin.Props.Set ("author", Project.Props.Get ("author", ""));
               Plugin.Props.Set ("author_email", Project.Props.Get ("author_email", ""));
               Plugin.Save (File);
            end Create_Plugin;

         begin
            Generator.Update_Project (Create_Plugin'Access);
         end;

         --  Generate the new plugin content.
         Generator.Set_Force_Save (False);
         Generator.Set_Global ("pluginName", Name);
         Gen.Generator.Generate_All (Generator, Gen.Artifacts.ITERATION_TABLE,
                                     "create-plugin");
         if Kind /= "" then
            Gen.Generator.Generate_All (Generator, Gen.Artifacts.ITERATION_TABLE,
                                        "create-plugin-" & Kind);
         end if;

         --  And save the project dynamo.xml file which now refers to the new plugin.
         Generator.Set_Result_Directory (Result_Dir);
         Generator.Save_Project;
      end;
   end Execute;

   --  ------------------------------
   --  Write the help associated with the command.
   --  ------------------------------
   procedure Help (Cmd       : in Command;
                   Generator : in out Gen.Generator.Handler) is
      pragma Unreferenced (Cmd, Generator);
      use Ada.Text_IO;
   begin
      Put_Line ("create-plugin: Create a new plugin for the current project");
      Put_Line ("Usage: create-plugin NAME");
      New_Line;
      Put_Line ("  Creates a new AWA plugin for the application with the name passed in NAME.");
   end Help;

end Gen.Commands.Plugins;

-----------------------------------------------------------------------
--  gen-commands-plugins -- Plugin creation and management commands for dynamo
--  Copyright (C) 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 Ada.Directories;
with Ada.Text_IO;
with Gen.Artifacts;
with Gen.Model.Projects;
with GNAT.Command_Line;

with Util.Files;
with Util.Log.Loggers;
with Util.Strings.Transforms;
package body Gen.Commands.Plugins is

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("Gen.Commands.Project");

   --  ------------------------------
   --  Generator Command
   --  ------------------------------

   --  Execute the command with the arguments.
   procedure Execute (Cmd       : in Command;
                      Generator : in out Gen.Generator.Handler) is
      pragma Unreferenced (Cmd);
      use GNAT.Command_Line;

      Result_Dir : constant String := Generator.Get_Result_Directory;
   begin
      --  If a dynamo.xml file exists, read it.
      if Ada.Directories.Exists ("dynamo.xml") then
         Generator.Read_Project ("dynamo.xml");
      else
         Generator.Set_Project_Property ("license", "apache");
         Generator.Set_Project_Property ("author", "unknown");
         Generator.Set_Project_Property ("author_email", "unknown@company.com");
      end if;
      --  Parse the command line
      loop
         case Getopt ("l:") is
         when ASCII.NUL => exit;

         when 'l' =>
            declare
               L : constant String := Util.Strings.Transforms.To_Lower_Case (Parameter);
            begin
               Log.Info ("License {0}", L);

               if L = "apache" then
                  Generator.Set_Project_Property ("license", "apache");
               elsif L = "gpl" then
                  Generator.Set_Project_Property ("license", "gpl");
               elsif L = "proprietary" then
                  Generator.Set_Project_Property ("license", "proprietary");
               else
                  Generator.Error ("Invalid license: {0}", L);
                  Generator.Error ("Valid licenses: apache, gpl, proprietary");
                  return;
               end if;
            end;

         when others =>
            null;
         end case;
      end loop;
      declare
         Name  : constant String := Get_Argument;
         Kind  : constant String := Get_Argument;
         Dir   : constant String := Generator.Get_Plugin_Directory;
         Path  : constant String := Util.Files.Compose (Dir, Name);
      begin
         if Name'Length = 0 then
            Generator.Error ("Missing plugin name");
            Gen.Commands.Usage;
            return;
         end if;
         if Kind /= "ada" and Kind /= "web" and Kind /= "" then
            Generator.Error ("Invalid plugin type (must be 'ada' or 'web')");
            return;
         end if;

         if Ada.Directories.Exists (Path) then
            Generator.Error ("Plugin {0} exists already", Name);
            return;
         end if;
         if not Ada.Directories.Exists (Dir) then
            Ada.Directories.Create_Directory (Dir);
         end if;
         Ada.Directories.Create_Directory (Path);

         Generator.Set_Result_Directory (Path);

         --  Create the plugin project instance and generate its dynamo.xml file.
         --  The new plugin is added to the current project so that it will be referenced.
         declare
            procedure Create_Plugin (Project : in out Model.Projects.Root_Project_Definition);

            procedure Create_Plugin (Project : in out Model.Projects.Root_Project_Definition) is
               Plugin : Gen.Model.Projects.Project_Definition_Access;
               File   : constant String := Util.Files.Compose (Path, "dynamo.xml");
            begin
               Project.Create_Project (Name    => Name,
                                       Path    => File,
                                       Project => Plugin);
               Project.Add_Module (Plugin);

               Plugin.Props.Set ("license", Project.Props.Get ("license", "none"));
               Plugin.Props.Set ("author", Project.Props.Get ("author", ""));
               Plugin.Props.Set ("author_email", Project.Props.Get ("author_email", ""));
               Plugin.Save (File);
            end Create_Plugin;

         begin
            Generator.Update_Project (Create_Plugin'Access);
         end;

         --  Generate the new plugin content.
         Generator.Set_Force_Save (False);
         Generator.Set_Global ("pluginName", Name);
         Gen.Generator.Generate_All (Generator, Gen.Artifacts.ITERATION_TABLE,
                                     "create-plugin");
         if Kind /= "" then
            Gen.Generator.Generate_All (Generator, Gen.Artifacts.ITERATION_TABLE,
                                        "create-plugin-" & Kind);
         end if;

         --  And save the project dynamo.xml file which now refers to the new plugin.
         Generator.Set_Result_Directory (Result_Dir);
         Generator.Save_Project;
      end;
   end Execute;

   --  ------------------------------
   --  Write the help associated with the command.
   --  ------------------------------
   procedure Help (Cmd       : in Command;
                   Generator : in out Gen.Generator.Handler) is
      pragma Unreferenced (Cmd, Generator);
      use Ada.Text_IO;
   begin
      Put_Line ("create-plugin: Create a new plugin for the current project");
      Put_Line ("Usage: create-plugin NAME [ada | web]");
      New_Line;
      Put_Line ("  Creates a new AWA plugin for the application with the name passed in NAME.");
      Put_Line ("  The plugin type is specified as the last argument which can be one of:");
      New_Line;
      Put_Line ("    ada  the plugin contains Ada code and a GNAT project is created");
      Put_Line ("    web  the plugin contains XHTML, CSS, Javascript files only");
      New_Line;
      Put_Line ("  The plugin is created in the directory:");
      Put_Line ("    plugins/NAME");
   end Help;

end Gen.Commands.Plugins;

Update the documentation for the help create-plugin command


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

package Gen.Commands.Propset is

   --  ------------------------------
   --  Propset Command
   --  ------------------------------
   --  This command sets a property in the dynamo project configuration.
   type Command is new Gen.Commands.Command with null record;

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

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

end Gen.Commands.Propset;

-----------------------------------------------------------------------
--  gen-commands-propset -- Set a property on dynamo project
--  Copyright (C) 2011, 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 Gen.Commands.Propset is

   --  ------------------------------
   --  Propset Command
   --  ------------------------------
   --  This command sets a property in the dynamo project configuration.
   type Command is new Gen.Commands.Command with null record;

   --  Execute the command with the arguments.
   overriding
   procedure Execute (Cmd       : in Command;
                      Name      : in String;
                      Args      : in Argument_List'Class;
                      Generator : in out Gen.Generator.Handler);

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

end Gen.Commands.Propset;

Update to use the new command implementation


-----------------------------------------------------------------------
--  components-utils-escape -- Escape generated content produced by component children
--  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 Util.Strings.Transforms;
package body ASF.Components.Utils.Escapes is

   --  ------------------------------
   --  Write the content that was collected by rendering the inner children.
   --  Escape the content using Javascript escape rules.
   --  ------------------------------
   procedure Write_Content (UI      : in UIEscape;
                            Writer  : in out Contexts.Writer.Response_Writer'Class;
                            Content : in String;
                            Context : in out ASF.Contexts.Faces.Faces_Context'Class) is
      pragma Unreferenced (UI, Context);

      Result : Ada.Strings.Unbounded.Unbounded_String;
   begin
      Util.Strings.Transforms.Escape_Java (Content => Content,
                                           Into    => Result);
      Writer.Write (Result);
   end Write_Content;

   --  ------------------------------
   --  Encode the children components in the javascript queue.
   --  ------------------------------
   overriding
   procedure Encode_Children (UI      : in UIEscape;
                              Context : in out ASF.Contexts.Faces.Faces_Context'Class) is

      procedure Process (Content : in String);

      procedure Process (Content : in String) is
         Writer : constant Contexts.Writer.Response_Writer_Access := Context.Get_Response_Writer;
      begin
         UIEscape'Class (UI).Write_Content (Writer.all, Content, Context);
      end Process;

   begin
      UI.Wrap_Encode_Children (Context, Process'Access);
   end Encode_Children;

end ASF.Components.Utils.Escapes;

-----------------------------------------------------------------------
--  components-utils-escape -- Escape generated content produced by component children
--  Copyright (C) 2011, 2012, 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.Strings.Transforms;
package body ASF.Components.Utils.Escapes is

   --  ------------------------------
   --  Write the content that was collected by rendering the inner children.
   --  Escape the content using Javascript escape rules.
   --  ------------------------------
   procedure Write_Content (UI      : in UIEscape;
                            Writer  : in out Contexts.Writer.Response_Writer'Class;
                            Content : in String;
                            Context : in out ASF.Contexts.Faces.Faces_Context'Class) is
      pragma Unreferenced (UI, Context);

      Result : Ada.Strings.Unbounded.Unbounded_String;
      Mode   : constant String := UI.Get_Attribute (ESCAPE_MODE_NAME, Context);
   begin
      if Mode = "xml" then
         Util.Strings.Transforms.Escape_Xml (Content => Content,
                                             Into    => Result);
      else
         Util.Strings.Transforms.Escape_Java (Content => Content,
                                              Into    => Result);
      end if;
      Writer.Write (Result);
   end Write_Content;

   --  ------------------------------
   --  Encode the children components in the javascript queue.
   --  ------------------------------
   overriding
   procedure Encode_Children (UI      : in UIEscape;
                              Context : in out ASF.Contexts.Faces.Faces_Context'Class) is

      procedure Process (Content : in String);

      procedure Process (Content : in String) is
         Writer : constant Contexts.Writer.Response_Writer_Access := Context.Get_Response_Writer;
      begin
         UIEscape'Class (UI).Write_Content (Writer.all, Content, Context);
      end Process;

   begin
      UI.Wrap_Encode_Children (Context, Process'Access);
   end Encode_Children;

end ASF.Components.Utils.Escapes;

Add support to escape using XML or using Javascript escape rules


-- $Id$

-- Simple line plot and multiple windows demo.

-- Copyright (C) 2007  Werner Smekal

-- This file is part of PLplot.

-- PLplot is free software; you can redistribute it and/or modify
-- it under the terms of the GNU General Library Public License as published
-- by the Free Software Foundation; either version 2 of the License, or
-- (at your option) any later version.

-- PLplot is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-- GNU Library General Public License for more details.

-- You should have received a copy of the GNU Library General Public License
-- along with PLplot; if not, write to the Free Software
-- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA

with
    Interfaces.C,
    Ada.Text_IO,
    Ada.Numerics,
    Ada.Numerics.Long_Elementary_Functions,
    Ada.Strings.Bounded,
    PLplot,
    PlplotThin;
use
    Interfaces.C,
    Ada.Text_IO,
    Ada.Numerics,
    Ada.Numerics.Long_Elementary_Functions,
    Ada.Strings.Bounded,
    PLplot,
    PlplotThin;

-- COMMENT THIS LINE IF YOUR COMPILER DOES NOT INCLUDE THESE
-- DEFINITIONS, FOR EXAMPLE, IF IT IS NOT ADA 2005 WITH ANNEX G.3 COMPLIANCE.
--with Ada.Numerics.Long_Real_Arrays; use Ada.Numerics.Long_Real_Arrays;

procedure x12a is
    string : char_array(0 .. 20);
    y0 : PL_Float_Array (0 .. 9);
    procedure Sprintf( buffer : out char_array; format : in char_array; variable: in PLFLT );
    pragma Import(C, Sprintf, "sprintf" );

    procedure plfbox(x0 : PLFLT; y0 : PLFLT) is
        x, y : PL_Float_Array (0 .. 3);
    begin
			  x(0) := x0;
			  y(0) := 0.0;
        x(1) := x0;
        y(1) := y0;
        x(2) := x0 + 1.0;
        y(2) := y0;
        x(3) := x0 + 1.0;
        y(3) := 0.0;
        plfill(4, x, y);
        plcol0(1);
        pllsty(1);
        plline(4, x, y);
		end;

begin
			-- plplot initialization

			-- plparseopts(PL_PARSE_FULL);
			Parse_Command_Line_Arguments(PL_PARSE_FULL);

			plinit;

			pladv(0);
			plvsta;
			plwind(1980.0, 1990.0, 0.0, 35.0);
			plbox("bc" & Nul, 1.0, 0, "bcnv" & Nul, 10.0, 0);
			plcol0(2);
			pllab("Year" & Nul, "Widget Sales (millions)" & Nul, "#frPLplot Example 12" & Nul);

			y0(0) := 5.0;
			y0(1) := 15.0;
			y0(2) := 12.0;
			y0(3) := 24.0;
			y0(4) := 28.0;
			y0(5) := 30.0;
			y0(6) := 20.0;
			y0(7) := 8.0;
			y0(8) := 12.0;
			y0(9) := 3.0;

			for i in y0'Range loop
          plcol0(i + 1);
          plpsty(0);
          plfbox(Long_Float(1980 + i), y0(i));
          sprintf(string, "%.0f" & Nul, y0(i));
          plptex(Long_Float(1980 + i) + 0.5, (y0(i) + 1.0), 1.0, 0.0, 0.5, string);
          sprintf(string, "%.0f" & Nul, Long_Float(1980 + i));
          plmtex("b" & Nul, 1.0, (Long_Float(i + 1) * 0.1 - 0.05), 0.5, string);
			end loop;

			-- Don't forget to call plend() to finish off!
	    plend;
	end x12a;

-- $Id$

-- Simple line plot and multiple windows demo.

-- Copyright (C) 2007  Werner Smekal

-- This file is part of PLplot.

-- PLplot is free software; you can redistribute it and/or modify
-- it under the terms of the GNU General Library Public License as published
-- by the Free Software Foundation; either version 2 of the License, or
-- (at your option) any later version.

-- PLplot is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-- GNU Library General Public License for more details.

-- You should have received a copy of the GNU Library General Public License
-- along with PLplot; if not, write to the Free Software
-- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA

with
    Ada.Text_IO,
    Ada.Numerics,
    Ada.Numerics.Long_Elementary_Functions,
    Ada.Strings.Bounded,
    Interfaces.C,
    PlplotThin;
use
    Ada.Text_IO,
    Ada.Numerics,
    Ada.Numerics.Long_Elementary_Functions,
    Ada.Strings.Bounded,
    Interfaces.C,
    PlplotThin;

-- COMMENT THIS LINE IF YOUR COMPILER DOES NOT INCLUDE THESE
-- DEFINITIONS, FOR EXAMPLE, IF IT IS NOT ADA 2005 WITH ANNEX G.3 COMPLIANCE.
--with Ada.Numerics.Long_Real_Arrays; use Ada.Numerics.Long_Real_Arrays;

procedure x12a is
    string : char_array(0 .. 20);
    y0 : PL_Float_Array (0 .. 9);
    procedure Sprintf( buffer : out char_array; format : in char_array; variable: in PLFLT );
    pragma Import(C, Sprintf, "sprintf" );

    procedure plfbox(x0 : PLFLT; y0 : PLFLT) is
        x, y : PL_Float_Array (0 .. 3);
    begin
        x(0) := x0;
        y(0) := 0.0;
        x(1) := x0;
        y(1) := y0;
        x(2) := x0 + 1.0;
        y(2) := y0;
        x(3) := x0 + 1.0;
        y(3) := 0.0;
        plfill(4, x, y);
        plcol0(1);
        pllsty(1);
        plline(4, x, y);
    end;

    begin
    -- plplot initialization

       plparseopts(PL_PARSE_FULL);

       plinit;

       pladv(0);
       plvsta;
       plwind(1980.0, 1990.0, 0.0, 35.0);
       plbox(To_C("bc"), 1.0, 0, To_C("bcnv"), 10.0, 0);
       plcol0(2);
       pllab(To_C("Year"), To_C("Widget Sales (millions)"), To_C("#frPLplot Example 12"));

       y0(0) := 5.0;
       y0(1) := 15.0;
       y0(2) := 12.0;
       y0(3) := 24.0;
       y0(4) := 28.0;
       y0(5) := 30.0;
       y0(6) := 20.0;
       y0(7) := 8.0;
       y0(8) := 12.0;
       y0(9) := 3.0;

       for i in y0'Range loop
          plcol0(i + 1);
          plpsty(0);
          plfbox(Long_Float(1980 + i), y0(i));
          sprintf(string, To_C("%.0f"), y0(i));
          plptex(Long_Float(1980 + i) + 0.5, (y0(i) + 1.0), 1.0, 0.0, 0.5, string);
          sprintf(string, To_C("%.0f"), Long_Float(1980 + i));
          plmtex(To_C("b"), 1.0, (Long_Float(i + 1) * 0.1 - 0.05), 0.5, string);
       end loop;

       -- Don't forget to call plend() to finish off!
       plend;
end x12a;

Use of To_C for all strings, whitespace changes, move to pure thin API
(plparseopts).  Result (with plfill library changes just committed) is
identical to C example.

svn path=/trunk/; revision=7443


-----------------------------------------------------------------------
--  mat-commands -- Command support and execution
--  Copyright (C) 2014, 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 MAT.Targets;
package MAT.Commands is

   Stop_Interp : exception;

   --  Procedure that defines a command handler.
   type Command_Handler is access procedure (Target : in out MAT.Targets.Target_Type'Class;
                                             Args   : in String);

   --  Execute the command given in the line.
   procedure Execute (Target : in out MAT.Targets.Target_Type'Class;
                      Line   : in String);

   --  Initialize the process targets by loading the MAT files.
   procedure Initialize_Files (Target  : in out MAT.Targets.Target_Type'Class);

   --  Symbol command.
   --  Load the symbols from the binary file.
   procedure Symbol_Command (Target : in out MAT.Targets.Target_Type'Class;
                             Args   : in String);

   --  Sizes command.
   --  Collect statistics about the used memory slots and report the different slot
   --  sizes with count.
   procedure Sizes_Command (Target : in out MAT.Targets.Target_Type'Class;
                            Args   : in String);

   --  Threads command.
   --  Collect statistics about the threads and their allocation.
   procedure Threads_Command (Target : in out MAT.Targets.Target_Type'Class;
                              Args   : in String);

   --  Events command.
   --  Print the probe events.
   procedure Events_Command (Target : in out MAT.Targets.Target_Type'Class;
                             Args   : in String);

   --  Event command.
   --  Print the probe event with the stack frame.
   procedure Event_Command (Target : in out MAT.Targets.Target_Type'Class;
                            Args   : in String);

   --  Info command to print symmary information about the program.
   procedure Info_Command (Target : in out MAT.Targets.Target_Type'Class;
                           Args   : in String);

   --  Timeline command.
   --  Identify the interesting timeline groups in the events and display them.
   procedure Timeline_Command (Target : in out MAT.Targets.Target_Type'Class;
                               Args   : in String);

end MAT.Commands;

-----------------------------------------------------------------------
--  mat-commands -- Command support and execution
--  Copyright (C) 2014, 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 MAT.Targets;
package MAT.Commands is

   Stop_Interp : exception;

   --  Procedure that defines a command handler.
   type Command_Handler is access procedure (Target : in out MAT.Targets.Target_Type'Class;
                                             Args   : in String);

   --  Execute the command given in the line.
   procedure Execute (Target : in out MAT.Targets.Target_Type'Class;
                      Line   : in String);

   --  Initialize the process targets by loading the MAT files.
   procedure Initialize_Files (Target  : in out MAT.Targets.Target_Type'Class);

   --  Symbol command.
   --  Load the symbols from the binary file.
   procedure Symbol_Command (Target : in out MAT.Targets.Target_Type'Class;
                             Args   : in String);

   --  Sizes command.
   --  Collect statistics about the used memory slots and report the different slot
   --  sizes with count.
   procedure Sizes_Command (Target : in out MAT.Targets.Target_Type'Class;
                            Args   : in String);

   --  Threads command.
   --  Collect statistics about the threads and their allocation.
   procedure Threads_Command (Target : in out MAT.Targets.Target_Type'Class;
                              Args   : in String);

   --  Events command.
   --  Print the probe events.
   procedure Events_Command (Target : in out MAT.Targets.Target_Type'Class;
                             Args   : in String);

   --  Event command.
   --  Print the probe event with the stack frame.
   procedure Event_Command (Target : in out MAT.Targets.Target_Type'Class;
                            Args   : in String);

   --  Info command to print symmary information about the program.
   procedure Info_Command (Target : in out MAT.Targets.Target_Type'Class;
                           Args   : in String);

   --  Timeline command.
   --  Identify the interesting timeline groups in the events and display them.
   procedure Timeline_Command (Target : in out MAT.Targets.Target_Type'Class;
                               Args   : in String);

   --  Addr command to print a description of an address.
   procedure Addr_Command (Target : in out MAT.Targets.Target_Type'Class;
                           Args   : in String);

end MAT.Commands;

Declare the Addr_Command procedure

Declare the Addr_Command procedure