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

package body Wiki.Buffers is

   subtype Input is Wiki.Strings.WString;
   subtype Block_Access is Buffer_Access;

   procedure Next (Content : in out Buffer_Access;
                   Pos     : in out Positive) is
   begin
      if Pos + 1 > Content.Last then
         Content := Content.Next_Block;
         Pos := 1;
      else
         Pos := Pos + 1;
      end if;
   end Next;

   --  ------------------------------
   --  Get the length of the item builder.
   --  ------------------------------
   function Length (Source : in Builder) return Natural is
   begin
      return Source.Length;
   end Length;

   --  ------------------------------
   --  Get the capacity of the builder.
   --  ------------------------------
   function Capacity (Source : in Builder) return Natural is
      B : constant Block_Access := Source.Current;
   begin
      return Source.Length + B.Len - B.Last;
   end Capacity;

   --  ------------------------------
   --  Get the builder block size.
   --  ------------------------------
   function Block_Size (Source : in Builder) return Positive is
   begin
      return Source.Block_Size;
   end Block_Size;

   --  ------------------------------
   --  Set the block size for the allocation of next chunks.
   --  ------------------------------
   procedure Set_Block_Size (Source : in out Builder;
                             Size   : in Positive) is
   begin
      Source.Block_Size := Size;
   end Set_Block_Size;

   --  ------------------------------
   --  Append the <tt>New_Item</tt> at the end of the source growing the buffer if necessary.
   --  ------------------------------
   procedure Append (Source   : in out Builder;
                     New_Item : in Input) is
      B     : Block_Access := Source.Current;
      Start : Natural := New_Item'First;
      Last  : constant Natural := New_Item'Last;
   begin
      while Start <= Last loop
         declare
            Space : Natural := B.Len - B.Last;
            Size  : constant Natural := Last - Start + 1;
         begin
            if Space > Size then
               Space := Size;
            elsif Space = 0 then
               if Size > Source.Block_Size then
                  B.Next_Block := new Buffer (Size);
               else
                  B.Next_Block := new Buffer (Source.Block_Size);
               end if;
               B := B.Next_Block;
               Source.Current := B;
               if B.Len > Size then
                  Space := Size;
               else
                  Space  := B.Len;
               end if;
            end if;
            B.Content (B.Last + 1 .. B.Last + Space) := New_Item (Start .. Start + Space - 1);
            Source.Length := Source.Length + Space;
            B.Last := B.Last + Space;
            Start  := Start + Space;
         end;
      end loop;
   end Append;

   --  ------------------------------
   --  Append the <tt>New_Item</tt> at the end of the source growing the buffer if necessary.
   --  ------------------------------
   procedure Append (Source   : in out Builder;
                     New_Item : in Wiki.Strings.WChar) is
      B     : Block_Access := Source.Current;
   begin
      if B.Len = B.Last then
         B.Next_Block := new Buffer (Source.Block_Size);
         B := B.Next_Block;
         Source.Current := B;
      end if;
      Source.Length := Source.Length + 1;
      B.Last := B.Last + 1;
      B.Content (B.Last) := New_Item;
   end Append;

   procedure Inline_Append (Source   : in out Builder) is
      B     : Block_Access := Source.Current;
      Last  : Natural;
   begin
      loop
         if B.Len = B.Last then
            B.Next_Block := new Buffer (Source.Block_Size);
            B := B.Next_Block;
            Source.Current := B;
         end if;
         Process (B.Content (B.Last + 1 .. B.Len), Last);
         exit when Last > B.Len or Last <= B.Last;
         Source.Length := Source.Length + Last - B.Last;
         B.Last := Last;
         exit when Last < B.Len;
      end loop;
   end Inline_Append;

   --  ------------------------------
   --  Append in `Into` builder the `Content` builder starting at `From` position
   --  and the up to and including the `To` position.
   --  ------------------------------
   procedure Append (Into    : in out Builder;
                     Content : in Builder;
                     From    : in Positive;
                     To      : in Positive) is
   begin
      if From <= Content.First.Last then
         if To <= Content.First.Last then
            Append (Into, Content.First.Content (From .. To));
            return;
         end if;
         Append (Into, Content.First.Content (From .. Content.First.Last));
      end if;
      declare
         Pos    : Integer := From - Into.First.Last;
         Last   : Integer := To - Into.First.Last;
         B      : Block_Access := Into.First.Next_Block;
      begin
         loop
            if B = null then
               return;
            end if;
            if Pos <= B.Last then
               if Last <= B.Last then
                  Append (Into, B.Content (1 .. Last));
                  return;
               end if;
               Append (Into, B.Content (1 .. B.Last));
            end if;
            Pos := Pos - B.Last;
            Last := Last - B.Last;
            B := B.Next_Block;
         end loop;
      end;
   end Append;

   procedure Append (Into     : in out Builder;
                     Buffer   : in Buffer_Access;
                     From     : in Positive) is
      Block : Buffer_Access := Buffer;
      Pos   : Positive := From;
      First : Positive := From;
   begin
      while Block /= null loop
         Append (Into, Block.Content (First .. Block.Last));
         Block := Block.Next_Block;
         Pos := 1;
         First := 1;
      end loop;
   end Append;

   --  ------------------------------
   --  Clear the source freeing any storage allocated for the buffer.
   --  ------------------------------
   procedure Clear (Source : in out Builder) is
      procedure Free is
        new Ada.Unchecked_Deallocation (Object => Buffer, Name => Buffer_Access);
      Current, Next : Block_Access;
   begin
      Next := Source.First.Next_Block;
      while Next /= null loop
         Current := Next;
         Next    := Current.Next_Block;
         Free (Current);
      end loop;
      Source.First.Next_Block := null;
      Source.First.Last       := 0;
      Source.Current          := Source.First'Unchecked_Access;
      Source.Length           := 0;
   end Clear;

   --  ------------------------------
   --  Iterate over the buffer content calling the <tt>Process</tt> procedure with each
   --  chunk.
   --  ------------------------------
   procedure Iterate (Source  : in Builder;
                      Process : not null access procedure (Chunk : in Input)) is
   begin
      if Source.First.Last > 0 then
         Process (Source.First.Content (1 .. Source.First.Last));
         declare
            B : Block_Access := Source.First.Next_Block;
         begin
            while B /= null loop
               Process (B.Content (1 .. B.Last));
               B := B.Next_Block;
            end loop;
         end;
      end if;
   end Iterate;

   procedure Inline_Iterate (Source  : in Builder) is
   begin
      if Source.First.Last > 0 then
         Process (Source.First.Content (1 .. Source.First.Last));
         declare
            B : Block_Access := Source.First.Next_Block;
         begin
            while B /= null loop
               Process (B.Content (1 .. B.Last));
               B := B.Next_Block;
            end loop;
         end;
      end if;
   end Inline_Iterate;

   procedure Inline_Update (Source  : in out Builder) is
   begin
      if Source.First.Last > 0 then
         Process (Source.First.Content (1 .. Source.First.Last));
         declare
            B : Block_Access := Source.First.Next_Block;
         begin
            while B /= null loop
               Process (B.Content (1 .. B.Last));
               B := B.Next_Block;
            end loop;
         end;
      end if;
   end Inline_Update;

   --  ------------------------------
   --  Return the content starting from the tail and up to <tt>Length</tt> items.
   --  ------------------------------
   function Tail (Source : in Builder;
                  Length : in Natural) return Input is
      Last : constant Natural := Source.Current.Last;
   begin
      if Last >= Length then
         return Source.Current.Content (Last - Length + 1 .. Last);
      elsif Length >= Source.Length then
         return To_Array (Source);
      else
         declare
            Result  : Input (1 .. Length);
            Offset  : Natural := Source.Length - Length;
            B       : access constant Buffer := Source.First'Access;
            Src_Pos : Positive := 1;
            Dst_Pos : Positive := 1;
            Len     : Natural;
         begin
            --  Skip the data moving to next blocks as needed.
            while Offset /= 0 loop
               if Offset < B.Last then
                  Src_Pos := Offset + 1;
                  Offset := 0;
               else
                  Offset := Offset - B.Last + 1;
                  B := B.Next_Block;
               end if;
            end loop;

            --  Copy what remains until we reach the length.
            while Dst_Pos <= Length loop
               Len := B.Last - Src_Pos + 1;
               Result (Dst_Pos .. Dst_Pos + Len - 1) := B.Content (Src_Pos .. B.Last);
               Src_Pos := 1;
               Dst_Pos := Dst_Pos + Len;
               B := B.Next_Block;
            end loop;
            return Result;
         end;
      end if;
   end Tail;

   --  ------------------------------
   --  Get the buffer content as an array.
   --  ------------------------------
   function To_Array (Source : in Builder) return Input is
      Result : Input (1 .. Source.Length);
   begin
      if Source.First.Last > 0 then
         declare
            Pos : Positive := Source.First.Last;
            B   : Block_Access := Source.First.Next_Block;
         begin
            Result (1 .. Pos) := Source.First.Content (1 .. Pos);
            while B /= null loop
               Result (Pos + 1 .. Pos + B.Last) := B.Content (1 .. B.Last);
               Pos := Pos + B.Last;
               B   := B.Next_Block;
            end loop;
         end;
      end if;
      return Result;
   end To_Array;

   --  ------------------------------
   --  Get the element at the given position.
   --  ------------------------------
   function Element (Source   : in Builder;
                     Position : in Positive) return Wiki.Strings.WChar is
   begin
      if Position <= Source.First.Last then
         return Source.First.Content (Position);
      else
         declare
            Pos : Positive := Position - Source.First.Last;
            B   : Block_Access := Source.First.Next_Block;
         begin
            loop
               if Pos <= B.Last then
                  return B.Content (Pos);
               end if;
               Pos := Pos - B.Last;
               B := B.Next_Block;
            end loop;
         end;
      end if;
   end Element;

   --  ------------------------------
   --  Call the <tt>Process</tt> procedure with the full buffer content, trying to avoid
   --  secondary stack copies as much as possible.
   --  ------------------------------
   procedure Get (Source : in Builder) is
   begin
      if Source.Length < Source.First.Len then
         Process (Source.First.Content (1 .. Source.Length));
      else
         declare
            Content : constant Input := To_Array (Source);
         begin
            Process (Content);
         end;
      end if;
   end Get;

   --  ------------------------------
   --  Setup the builder.
   --  ------------------------------
   overriding
   procedure Initialize (Source : in out Builder) is
   begin
      Source.Current := Source.First'Unchecked_Access;
   end Initialize;

   --  ------------------------------
   --  Finalize the builder releasing the storage.
   --  ------------------------------
   overriding
   procedure Finalize (Source : in out Builder) is
   begin
      Clear (Source);
   end Finalize;

   function Count_Occurence (Buffer : in Buffer_Access;
                             From   : in Positive;
                             Item   : in Wiki.Strings.WChar) return Natural is
      Count   : Natural := 0;
      Current : Buffer_Access := Buffer;
      Pos     : Positive := From;
   begin
      while Current /= null loop
         declare
            First : Positive := Pos;
            Last  : Natural := Current.Last;
         begin
            while Pos <= Last and then Current.Content (Pos) = Item loop
               Pos := Pos + 1;
            end loop;
            if Pos > First then
               Count := Count + Pos - First;
            end if;
            exit when Pos <= Last;
         end;
         Current := Current.Next_Block;
         Pos := 1;
      end loop;
      return Count;
   end Count_Occurence;

   procedure Count_Occurence (Buffer : in out Buffer_Access;
                              From   : in out Positive;
                              Item   : in Wiki.Strings.WChar;
                              Count  : out Natural) is
      Current : Buffer_Access := Buffer;
      Pos     : Positive := From;
   begin
      Count := 0;
      while Current /= null loop
         declare
            First : Positive := From;
            Last  : Natural := Current.Last;
         begin
            while Pos <= Last and then Current.Content (Pos) = Item loop
               Pos := Pos + 1;
            end loop;
            if Pos > First then
               Count := Count + Pos - First;
            end if;
            exit when Pos <= Last;
         end;
         Current := Current.Next_Block;
         Pos := 1;
      end loop;
      Buffer := Current;
      From := Pos;
   end Count_Occurence;

   procedure Find (Buffer : in out Buffer_Access;
                   From   : in out Positive;
                   Item   : in Wiki.Strings.WChar) is
      Pos : Positive := From;
   begin
      while Buffer /= null loop
         declare
            Last : constant Natural := Buffer.Last;
         begin
            while Pos <= Last loop
               if Buffer.Content (Pos) = Item then
                  From := Pos;
                  return;
               end if;
               Pos := Pos + 1;
            end loop;
         end;
         Buffer := Buffer.Next_Block;
         Pos := 1;
      end loop;
   end Find;

end Wiki.Buffers;

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

package body Wiki.Buffers is

   subtype Input is Wiki.Strings.WString;
   subtype Block_Access is Buffer_Access;

   --  ------------------------------
   --  Move forward to skip a number of items.
   --  ------------------------------
   procedure Next (Content : in out Buffer_Access;
                   Pos     : in out Positive) is
   begin
      if Pos + 1 > Content.Last then
         Content := Content.Next_Block;
         Pos := 1;
      else
         Pos := Pos + 1;
      end if;
   end Next;

   procedure Next (Content : in out Buffer_Access;
                   Pos     : in out Positive;
                   Count   : in Natural) is
   begin
      for I in 1 .. Count loop
         if Pos + 1 > Content.Last then
            Content := Content.Next_Block;
            Pos := 1;
         else
            Pos := Pos + 1;
         end if;
      end loop;
   end Next;

   --  ------------------------------
   --  Get the length of the item builder.
   --  ------------------------------
   function Length (Source : in Builder) return Natural is
   begin
      return Source.Length;
   end Length;

   --  ------------------------------
   --  Get the capacity of the builder.
   --  ------------------------------
   function Capacity (Source : in Builder) return Natural is
      B : constant Block_Access := Source.Current;
   begin
      return Source.Length + B.Len - B.Last;
   end Capacity;

   --  ------------------------------
   --  Get the builder block size.
   --  ------------------------------
   function Block_Size (Source : in Builder) return Positive is
   begin
      return Source.Block_Size;
   end Block_Size;

   --  ------------------------------
   --  Set the block size for the allocation of next chunks.
   --  ------------------------------
   procedure Set_Block_Size (Source : in out Builder;
                             Size   : in Positive) is
   begin
      Source.Block_Size := Size;
   end Set_Block_Size;

   --  ------------------------------
   --  Append the <tt>New_Item</tt> at the end of the source growing the buffer if necessary.
   --  ------------------------------
   procedure Append (Source   : in out Builder;
                     New_Item : in Input) is
      B     : Block_Access := Source.Current;
      Start : Natural := New_Item'First;
      Last  : constant Natural := New_Item'Last;
   begin
      while Start <= Last loop
         declare
            Space : Natural := B.Len - B.Last;
            Size  : constant Natural := Last - Start + 1;
         begin
            if Space > Size then
               Space := Size;
            elsif Space = 0 then
               if Size > Source.Block_Size then
                  B.Next_Block := new Buffer (Size);
               else
                  B.Next_Block := new Buffer (Source.Block_Size);
               end if;
               B.Next_Block.Offset := B.Offset + B.Len;
               B := B.Next_Block;
               Source.Current := B;
               if B.Len > Size then
                  Space := Size;
               else
                  Space  := B.Len;
               end if;
            end if;
            B.Content (B.Last + 1 .. B.Last + Space) := New_Item (Start .. Start + Space - 1);
            Source.Length := Source.Length + Space;
            B.Last := B.Last + Space;
            Start  := Start + Space;
         end;
      end loop;
   end Append;

   --  ------------------------------
   --  Append the <tt>New_Item</tt> at the end of the source growing the buffer if necessary.
   --  ------------------------------
   procedure Append (Source   : in out Builder;
                     New_Item : in Wiki.Strings.WChar) is
      B     : Block_Access := Source.Current;
   begin
      if B.Len = B.Last then
         B.Next_Block := new Buffer (Source.Block_Size);
         B.Next_Block.Offset := B.Offset + B.Len;
         B := B.Next_Block;
         Source.Current := B;
      end if;
      Source.Length := Source.Length + 1;
      B.Last := B.Last + 1;
      B.Content (B.Last) := New_Item;
   end Append;

   procedure Inline_Append (Source   : in out Builder) is
      B     : Block_Access := Source.Current;
      Last  : Natural;
   begin
      loop
         if B.Len = B.Last then
            B.Next_Block := new Buffer (Source.Block_Size);
            B.Next_Block.Offset := B.Offset + B.Len;
            B := B.Next_Block;
            Source.Current := B;
         end if;
         Process (B.Content (B.Last + 1 .. B.Len), Last);
         exit when Last > B.Len or Last <= B.Last;
         Source.Length := Source.Length + Last - B.Last;
         B.Last := Last;
         exit when Last < B.Len;
      end loop;
   end Inline_Append;

   --  ------------------------------
   --  Append in `Into` builder the `Content` builder starting at `From` position
   --  and the up to and including the `To` position.
   --  ------------------------------
   procedure Append (Into    : in out Builder;
                     Content : in Builder;
                     From    : in Positive;
                     To      : in Positive) is
   begin
      if From <= Content.First.Last then
         if To <= Content.First.Last then
            Append (Into, Content.First.Content (From .. To));
            return;
         end if;
         Append (Into, Content.First.Content (From .. Content.First.Last));
      end if;
      declare
         Pos    : Integer := From - Into.First.Last;
         Last   : Integer := To - Into.First.Last;
         B      : Block_Access := Into.First.Next_Block;
      begin
         loop
            if B = null then
               return;
            end if;
            if Pos <= B.Last then
               if Last <= B.Last then
                  Append (Into, B.Content (1 .. Last));
                  return;
               end if;
               Append (Into, B.Content (1 .. B.Last));
            end if;
            Pos := Pos - B.Last;
            Last := Last - B.Last;
            B := B.Next_Block;
         end loop;
      end;
   end Append;

   procedure Append (Into     : in out Builder;
                     Buffer   : in Buffer_Access;
                     From     : in Positive) is
      Block : Buffer_Access := Buffer;
      Pos   : Positive := From;
      First : Positive := From;
   begin
      while Block /= null loop
         Append (Into, Block.Content (First .. Block.Last));
         Block := Block.Next_Block;
         Pos := 1;
         First := 1;
      end loop;
   end Append;

   --  ------------------------------
   --  Clear the source freeing any storage allocated for the buffer.
   --  ------------------------------
   procedure Clear (Source : in out Builder) is
      procedure Free is
        new Ada.Unchecked_Deallocation (Object => Buffer, Name => Buffer_Access);
      Current, Next : Block_Access;
   begin
      Next := Source.First.Next_Block;
      while Next /= null loop
         Current := Next;
         Next    := Current.Next_Block;
         Free (Current);
      end loop;
      Source.First.Next_Block := null;
      Source.First.Last       := 0;
      Source.Current          := Source.First'Unchecked_Access;
      Source.Length           := 0;
   end Clear;

   --  ------------------------------
   --  Iterate over the buffer content calling the <tt>Process</tt> procedure with each
   --  chunk.
   --  ------------------------------
   procedure Iterate (Source  : in Builder;
                      Process : not null access procedure (Chunk : in Input)) is
   begin
      if Source.First.Last > 0 then
         Process (Source.First.Content (1 .. Source.First.Last));
         declare
            B : Block_Access := Source.First.Next_Block;
         begin
            while B /= null loop
               Process (B.Content (1 .. B.Last));
               B := B.Next_Block;
            end loop;
         end;
      end if;
   end Iterate;

   procedure Inline_Iterate (Source  : in Builder) is
   begin
      if Source.First.Last > 0 then
         Process (Source.First.Content (1 .. Source.First.Last));
         declare
            B : Block_Access := Source.First.Next_Block;
         begin
            while B /= null loop
               Process (B.Content (1 .. B.Last));
               B := B.Next_Block;
            end loop;
         end;
      end if;
   end Inline_Iterate;

   procedure Inline_Update (Source  : in out Builder) is
   begin
      if Source.First.Last > 0 then
         Process (Source.First.Content (1 .. Source.First.Last));
         declare
            B : Block_Access := Source.First.Next_Block;
         begin
            while B /= null loop
               Process (B.Content (1 .. B.Last));
               B := B.Next_Block;
            end loop;
         end;
      end if;
   end Inline_Update;

   --  ------------------------------
   --  Return the content starting from the tail and up to <tt>Length</tt> items.
   --  ------------------------------
   function Tail (Source : in Builder;
                  Length : in Natural) return Input is
      Last : constant Natural := Source.Current.Last;
   begin
      if Last >= Length then
         return Source.Current.Content (Last - Length + 1 .. Last);
      elsif Length >= Source.Length then
         return To_Array (Source);
      else
         declare
            Result  : Input (1 .. Length);
            Offset  : Natural := Source.Length - Length;
            B       : access constant Buffer := Source.First'Access;
            Src_Pos : Positive := 1;
            Dst_Pos : Positive := 1;
            Len     : Natural;
         begin
            --  Skip the data moving to next blocks as needed.
            while Offset /= 0 loop
               if Offset < B.Last then
                  Src_Pos := Offset + 1;
                  Offset := 0;
               else
                  Offset := Offset - B.Last + 1;
                  B := B.Next_Block;
               end if;
            end loop;

            --  Copy what remains until we reach the length.
            while Dst_Pos <= Length loop
               Len := B.Last - Src_Pos + 1;
               Result (Dst_Pos .. Dst_Pos + Len - 1) := B.Content (Src_Pos .. B.Last);
               Src_Pos := 1;
               Dst_Pos := Dst_Pos + Len;
               B := B.Next_Block;
            end loop;
            return Result;
         end;
      end if;
   end Tail;

   --  ------------------------------
   --  Get the buffer content as an array.
   --  ------------------------------
   function To_Array (Source : in Builder) return Input is
      Result : Input (1 .. Source.Length);
   begin
      if Source.First.Last > 0 then
         declare
            Pos : Positive := Source.First.Last;
            B   : Block_Access := Source.First.Next_Block;
         begin
            Result (1 .. Pos) := Source.First.Content (1 .. Pos);
            while B /= null loop
               Result (Pos + 1 .. Pos + B.Last) := B.Content (1 .. B.Last);
               Pos := Pos + B.Last;
               B   := B.Next_Block;
            end loop;
         end;
      end if;
      return Result;
   end To_Array;

   --  ------------------------------
   --  Get the element at the given position.
   --  ------------------------------
   function Element (Source   : in Builder;
                     Position : in Positive) return Wiki.Strings.WChar is
   begin
      if Position <= Source.First.Last then
         return Source.First.Content (Position);
      else
         declare
            Pos : Positive := Position - Source.First.Last;
            B   : Block_Access := Source.First.Next_Block;
         begin
            loop
               if Pos <= B.Last then
                  return B.Content (Pos);
               end if;
               Pos := Pos - B.Last;
               B := B.Next_Block;
            end loop;
         end;
      end if;
   end Element;

   --  ------------------------------
   --  Call the <tt>Process</tt> procedure with the full buffer content, trying to avoid
   --  secondary stack copies as much as possible.
   --  ------------------------------
   procedure Get (Source : in Builder) is
   begin
      if Source.Length < Source.First.Len then
         Process (Source.First.Content (1 .. Source.Length));
      else
         declare
            Content : constant Input := To_Array (Source);
         begin
            Process (Content);
         end;
      end if;
   end Get;

   --  ------------------------------
   --  Setup the builder.
   --  ------------------------------
   overriding
   procedure Initialize (Source : in out Builder) is
   begin
      Source.Current := Source.First'Unchecked_Access;
   end Initialize;

   --  ------------------------------
   --  Finalize the builder releasing the storage.
   --  ------------------------------
   overriding
   procedure Finalize (Source : in out Builder) is
   begin
      Clear (Source);
   end Finalize;

   function Count_Occurence (Buffer : in Buffer_Access;
                             From   : in Positive;
                             Item   : in Wiki.Strings.WChar) return Natural is
      Count   : Natural := 0;
      Current : Buffer_Access := Buffer;
      Pos     : Positive := From;
   begin
      while Current /= null loop
         declare
            First : Positive := Pos;
            Last  : Natural := Current.Last;
         begin
            while Pos <= Last and then Current.Content (Pos) = Item loop
               Pos := Pos + 1;
            end loop;
            if Pos > First then
               Count := Count + Pos - First;
            end if;
            exit when Pos <= Last;
         end;
         Current := Current.Next_Block;
         Pos := 1;
      end loop;
      return Count;
   end Count_Occurence;

   procedure Count_Occurence (Buffer : in out Buffer_Access;
                              From   : in out Positive;
                              Item   : in Wiki.Strings.WChar;
                              Count  : out Natural) is
      Current : Buffer_Access := Buffer;
      Pos     : Positive := From;
   begin
      Count := 0;
      while Current /= null loop
         declare
            First : Positive := From;
            Last  : Natural := Current.Last;
         begin
            while Pos <= Last and then Current.Content (Pos) = Item loop
               Pos := Pos + 1;
            end loop;
            if Pos > First then
               Count := Count + Pos - First;
            end if;
            exit when Pos <= Last;
         end;
         Current := Current.Next_Block;
         Pos := 1;
      end loop;
      Buffer := Current;
      From := Pos;
   end Count_Occurence;

   procedure Find (Buffer : in out Buffer_Access;
                   From   : in out Positive;
                   Item   : in Wiki.Strings.WChar) is
      Pos : Positive := From;
   begin
      while Buffer /= null loop
         declare
            Last : constant Natural := Buffer.Last;
         begin
            while Pos <= Last loop
               if Buffer.Content (Pos) = Item then
                  From := Pos;
                  return;
               end if;
               Pos := Pos + 1;
            end loop;
         end;
         Buffer := Buffer.Next_Block;
         Pos := 1;
      end loop;
   end Find;

end Wiki.Buffers;

Add Next procedure

Add Next procedure


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

with Wiki.Attributes;
with Wiki.Plugins;
with Wiki.Filters;
with Wiki.Strings;
with Wiki.Documents;
with Wiki.Streams;

--  == Wiki Parsers ==
--  The Wikis.Parsers package implements a parser for several well known wiki formats.
--  The parser works with the Document_Reader interface type which defines several
--  procedures that are called by the parser when the wiki text is scanned.
package Wiki.Parsers is

   pragma Preelaborate;

   type Parser is tagged limited private;

   --  Add the plugin to the wiki engine.
   procedure Add_Plugin (Engine : in out Parser;
                         Name   : in String;
                         Plugin : in Wiki.Plugins.Wiki_Plugin_Access);

   --  Set the wiki syntax that the wiki engine must use.
   procedure Set_Syntax (Engine : in out Parser;
                         Syntax : in Wiki_Syntax := SYNTAX_MIX);

   --  Add a filter in the wiki engine.
   procedure Add_Filter (Engine : in out Parser;
                         Filter : in Wiki.Filters.Filter_Type_Access);

   --  Parse the wiki text contained in Text according to the wiki syntax
   --  defined on the parser.
   procedure Parse (Engine : in out Parser;
                    Text   : in Wide_Wide_String;
                    Doc    : in out Wiki.Documents.Document);

   --  Parse the wiki stream managed by <tt>Stream</tt> according to the wiki syntax configured
   --  on the wiki engine.
   procedure Parse (Engine : in out Parser;
                    Stream : in Wiki.Streams.Input_Stream_Access;
                    Doc    : in out Wiki.Documents.Document);

private

   type Parser is tagged limited record
      Pending             : Wide_Wide_Character;
      Has_Pending         : Boolean;
      Syntax              : Wiki_Syntax;
      Document            : Wiki.Documents.Document;
      Filters             : Wiki.Filters.Filter_Chain;
      Format              : Wiki.Format_Map;
      Text                : Wiki.Strings.BString (512);
      Token               : Wiki.Strings.BString (512);
      Empty_Line          : Boolean := True;
      Is_Eof              : Boolean := False;
      In_Paragraph        : Boolean := False;
      In_List             : Boolean := False;
      Need_Paragraph      : Boolean := True;
      Link_Double_Bracket : Boolean := False;
      Is_Dotclear         : Boolean := False;
      Link_Title_First    : Boolean := False;
      Check_Image_Link    : Boolean := False;
      Header_Offset       : Integer := 0;
      Quote_Level         : Natural := 0;
      Escape_Char         : Wide_Wide_Character;
      List_Level          : Natural := 0;
      Reader              : Wiki.Streams.Input_Stream_Access := null;
      Attributes          : Wiki.Attributes.Attribute_List;
   end record;

   type Parser_Handler is access procedure (P     : in out Parser;
                                            Token : in Wide_Wide_Character);

   type Parser_Table is array (0 .. 127) of Parser_Handler;
   type Parser_Table_Access is access Parser_Table;

   --  Peek the next character from the wiki text buffer.
   procedure Peek (P     : in out Parser;
                   Token : out Wide_Wide_Character);

   --  Put back the character so that it will be returned by the next call to Peek.
   procedure Put_Back (P     : in out Parser;
                       Token : in Wide_Wide_Character);

   --  Skip all the spaces and tabs as well as end of the current line (CR+LF).
   procedure Skip_End_Of_Line (P : in out Parser);

   --  Skip white spaces and tabs.
   procedure Skip_Spaces (P : in out Parser);

   --  Flush the wiki text that was collected in the text buffer.
   procedure Flush_Text (P : in out Parser);

   --  Flush the wiki dl/dt/dd definition list.
   procedure Flush_List (P : in out Parser);

   --  Append a character to the wiki text buffer.
   procedure Parse_Text (P     : in out Parser;
                         Token : in Wide_Wide_Character);

   --  Check if the link refers to an image and must be rendered as an image.
   function Is_Image (P    : in Parser;
                      Link : in Wide_Wide_String) return Boolean;

   procedure Start_Element (P          : in out Parser;
                            Tag        : in Wiki.Html_Tag;
                            Attributes : in out Wiki.Attributes.Attribute_List);

   procedure End_Element (P    : in out Parser;
                          Tag  : in Wiki.Html_Tag);

end Wiki.Parsers;

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

with Wiki.Attributes;
with Wiki.Plugins;
with Wiki.Filters;
with Wiki.Strings;
with Wiki.Documents;
with Wiki.Streams;

--  === Wiki Parsers ===
--  The Wikis.Parsers package implements a parser for several well known wiki formats
--  but also for HTML.  While reading the input, the parser populates a wiki <tt>Document</tt>
--  instance with headers, paragraphs, links, and other elements.
--
--     Doc    : Wiki.Documents.Document;
--     Engine : Wiki.Parsers.Parser;
--
--  Before using the parser, it must be configured to choose the syntax by using the
--  <tt>Set_Syntax</tt> procedure:
--
--    Engine.Set_Syntax (Wiki.SYNTAX_HTML);
--
--  The parser can be configured to use filters.  A filter is added by using the
--  <tt>Add_Filter</tt> procedure.  A filter is added at begining of the chain so that
--  the filter added last is called first.
--
--  The <tt>Parse</tt> procedure is then used to parse either a string content or some stream
--  represented by the <tt>Input_Stream</tt> interface.  After the <tt>Parse</tt> procedure
--  completes, the <tt>Document</tt> instance holds the wiki document.
--
--    Engine.Parse (Some_Text, Doc);
--
package Wiki.Parsers is

   pragma Preelaborate;

   type Parser is tagged limited private;

   --  Add the plugin to the wiki engine.
   procedure Add_Plugin (Engine : in out Parser;
                         Name   : in String;
                         Plugin : in Wiki.Plugins.Wiki_Plugin_Access);

   --  Set the wiki syntax that the wiki engine must use.
   procedure Set_Syntax (Engine : in out Parser;
                         Syntax : in Wiki_Syntax := SYNTAX_MIX);

   --  Add a filter in the wiki engine.
   procedure Add_Filter (Engine : in out Parser;
                         Filter : in Wiki.Filters.Filter_Type_Access);

   --  Parse the wiki text contained in Text according to the wiki syntax
   --  defined on the parser.
   procedure Parse (Engine : in out Parser;
                    Text   : in Wiki.Strings.WString;
                    Doc    : in out Wiki.Documents.Document);

   --  Parse the wiki stream managed by <tt>Stream</tt> according to the wiki syntax configured
   --  on the wiki engine.
   procedure Parse (Engine : in out Parser;
                    Stream : in Wiki.Streams.Input_Stream_Access;
                    Doc    : in out Wiki.Documents.Document);

private

   type Parser is tagged limited record
      Pending             : Wiki.Strings.WChar;
      Has_Pending         : Boolean;
      Syntax              : Wiki_Syntax;
      Document            : Wiki.Documents.Document;
      Filters             : Wiki.Filters.Filter_Chain;
      Format              : Wiki.Format_Map;
      Text                : Wiki.Strings.BString (512);
      Token               : Wiki.Strings.BString (512);
      Empty_Line          : Boolean := True;
      Is_Eof              : Boolean := False;
      In_Paragraph        : Boolean := False;
      In_List             : Boolean := False;
      Need_Paragraph      : Boolean := True;
      Link_Double_Bracket : Boolean := False;
      Is_Dotclear         : Boolean := False;
      Link_Title_First    : Boolean := False;
      Check_Image_Link    : Boolean := False;
      Header_Offset       : Integer := 0;
      Quote_Level         : Natural := 0;
      Escape_Char         : Wiki.Strings.WChar;
      List_Level          : Natural := 0;
      Reader              : Wiki.Streams.Input_Stream_Access := null;
      Attributes          : Wiki.Attributes.Attribute_List;
   end record;

   type Parser_Handler is access procedure (P     : in out Parser;
                                            Token : in Wiki.Strings.WChar);

   type Parser_Table is array (0 .. 127) of Parser_Handler;
   type Parser_Table_Access is access Parser_Table;

   --  Peek the next character from the wiki text buffer.
   procedure Peek (P     : in out Parser;
                   Token : out Wiki.Strings.WChar);

   --  Put back the character so that it will be returned by the next call to Peek.
   procedure Put_Back (P     : in out Parser;
                       Token : in Wiki.Strings.WChar);

   --  Skip all the spaces and tabs as well as end of the current line (CR+LF).
   procedure Skip_End_Of_Line (P : in out Parser);

   --  Skip white spaces and tabs.
   procedure Skip_Spaces (P : in out Parser);

   --  Flush the wiki text that was collected in the text buffer.
   procedure Flush_Text (P : in out Parser);

   --  Flush the wiki dl/dt/dd definition list.
   procedure Flush_List (P : in out Parser);

   --  Append a character to the wiki text buffer.
   procedure Parse_Text (P     : in out Parser;
                         Token : in Wiki.Strings.WChar);

   --  Check if the link refers to an image and must be rendered as an image.
   function Is_Image (P    : in Parser;
                      Link : in Wiki.Strings.WString) return Boolean;

   procedure Start_Element (P          : in out Parser;
                            Tag        : in Wiki.Html_Tag;
                            Attributes : in out Wiki.Attributes.Attribute_List);

   procedure End_Element (P    : in out Parser;
                          Tag  : in Wiki.Html_Tag);

end Wiki.Parsers;

Add some documentation

Add some documentation


-----------------------------------------------------------------------
--  util-log-locations -- General purpose source file location
--  Copyright (C) 2009, 2010, 2011, 2012, 2013, 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 Util.Strings;
package body Util.Log.Locations is

   --  ------------------------------
   --  Create a File_Info record to identify the file whose path is Path
   --  and whose relative path portion starts at Relative_Position.
   --  ------------------------------
   function Create_File_Info (Path              : in String;
                              Relative_Position : in Natural) return File_Info_Access is
   begin
      return new File_Info '(Length       => Path'Length,
                             Path         => Path,
                             Relative_Pos => Relative_Position);
   end Create_File_Info;

   --  ------------------------------
   --  Get the relative path name
   --  ------------------------------
   function Relative_Path (File : in File_Info) return String is
   begin
      return File.Path (File.Relative_Pos .. File.Path'Last);
   end Relative_Path;

   --  ------------------------------
   --  Get the line number
   --  ------------------------------
   function Line (Info : Line_Info) return Natural is
   begin
      return Info.Line;
   end Line;

   --  ------------------------------
   --  Get the column number
   --  ------------------------------
   function Column (Info : Line_Info) return Natural is
   begin
      return Info.Column;
   end Column;

   --  ------------------------------
   --  Get the source file
   --  ------------------------------
   function File (Info : Line_Info) return String is
   begin
      return Info.File.Path;
   end File;

   --  ------------------------------
   --  Create a source line information.
   --  ------------------------------
   function Create_Line_Info (File   : in File_Info_Access;
                              Line   : in Natural;
                              Column : in Natural := 0) return Line_Info is
      Result : Line_Info;
   begin
      Result.Line   := Line;
      Result.Column := Column;
      if File = null then
         Result.File := NO_FILE'Access;
      else
         Result.File := File;
      end if;
      return Result;
   end Create_Line_Info;

   --  ------------------------------
   --  Get a printable representation of the line information using
   --  the format:
   --    <path>:<line>[:<column>]
   --  The path can be reported as relative or absolute path.
   --  The column is optional and reported by default.
   --  ------------------------------
   function To_String (Info     : in Line_Info;
                       Relative : in Boolean := True;
                       Column   : in Boolean := True) return String is
   begin
      if Relative then
         if Column then
            return Relative_Path (Info.File.all) & ":" & Util.Strings.Image (Info.Line)
               & ":" & Util.Strings.Image (Info.Column);
         else
            return Relative_Path (Info.File.all) & ":" & Util.Strings.Image (Info.Line);
         end if;
      else
         if Column then
            return Info.File.Path & ":" & Util.Strings.Image (Info.Line)
               & ":" & Util.Strings.Image (Info.Column);
         else
            return Info.File.Path & ":" & Util.Strings.Image (Info.Line);
         end if;
      end if;
   end To_String;

end Util.Log.Locations;

-----------------------------------------------------------------------
--  util-log-locations -- General purpose source file location
--  Copyright (C) 2009, 2010, 2011, 2012, 2013, 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 Util.Strings;
package body Util.Log.Locations is

   --  ------------------------------
   --  Create a File_Info record to identify the file whose path is Path
   --  and whose relative path portion starts at Relative_Position.
   --  ------------------------------
   function Create_File_Info (Path              : in String;
                              Relative_Position : in Natural) return File_Info_Access is
   begin
      return new File_Info '(Length       => Path'Length,
                             Path         => Path,
                             Relative_Pos => Relative_Position);
   end Create_File_Info;

   --  ------------------------------
   --  Get the relative path name
   --  ------------------------------
   function Relative_Path (File : in File_Info) return String is
   begin
      return File.Path (File.Relative_Pos .. File.Path'Last);
   end Relative_Path;

   --  ------------------------------
   --  Get the line number
   --  ------------------------------
   function Line (Info : Line_Info) return Natural is
   begin
      return Info.Line;
   end Line;

   --  ------------------------------
   --  Get the column number
   --  ------------------------------
   function Column (Info : Line_Info) return Natural is
   begin
      return Info.Column;
   end Column;

   --  ------------------------------
   --  Get the source file
   --  ------------------------------
   function File (Info : Line_Info) return String is
   begin
      return Info.File.Path;
   end File;

   --  ------------------------------
   --  Compare the two source location.  The comparison is made on:
   --  o the source file,
   --  o the line number,
   --  o the column.
   --  ------------------------------
   function "<" (Left, Right : in Line_Info) return Boolean is
   begin
      if Left.File.Path < Right.File.Path then
         return True;
      elsif Left.File.Path > Right.File.Path then
         return False;
      elsif Left.Line < Right.Line then
         return True;
      elsif Left.Line > Right.Line then
         return False;
      else
         return Left.Column < Right.Column;
      end if;
   end "<";

   --  ------------------------------
   --  Create a source line information.
   --  ------------------------------
   function Create_Line_Info (File   : in File_Info_Access;
                              Line   : in Natural;
                              Column : in Natural := 0) return Line_Info is
      Result : Line_Info;
   begin
      Result.Line   := Line;
      Result.Column := Column;
      if File = null then
         Result.File := NO_FILE'Access;
      else
         Result.File := File;
      end if;
      return Result;
   end Create_Line_Info;

   --  ------------------------------
   --  Get a printable representation of the line information using
   --  the format:
   --    <path>:<line>[:<column>]
   --  The path can be reported as relative or absolute path.
   --  The column is optional and reported by default.
   --  ------------------------------
   function To_String (Info     : in Line_Info;
                       Relative : in Boolean := True;
                       Column   : in Boolean := True) return String is
   begin
      if Relative then
         if Column then
            return Relative_Path (Info.File.all) & ":" & Util.Strings.Image (Info.Line)
               & ":" & Util.Strings.Image (Info.Column);
         else
            return Relative_Path (Info.File.all) & ":" & Util.Strings.Image (Info.Line);
         end if;
      else
         if Column then
            return Info.File.Path & ":" & Util.Strings.Image (Info.Line)
               & ":" & Util.Strings.Image (Info.Column);
         else
            return Info.File.Path & ":" & Util.Strings.Image (Info.Line);
         end if;
      end if;
   end To_String;

end Util.Log.Locations;

Implement the "<" function to compare two source locations


--                              -*- Mode: Ada -*-
--  Filename        : bare_bones.adb
--  Description     : A "hello world" style OS kernel written in Ada.
--  Author          : Luke A. Guest
--  Created On      : Thu Jun 14 11:59:53 2012
--  Licence         : See LICENCE in the root directory.
with Console; use Console;
with Multiboot; use Multiboot;
with System.Address_To_Access_Conversions;
with Ada.Unchecked_Conversion;

use type Multiboot.Magic_Values;

procedure Bare_Bones is
   Line : Screen_Height_Range := Screen_Height_Range'First;
begin
   Clear;

   Put ("Hello, bare bones in Ada",
        Screen_Width_Range'First,
        Line);

   Line := Line + 1;

   if Magic = Magic_Value then
      Put ("Magic numbers match!", Screen_Width_Range'First, Line);
   else
      Put ("Magic numbers don't match!", Screen_Width_Range'First, Line);

      raise Program_Error;
   end if;

   Line := Line + 1;

   if Info.Flags.Memory then
      Put ("Memory info present", Screen_Width_Range'First, Line);

      Line := Line + 1;
   end if;

   if Info.Flags.Boot_Device then
      Put ("Boot device info present", Screen_Width_Range'First, Line);

      Line := Line + 1;
   end if;

   if Info.Flags.Command_Line then
      Put ("Command line info present", Screen_Width_Range'First, Line);

      Line := Line + 1;
   end if;

   if Info.Flags.Modules then
      Put ("Modules info present", Screen_Width_Range'First, Line);

      Line := Line + 1;

      if Info.Modules.Count = 2 then
         declare
            type My_Modules_Array is new Modules_Array
              (1 .. Natural (Info.Modules.Count));
            type My_Modules_Array_Access is access all My_Modules_Array;

            --  My_Modules : aliased Modules_Array
            --    (1 .. Natural (Info.Modules.Count));
            --  pragma Unreferenced (My_Modules);

            package To_Modules is new System.Address_To_Access_Conversions
              (Object => My_Modules_Array_Access);

            function Conv is new Ada.Unchecked_Conversion
              (Source => To_Modules.Object_Pointer,
               Target => My_Modules_Array_Access);

            Modules : constant My_Modules_Array_Access :=
              Conv (To_Modules.To_Pointer
                      (Info.Modules.First));

            M : Multiboot.Modules;
            pragma Unreferenced (M);
         begin
            Put ("2 modules loaded is correct",
                 Screen_Width_Range'First, Line);

            for I in 1 .. Info.Modules.Count loop
               M := Modules (Natural (I));
            end loop;

            Line := Line + 1;
         end;
      end if;
   end if;

   if Info.Flags.Symbol_Table then
      Put ("Symbol table info present", Screen_Width_Range'First, Line);

      Line := Line + 1;
   end if;

   if Info.Flags.Section_Header_Table then
      Put ("Section header table info present",
         Screen_Width_Range'First, Line);

      Line := Line + 1;
   end if;

   if Info.Flags.BIOS_Memory_Map then
      Put ("BIOS memory map info present", Screen_Width_Range'First, Line);

      Line := Line + 1;

      declare
         Map : Memory_Map_Entry_Access := Multiboot.First_Memory_Map_Entry;
      begin
         while Map /= null loop
            Map := Multiboot.Next_Memory_Map_Entry (Map);
         end loop;
      end;
   end if;

   if Info.Flags.Drives then
      Put ("Drives info present", Screen_Width_Range'First, Line);

      Line := Line + 1;
   end if;

   if Info.Flags.ROM_Configuration then
      Put ("ROM configuration info present", Screen_Width_Range'First, Line);

      Line := Line + 1;
   end if;

   if Info.Flags.Boot_Loader then
      Put ("Boot loader info present", Screen_Width_Range'First, Line);

      Line := Line + 1;
   end if;

   if Info.Flags.APM_Table then
      Put ("APM table info present", Screen_Width_Range'First, Line);

      Line := Line + 1;
   end if;

   if Info.Flags.Graphics_Table then
      Put ("Graphics table info present", Screen_Width_Range'First, Line);

      Line := Line + 1;
   end if;

   --  raise Console.TE;
   --  raise Constraint_Error;

   --  Put (Natural 'Image (54),
   --       Screen_Width_Range'First,
   --       Screen_Height_Range'First + 1);
--  exception
--     when Constraint_Error =>
--        Put ("Constraint Error caught", 1, 2);
   --  when Console.TE =>
   --     Put ("TE caught", 1, 2);
end Bare_Bones;
pragma No_Return (Bare_Bones);

--                              -*- Mode: Ada -*-
--  Filename        : bare_bones.adb
--  Description     : A "hello world" style OS kernel written in Ada.
--  Author          : Luke A. Guest
--  Created On      : Thu Jun 14 11:59:53 2012
--  Licence         : See LICENCE in the root directory.
pragma Restrictions (No_Obsolescent_Features);
--  with Console; use Console;
--  with Multiboot; use Multiboot;
--  with System.Address_To_Access_Conversions;
--  with Ada.Unchecked_Conversion;

--  use type Multiboot.Magic_Values;

procedure Bare_Bones is
   --  Line : Screen_Height_Range := Screen_Height_Range'First;
begin
   null;
   --  Clear;

   --  Put ("Hello, bare bones in Ada",
   --       Screen_Width_Range'First,
   --       Line);

   --  Line := Line + 1;

   --  if Magic = Magic_Value then
   --     Put ("Magic numbers match!", Screen_Width_Range'First, Line);
   --  else
   --     Put ("Magic numbers don't match!", Screen_Width_Range'First, Line);

   --     raise Program_Error;
   --  end if;

   --  Line := Line + 1;

   --  if Info.Flags.Memory then
   --     Put ("Memory info present", Screen_Width_Range'First, Line);

   --     Line := Line + 1;
   --  end if;

   --  if Info.Flags.Boot_Device then
   --     Put ("Boot device info present", Screen_Width_Range'First, Line);

   --     Line := Line + 1;
   --  end if;

   --  if Info.Flags.Command_Line then
   --     Put ("Command line info present", Screen_Width_Range'First, Line);

   --     Line := Line + 1;
   --  end if;

   --  if Info.Flags.Modules then
   --     Put ("Modules info present", Screen_Width_Range'First, Line);

   --     Line := Line + 1;

   --     if Info.Modules.Count = 2 then
   --        declare
   --           type My_Modules_Array is new Modules_Array
   --             (1 .. Natural (Info.Modules.Count));
   --           type My_Modules_Array_Access is access all My_Modules_Array;

   --           --  My_Modules : aliased Modules_Array
   --           --    (1 .. Natural (Info.Modules.Count));
   --           --  pragma Unreferenced (My_Modules);

   --           package To_Modules is new System.Address_To_Access_Conversions
   --             (Object => My_Modules_Array_Access);

   --           function Conv is new Ada.Unchecked_Conversion
   --             (Source => To_Modules.Object_Pointer,
   --              Target => My_Modules_Array_Access);

   --           Modules : constant My_Modules_Array_Access :=
   --             Conv (To_Modules.To_Pointer
   --                     (Info.Modules.First));

   --           M : Multiboot.Modules;
   --           pragma Unreferenced (M);
   --        begin
   --           Put ("2 modules loaded is correct",
   --                Screen_Width_Range'First, Line);

   --           for I in 1 .. Info.Modules.Count loop
   --              M := Modules (Natural (I));
   --           end loop;

   --           Line := Line + 1;
   --        end;
   --     end if;
   --  end if;

   --  if Info.Flags.Symbol_Table then
   --     Put ("Symbol table info present", Screen_Width_Range'First, Line);

   --     Line := Line + 1;
   --  end if;

   --  if Info.Flags.Section_Header_Table then
   --     Put ("Section header table info present",
   --        Screen_Width_Range'First, Line);

   --     Line := Line + 1;
   --  end if;

   --  if Info.Flags.BIOS_Memory_Map then
   --     Put ("BIOS memory map info present", Screen_Width_Range'First, Line);

   --     Line := Line + 1;

   --     declare
   --        Map : Memory_Map_Entry_Access := Multiboot.First_Memory_Map_Entry;
   --     begin
   --        while Map /= null loop
   --           Map := Multiboot.Next_Memory_Map_Entry (Map);
   --        end loop;
   --     end;
   --  end if;

   --  if Info.Flags.Drives then
   --     Put ("Drives info present", Screen_Width_Range'First, Line);

   --     Line := Line + 1;
   --  end if;

   --  if Info.Flags.ROM_Configuration then
   --     Put ("ROM configuration info present",
   --          Screen_Width_Range'First, Line);

   --     Line := Line + 1;
   --  end if;

   --  if Info.Flags.Boot_Loader then
   --     Put ("Boot loader info present", Screen_Width_Range'First, Line);

   --     Line := Line + 1;
   --  end if;

   --  if Info.Flags.APM_Table then
   --     Put ("APM table info present", Screen_Width_Range'First, Line);

   --     Line := Line + 1;
   --  end if;

   --  if Info.Flags.Graphics_Table then
   --     Put ("Graphics table info present", Screen_Width_Range'First, Line);

   --     Line := Line + 1;
   --  end if;

   --  raise Constraint_Error;

   --  raise Console.TE;
   --  raise Constraint_Error;

   --  Put (Natural 'Image (54),
   --       Screen_Width_Range'First,
   --       Screen_Height_Range'First + 1);
--  exception
--     when Constraint_Error =>
--        Put ("Constraint Error caught", 1, 15);
--     when Program_Error =>
--        null;
      --  when Console.TE =>
   --     Put ("TE caught", 1, 2);
end Bare_Bones;
pragma No_Return (Bare_Bones);

Comment out the PC stuff.

Comment out the PC stuff.


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

with ADO.Sequences.Hilo;
with Ada.Unchecked_Deallocation;

--  The <b>ADO.Sessions.Factory</b> package defines the factory for creating
--  sessions.
package body ADO.Sessions.Factory is

   use ADO.Databases;

   --  ------------------------------
   --  Open a session
   --  ------------------------------
   procedure Open_Session (Factory  : in out Session_Factory;
                           Database : out Session) is
      S  : constant Session_Record_Access := new Session_Record;
      DB : constant Master_Connection'Class := Factory.Source.Get_Connection;
   begin
      S.Database := Master_Connection (DB);
      S.Entities := Factory.Entities;
      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;
      DB : constant Master_Connection'Class := Factory.Source.Get_Connection;
   begin
      S.Database := Master_Connection (DB);
      S.Entities := Factory.Entities;
      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_Proxy_Access) return Session is
      R : Session;
   begin
      if Proxy = null then
         raise ADO.Objects.SESSION_EXPIRED;
      end if;
      if Proxy.Session = null then
         raise ADO.Objects.SESSION_EXPIRED;
      end if;
      R.Impl := Proxy.Session;
      R.Impl.Counter := R.Impl.Counter + 1;
      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;
--        if Proxy.Session = null then
--           raise ADO.Objects.SESSION_EXPIRED;
--        end if;
      R.Impl := Proxy;
      R.Impl.Counter := R.Impl.Counter + 1;
      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;
      DB : constant Master_Connection'Class := Factory.Source.Get_Connection;
   begin
      S.Database := Master_Connection (DB);
      S.Entities := Factory.Entities;
      R.Impl := S;
      R.Sequences := Factory.Sequences;
      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.Databases.DataSource) is
   begin
      Factory.Source := Source;
      Factory.Entities := Factory.Entity_Cache'Unchecked_Access;
      Initialize_Sequences (Factory);

      if Factory.Source.Get_Database /= "" then
         declare
            S : Session := Factory.Get_Session;
         begin
            ADO.Schemas.Entities.Initialize (Factory.Entity_Cache, 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 := Factory.Entity_Cache'Unchecked_Access;
      Initialize_Sequences (Factory);

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

end ADO.Sessions.Factory;

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

with ADO.Sequences.Hilo;
with Ada.Unchecked_Deallocation;

--  The <b>ADO.Sessions.Factory</b> package defines the factory for creating
--  sessions.
package body ADO.Sessions.Factory is

   use ADO.Databases;

   --  ------------------------------
   --  Open a session
   --  ------------------------------
   procedure Open_Session (Factory  : in out Session_Factory;
                           Database : out Session) is
      S  : constant Session_Record_Access := new Session_Record;
      DB : constant Master_Connection'Class := Factory.Source.Get_Connection;
   begin
      S.Database := Master_Connection (DB);
      S.Entities := Factory.Entities;
      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;
      DB : constant Master_Connection'Class := Factory.Source.Get_Connection;
   begin
      S.Database := Master_Connection (DB);
      S.Entities := Factory.Entities;
      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_Proxy_Access) return Session is
      R : Session;
   begin
      if Proxy = null then
         raise ADO.Objects.SESSION_EXPIRED;
      end if;
      if Proxy.Session = null then
         raise ADO.Objects.SESSION_EXPIRED;
      end if;
      R.Impl := Proxy.Session;
      R.Impl.Counter := R.Impl.Counter + 1;
      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;
--        if Proxy.Session = null then
--           raise ADO.Objects.SESSION_EXPIRED;
--        end if;
      R.Impl := Proxy;
      R.Impl.Counter := R.Impl.Counter + 1;
      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;
      DB : constant Master_Connection'Class := Factory.Source.Get_Connection;
      S  : constant Session_Record_Access   := new Session_Record;
   begin
      R.Impl := S;
      R.Sequences := Factory.Sequences;
      S.Database := Master_Connection (DB);
      S.Entities := Factory.Entities;
      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.Databases.DataSource) is
   begin
      Factory.Source := Source;
      Factory.Entities := Factory.Entity_Cache'Unchecked_Access;
      Initialize_Sequences (Factory);

      if Factory.Source.Get_Database /= "" then
         declare
            S : Session := Factory.Get_Session;
         begin
            ADO.Schemas.Entities.Initialize (Factory.Entity_Cache, 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 := Factory.Entity_Cache'Unchecked_Access;
      Initialize_Sequences (Factory);

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

end ADO.Sessions.Factory;

Fix possible memory leak if the connection cannot be obtained: create the Session_Record only after having created the database connection.


-----------------------------------------------------------------------
--  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.
-----------------------------------------------------------------------

package Gen.Commands.Plugins is

   --  ------------------------------
   --  Generator Command
   --  ------------------------------
   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.Plugins;

-----------------------------------------------------------------------
--  gen-commands-plugins -- Plugin creation and management commands for dynamo
--  Copyright (C) 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.
-----------------------------------------------------------------------

package Gen.Commands.Plugins is

   --  ------------------------------
   --  Generator Command
   --  ------------------------------
   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.Plugins;

Update to use the new command implementation