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

with Util.Log.Loggers;
with Util.Files;
with Util.Encoders.Base16;
package body Babel.Files is

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

   Hex_Encoder : Util.Encoders.Base16.Encoder;

   --  ------------------------------
   --  Compare two files on their name and directory.
   --  ------------------------------
   function "<" (Left, Right : in File_Type) return Boolean is
      use type Ada.Strings.Unbounded.Unbounded_String;
   begin
      if Left = NO_FILE then
         return False;
      elsif Right = NO_FILE then
         return True;
      elsif Left.Dir = Right.Dir then
         return Left.Name < Right.Name;
      elsif Left.Dir = NO_DIRECTORY then
         return True;
      elsif Right.Dir = NO_DIRECTORY then
         return False;
      else
         return Left.Dir.Path < Right.Dir.Path;
      end if;
   end "<";

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

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

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

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

   --  ------------------------------
   --  Return true if the file is a new file.
   --  ------------------------------
   function Is_New (Element : in File_Type) return Boolean is
      use type ADO.Identifier;
   begin
      return Element.Id = NO_IDENTIFIER;
   end Is_New;

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

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

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

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

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

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

   --  ------------------------------
   --  Return the file size.
   --  ------------------------------
   function Get_Size (Element : in File_Type) return File_Size is
   begin
      return Element.Size;
   end Get_Size;

   --  ------------------------------
   --  Return the file modification date.
   --  ------------------------------
   function Get_Date (Element : in File_Type) return Ada.Calendar.Time is
   begin
      return Element.Date;
   end Get_Date;

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

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

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

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

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

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

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

   --  ------------------------------
   --  Execute the Process procedure on each directory found in the container.
   --  ------------------------------
   overriding
   procedure Each_Directory (Container : in Default_Container;
                             Process   : not null access
                               procedure (Dir : in Directory_Type)) is
      Iter : Directory_Vectors.Cursor := Container.Dirs.First;
   begin
      while Directory_Vectors.Has_Element (Iter) loop
         Process (Directory_Vectors.Element (Iter));
         Directory_Vectors.Next (Iter);
      end loop;
   end Each_Directory;

   --  ------------------------------
   --  Execute the Process procedure on each file found in the container.
   --  ------------------------------
   overriding
   procedure Each_File (Container : in Default_Container;
                        Process   : not null access
                          procedure (F : in File_Type)) is
      Iter : File_Vectors.Cursor := Container.Files.First;
   begin
      while File_Vectors.Has_Element (Iter) loop
         Process (File_Vectors.Element (Iter));
         File_Vectors.Next (Iter);
      end loop;
   end Each_File;

end Babel.Files;

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

with Util.Log.Loggers;
with Util.Files;
with Util.Encoders.Base16;
package body Babel.Files is

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

   Hex_Encoder : Util.Encoders.Base16.Encoder;

   --  ------------------------------
   --  Compare two files on their name and directory.
   --  ------------------------------
   function "<" (Left, Right : in File_Type) return Boolean is
      use type Ada.Strings.Unbounded.Unbounded_String;
   begin
      if Left = NO_FILE then
         return False;
      elsif Right = NO_FILE then
         return True;
      elsif Left.Dir = Right.Dir then
         return Left.Name < Right.Name;
      elsif Left.Dir = NO_DIRECTORY then
         return True;
      elsif Right.Dir = NO_DIRECTORY then
         return False;
      else
         return Left.Dir.Path < Right.Dir.Path;
      end if;
   end "<";

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

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

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

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

   --  ------------------------------
   --  Return true if the file is a new file.
   --  ------------------------------
   function Is_New (Element : in File_Type) return Boolean is
      use type ADO.Identifier;
   begin
      return Element.Id = NO_IDENTIFIER;
   end Is_New;

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

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

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

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

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

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

   --  ------------------------------
   --  Return the file size.
   --  ------------------------------
   function Get_Size (Element : in File_Type) return File_Size is
   begin
      return Element.Size;
   end Get_Size;

   --  ------------------------------
   --  Return the file modification date.
   --  ------------------------------
   function Get_Date (Element : in File_Type) return Ada.Calendar.Time is
   begin
      return Element.Date;
   end Get_Date;

   --  ------------------------------
   --  Return the user uid.
   --  ------------------------------
   function Get_User (Element : in File_Type) return Uid_Type is
   begin
      return Element.User;
   end Get_User;

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

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

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

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

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

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

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

   --  ------------------------------
   --  Execute the Process procedure on each directory found in the container.
   --  ------------------------------
   overriding
   procedure Each_Directory (Container : in Default_Container;
                             Process   : not null access
                               procedure (Dir : in Directory_Type)) is
      Iter : Directory_Vectors.Cursor := Container.Dirs.First;
   begin
      while Directory_Vectors.Has_Element (Iter) loop
         Process (Directory_Vectors.Element (Iter));
         Directory_Vectors.Next (Iter);
      end loop;
   end Each_Directory;

   --  ------------------------------
   --  Execute the Process procedure on each file found in the container.
   --  ------------------------------
   overriding
   procedure Each_File (Container : in Default_Container;
                        Process   : not null access
                          procedure (F : in File_Type)) is
      Iter : File_Vectors.Cursor := Container.Files.First;
   begin
      while File_Vectors.Has_Element (Iter) loop
         Process (File_Vectors.Element (Iter));
         File_Vectors.Next (Iter);
      end loop;
   end Each_File;

end Babel.Files;

Implement the Get_User operation

Implement the Get_User operation


--  bkp-files -- File and directories
-----------------------------------------------------------------------
--  Copyright (C) 2014 Stephane.Carrez
--  Written by Stephane.Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Ada.Strings.Unbounded;
with Ada.Directories;
with Ada.Containers.Vectors;
with Ada.Text_IO;
with Ada.Exceptions;
with Ada.Streams.Stream_IO;
with Util.Log.Loggers;
with Util.Files;
with Interfaces.C;
package body Babel.Files is

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

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

   --  ------------------------------
   --  Return true if the file was modified and need a backup.
   --  ------------------------------
   function Is_Modified (Element : in File) return Boolean is
   begin
      return Element.Status /= FILE_UNCHANGED;
   end Is_Modified;

   --  ------------------------------
   --  Return the path for the file.
   --  ------------------------------
   function Get_Path (Element : in File) return String is
   begin
      return Util.Files.Compose (Ada.Strings.Unbounded.To_String (Element.Path),
                                 Ada.Strings.Unbounded.To_String (Element.Name));
   end Get_Path;

   overriding
   procedure Add_File (Into    : in out File_Queue;
                       Path    : in String;
                       Element : in File) is
   begin
      Into.Queue.Enqueue (Element);
   end Add_File;

   overriding
   procedure Add_Directory (Into : in out File_Queue;
                            Path : in String;
                            Name : in String) is
   begin
      Into.Directories.Append (Util.Files.Compose (Path, Name));
   end Add_Directory;

   procedure Compute_Sha1 (Path : in String;
                           Into : in out File) is
      use Ada.Strings.Unbounded;
      use type Ada.Streams.Stream_Element_Offset;

      File : Ada.Streams.Stream_IO.File_Type;
      Name : constant String := Path & "/" & To_String (Into.Name);
      Last : Ada.Streams.Stream_Element_Offset;
      Buf  : Ada.Streams.Stream_Element_Array (0 .. 32_767);
      Ctx  : Util.Encoders.SHA1.Context;
   begin
      Ada.Streams.Stream_IO.Open (File, Ada.Streams.Stream_IO.In_File, Name);
      loop
         Ada.Streams.Stream_IO.Read (File, Buf, Last);
         Util.Encoders.SHA1.Update (Ctx, Buf (Buf'First .. Last));
         exit when Last /= Buf'Last;
      end loop;
      Ada.Streams.Stream_IO.Close (File);
      Util.Encoders.SHA1.Finish (Ctx, Into.SHA1);
   end Compute_Sha1;

   procedure Iterate_Files (Path   : in String;
                            Dir    : in out Directory;
                            Depth  : in Natural;
                            Update : access procedure (P : in String; F : in out File)) is
      use Ada.Strings.Unbounded;

      Iter : File_Vectors.Cursor := Dir.Files.First;

      procedure Iterate_File (Item : in out File) is
      begin
         Update (Path, Item);
      end Iterate_File;

      procedure Iterate_Child (Item : in out Directory) is
      begin
         Iterate_Files (Path & "/" & To_String (Item.Name), Item, Depth - 1, Update);
      end Iterate_Child;

   begin
      while File_Vectors.Has_Element (Iter) loop
         Dir.Files.Update_Element (Iter, Iterate_File'Access);
         File_Vectors.Next (Iter);
      end loop;
      if Depth > 0 and then Dir.Children /= null then
         declare
            Dir_Iter : Directory_Vectors.Cursor := Dir.Children.First;
         begin
            while Directory_Vectors.Has_Element (Dir_Iter) loop
               Dir.Children.Update_Element (Dir_Iter, Iterate_Child'Access);
               Directory_Vectors.Next (Dir_Iter);
            end loop;
         end;
      end if;
   end Iterate_Files;

   procedure Scan_Files (Path : in String;
                         Into : in out Directory) is
      Iter : File_Vectors.Cursor := Into.Files.First;

      procedure Compute_Sha1 (Item : in out File) is
      begin
         Compute_Sha1 (Path, Item);
      end Compute_Sha1;

   begin
      while File_Vectors.Has_Element (Iter) loop
         Into.Files.Update_Element (Iter, Compute_Sha1'Access);
         File_Vectors.Next (Iter);
      end loop;
   end Scan_Files;

   procedure Scan_Children (Path : in String;
                            Into : in out Directory) is
      procedure Update (Dir : in out Directory) is
         use Ada.Strings.Unbounded;
         use type Ada.Directories.File_Size;
      begin
         Scan (Path & "/" & To_String (Dir.Name), Dir);
         Into.Tot_Files := Into.Tot_Files + Dir.Tot_Files;
         Into.Tot_Size  := Into.Tot_Size + Dir.Tot_Size;
         Into.Tot_Dirs  := Into.Tot_Dirs + Dir.Tot_Dirs;
      end Update;

   begin
      if Into.Children /= null then
         declare
            Iter : Directory_Vectors.Cursor := Into.Children.First;
         begin
            while Directory_Vectors.Has_Element (Iter) loop
               Into.Children.Update_Element (Iter, Update'Access);
               Directory_Vectors.Next (Iter);
            end loop;
         end;
      end if;
   end Scan_Children;

   procedure Scan (Path : in String;
                   Into : in out Directory) is
      use Ada.Directories;

      Filter : constant Ada.Directories.Filter_Type := (Ordinary_File => True,
                                                        Ada.Directories.Directory => True,
                                                        Special_File => False);
      Search   : Search_Type;
      Ent      : Directory_Entry_Type;
      New_File : File;
      Child    : Directory;
   begin
      Into.Tot_Size  := 0;
      Into.Tot_Files := 0;
      Into.Tot_Dirs  := 0;
      Start_Search (Search, Directory => Path, Pattern => "*", Filter => Filter);
      while More_Entries (Search) loop
         Get_Next_Entry (Search, Ent);
         declare
            Name : constant String    := Simple_Name (Ent);
            Kind : constant File_Kind := Ada.Directories.Kind (Ent);
         begin
            if Kind = Ordinary_File then
               New_File.Name := Ada.Strings.Unbounded.To_Unbounded_String (Name);
               begin
                  New_File.Size := Ada.Directories.Size (Ent);
               exception
                  when Constraint_Error =>
                     New_File.Size := Ada.Directories.File_Size (Interfaces.Unsigned_32'Last);
               end;
               Into.Files.Append (New_File);
               if New_File.Size > 0 then
                  begin
                     Into.Tot_Size  := Into.Tot_Size + New_File.Size;
                  exception
                     when Constraint_Error =>
                        Ada.Text_IO.Put_Line ("Size: " & Ada.Directories.File_Size'Image (New_File.Size)
                                              & " for " & Path & "/" & Name);
                        Ada.Text_IO.Put_Line ("Size: " & Ada.Directories.File_Size'Image (Into.Tot_Size));

                  end;
               end if;
               Into.Tot_Files := Into.Tot_Files + 1;
            elsif Name /= "." and Name /= ".." then
               if Into.Children = null then
                  Into.Children := new Directory_Vector;
               end if;
               Child.Name := Ada.Strings.Unbounded.To_Unbounded_String (Name);
               Into.Children.Append (Child);
               Into.Tot_Dirs := Into.Tot_Dirs + 1;
            end if;
         end;
      end loop;
      Scan_Children (Path, Into);
      Scan_Files (Path, Into);

   exception
      when E : others =>
            Log.Error ("Exception ", E);
   end Scan;

end Babel.Files;

--  bkp-files -- File and directories
-----------------------------------------------------------------------
--  Copyright (C) 2014 Stephane.Carrez
--  Written by Stephane.Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Ada.Strings.Unbounded;
with Ada.Directories;
with Ada.Containers.Vectors;
with Ada.Text_IO;
with Ada.Exceptions;
with Ada.Streams.Stream_IO;
with Util.Log.Loggers;
with Util.Files;
with Interfaces.C;
package body Babel.Files is

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

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

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

   --  ------------------------------
   --  Return the path for the file.
   --  ------------------------------
   function Get_Path (Element : in File) return String is
   begin
      return Util.Files.Compose (Ada.Strings.Unbounded.To_String (Element.Path),
                                 Ada.Strings.Unbounded.To_String (Element.Name));
   end Get_Path;

   overriding
   procedure Add_File (Into    : in out File_Queue;
                       Path    : in String;
                       Element : in File) is
   begin
      Into.Queue.Enqueue (Element);
   end Add_File;

   overriding
   procedure Add_Directory (Into : in out File_Queue;
                            Path : in String;
                            Name : in String) is
   begin
      Into.Directories.Append (Util.Files.Compose (Path, Name));
   end Add_Directory;

   procedure Compute_Sha1 (Path : in String;
                           Into : in out File) is
      use Ada.Strings.Unbounded;
      use type Ada.Streams.Stream_Element_Offset;

      File : Ada.Streams.Stream_IO.File_Type;
      Name : constant String := Path & "/" & To_String (Into.Name);
      Last : Ada.Streams.Stream_Element_Offset;
      Buf  : Ada.Streams.Stream_Element_Array (0 .. 32_767);
      Ctx  : Util.Encoders.SHA1.Context;
   begin
      Ada.Streams.Stream_IO.Open (File, Ada.Streams.Stream_IO.In_File, Name);
      loop
         Ada.Streams.Stream_IO.Read (File, Buf, Last);
         Util.Encoders.SHA1.Update (Ctx, Buf (Buf'First .. Last));
         exit when Last /= Buf'Last;
      end loop;
      Ada.Streams.Stream_IO.Close (File);
      Util.Encoders.SHA1.Finish (Ctx, Into.SHA1);
   end Compute_Sha1;

   procedure Iterate_Files (Path   : in String;
                            Dir    : in out Directory;
                            Depth  : in Natural;
                            Update : access procedure (P : in String; F : in out File)) is
      use Ada.Strings.Unbounded;

      Iter : File_Vectors.Cursor := Dir.Files.First;

      procedure Iterate_File (Item : in out File) is
      begin
         Update (Path, Item);
      end Iterate_File;

      procedure Iterate_Child (Item : in out Directory) is
      begin
         Iterate_Files (Path & "/" & To_String (Item.Name), Item, Depth - 1, Update);
      end Iterate_Child;

   begin
      while File_Vectors.Has_Element (Iter) loop
         Dir.Files.Update_Element (Iter, Iterate_File'Access);
         File_Vectors.Next (Iter);
      end loop;
      if Depth > 0 and then Dir.Children /= null then
         declare
            Dir_Iter : Directory_Vectors.Cursor := Dir.Children.First;
         begin
            while Directory_Vectors.Has_Element (Dir_Iter) loop
               Dir.Children.Update_Element (Dir_Iter, Iterate_Child'Access);
               Directory_Vectors.Next (Dir_Iter);
            end loop;
         end;
      end if;
   end Iterate_Files;

   procedure Scan_Files (Path : in String;
                         Into : in out Directory) is
      Iter : File_Vectors.Cursor := Into.Files.First;

      procedure Compute_Sha1 (Item : in out File) is
      begin
         Compute_Sha1 (Path, Item);
      end Compute_Sha1;

   begin
      while File_Vectors.Has_Element (Iter) loop
         Into.Files.Update_Element (Iter, Compute_Sha1'Access);
         File_Vectors.Next (Iter);
      end loop;
   end Scan_Files;

   procedure Scan_Children (Path : in String;
                            Into : in out Directory) is
      procedure Update (Dir : in out Directory) is
         use Ada.Strings.Unbounded;
         use type Ada.Directories.File_Size;
      begin
         Scan (Path & "/" & To_String (Dir.Name), Dir);
         Into.Tot_Files := Into.Tot_Files + Dir.Tot_Files;
         Into.Tot_Size  := Into.Tot_Size + Dir.Tot_Size;
         Into.Tot_Dirs  := Into.Tot_Dirs + Dir.Tot_Dirs;
      end Update;

   begin
      if Into.Children /= null then
         declare
            Iter : Directory_Vectors.Cursor := Into.Children.First;
         begin
            while Directory_Vectors.Has_Element (Iter) loop
               Into.Children.Update_Element (Iter, Update'Access);
               Directory_Vectors.Next (Iter);
            end loop;
         end;
      end if;
   end Scan_Children;

   procedure Scan (Path : in String;
                   Into : in out Directory) is
      use Ada.Directories;

      Filter : constant Ada.Directories.Filter_Type := (Ordinary_File => True,
                                                        Ada.Directories.Directory => True,
                                                        Special_File => False);
      Search   : Search_Type;
      Ent      : Directory_Entry_Type;
      New_File : File;
      Child    : Directory;
   begin
      Into.Tot_Size  := 0;
      Into.Tot_Files := 0;
      Into.Tot_Dirs  := 0;
      Start_Search (Search, Directory => Path, Pattern => "*", Filter => Filter);
      while More_Entries (Search) loop
         Get_Next_Entry (Search, Ent);
         declare
            Name : constant String    := Simple_Name (Ent);
            Kind : constant File_Kind := Ada.Directories.Kind (Ent);
         begin
            if Kind = Ordinary_File then
               New_File.Name := Ada.Strings.Unbounded.To_Unbounded_String (Name);
               begin
                  New_File.Size := Ada.Directories.Size (Ent);
               exception
                  when Constraint_Error =>
                     New_File.Size := Ada.Directories.File_Size (Interfaces.Unsigned_32'Last);
               end;
               Into.Files.Append (New_File);
               if New_File.Size > 0 then
                  begin
                     Into.Tot_Size  := Into.Tot_Size + New_File.Size;
                  exception
                     when Constraint_Error =>
                        Ada.Text_IO.Put_Line ("Size: " & Ada.Directories.File_Size'Image (New_File.Size)
                                              & " for " & Path & "/" & Name);
                        Ada.Text_IO.Put_Line ("Size: " & Ada.Directories.File_Size'Image (Into.Tot_Size));

                  end;
               end if;
               Into.Tot_Files := Into.Tot_Files + 1;
            elsif Name /= "." and Name /= ".." then
               if Into.Children = null then
                  Into.Children := new Directory_Vector;
               end if;
               Child.Name := Ada.Strings.Unbounded.To_Unbounded_String (Name);
               Into.Children.Append (Child);
               Into.Tot_Dirs := Into.Tot_Dirs + 1;
            end if;
         end;
      end loop;
      Scan_Children (Path, Into);
      Scan_Files (Path, Into);

   exception
      when E : others =>
            Log.Error ("Exception ", E);
   end Scan;

end Babel.Files;

Fix the Is_Modified operation to use the new Status_Type


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

package Definitions is

   pragma Pure;

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

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

end Definitions;

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

package Definitions is

   pragma Pure;

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

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

end Definitions;

Bump version

Bump version


-----------------------------------------------------------------------
--  gen-commands-project -- Project creation command for dynamo
--  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.Project 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.Project;

-----------------------------------------------------------------------
--  gen-commands-project -- Project creation command for dynamo
--  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.Project 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.Project;

Update to use the new command implementation


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

------------------------------------------------------------------------------
-- Natools.Web.Comments provides an implementation of user-posted comments  --
-- like is commonly found on blogs.                                         --
------------------------------------------------------------------------------

with Natools.S_Expressions.Atom_Refs;
with Natools.S_Expressions.Lockable;
with Natools.S_Expressions.Printers;
with Natools.Web.Sites;
with Natools.Web.Tags;

private with Ada.Calendar.Time_Zones;
private with Ada.Containers.Doubly_Linked_Lists;
private with Ada.Finalization;
private with Natools.Constant_Indefinite_Ordered_Maps;
private with Natools.References;
private with Natools.Storage_Pools;
private with Natools.Web.Containers;
private with Natools.Web.Sites.Updates;

package Natools.Web.Comments is

   type Comment_Ref is new Tags.Visible with private;

   overriding procedure Render
     (Exchange : in out Sites.Exchange;
      Object : in Comment_Ref;
      Expression : in out S_Expressions.Lockable.Descriptor'Class);
      --  Render a comment

   type Comment_List is tagged private;

   procedure Load
     (Object : in out Comment_List;
      Builder : in out Sites.Site_Builder;
      Parent : in Tags.Visible_Access := null;
      Parent_Path : in S_Expressions.Atom_Refs.Immutable_Reference
        := S_Expressions.Atom_Refs.Null_Immutable_Reference);
      --  Load comment list from Builder back-end and register all comments

   procedure Render
     (Exchange : in out Sites.Exchange;
      Object : in Comment_List;
      Expression : in out S_Expressions.Lockable.Descriptor'Class);
      --  Render a comment list

   procedure Respond
     (List : in out Comment_List;
      Exchange : in out Sites.Exchange;
      Extra_Path : in S_Expressions.Atom);
      --  Respond to a request for the comment list

   procedure Set
     (List : out Comment_List;
      Expression : in out S_Expressions.Lockable.Descriptor'Class);
      --  (Re)initialize List using data from Expression

private

   package Comment_Atoms is
      type Enum is (Name, Mail, Link, Text, Class, Note, Title, Filter);
      type Set is array (Enum) of S_Expressions.Atom_Refs.Immutable_Reference;
   end Comment_Atoms;

   package Comment_Flags is
      type Enum is (Preprocessed, Ignored);
      type Set is array (Enum) of Boolean with Pack;
   end Comment_Flags;

   package List_Flags is
      type Enum is
        (Ignore_By_Default, Allow_Date_Override, Closed, Allow_Ignore);
      type Set is array (Enum) of Boolean with Pack;
   end List_Flags;

   type Comment_Data is record
      Date : Ada.Calendar.Time;
      Offset : Ada.Calendar.Time_Zones.Time_Offset;
      Id : S_Expressions.Atom_Refs.Immutable_Reference;
      Atoms : Comment_Atoms.Set;
      Flags : Comment_Flags.Set := (others => False);
      Parent : Tags.Visible_Access;
      Rank : Positive;
   end record;

   procedure Preprocess
     (Comment : in out Comment_Data;
      List : in Comment_List;
      Site : in Sites.Site);
   procedure Preprocess
     (Comment : in out Comment_Data;
      List : in Comment_List;
      Builder : in Sites.Site_Builder);
      --  Preprocess comment field contents

   procedure Write
     (Comment : in Comment_Data;
      Output : in out S_Expressions.Printers.Printer'Class);
      --  Serialize a comment into the given S_Expression stream

   package Comment_Maps is new Natools.Constant_Indefinite_Ordered_Maps
     (S_Expressions.Atom, Comment_Data, S_Expressions."<");

   procedure Set_Parent
     (Container : in out Comment_Maps.Updatable_Map;
      Parent : in Tags.Visible_Access);

   procedure Update_Ranks (Container : in out Comment_Maps.Updatable_Map);

   protected type Comment_Container is
      procedure Initialize
        (Data : in Comment_Maps.Unsafe_Maps.Map;
         Parent : in Tags.Visible_Access);

      procedure Insert (Data : in Comment_Data);

      procedure Ignore
        (Id : in S_Expressions.Atom;
         Ref : out S_Expressions.Atom_Refs.Immutable_Reference);

      procedure Orphan;

      function Find (Id : S_Expressions.Atom_Refs.Immutable_Reference)
        return Comment_Maps.Cursor;

      function First return Comment_Maps.Cursor;

      function Iterate
        return Comment_Maps.Map_Iterator_Interfaces.Reversible_Iterator'Class;

      function Length return Natural;
   private
      Map : Comment_Maps.Updatable_Map;
      Parent : Tags.Visible_Access;
   end Comment_Container;

   package Container_Refs is new References
     (Comment_Container,
      Storage_Pools.Access_In_Default_Pool'Storage_Pool,
      Storage_Pools.Access_In_Default_Pool'Storage_Pool);

   type Comment_Ref is new Tags.Visible with record
      Container : Container_Refs.Reference;
      Id : S_Expressions.Atom_Refs.Immutable_Reference;
   end record;

   type Comment_List is new Ada.Finalization.Controlled with record
      Backend_Name : S_Expressions.Atom_Refs.Immutable_Reference;
      Backend_Path : S_Expressions.Atom_Refs.Immutable_Reference;
      Parent_Path : S_Expressions.Atom_Refs.Immutable_Reference;
      Comments : Container_Refs.Reference;
      Post_Filter : S_Expressions.Atom_Refs.Immutable_Reference;
      Tags : Containers.Atom_Array_Refs.Immutable_Reference;
      Text_Filters : Containers.Atom_Array_Refs.Immutable_Reference;
      Default_Text_Filter : S_Expressions.Atom_Refs.Immutable_Reference;
      Flags : List_Flags.Set := (others => False);
      Parent : Web.Tags.Visible_Access;
   end record;

   overriding procedure Finalize (Object : in out Comment_List);

   type Comment_Inserter is new Sites.Updates.Site_Update with record
      Container : Container_Refs.Reference;
      Id : S_Expressions.Atom_Refs.Immutable_Reference;
      Tags : Containers.Atom_Array_Refs.Immutable_Reference;
   end record;

   overriding procedure Update
     (Self : in Comment_Inserter;
      Site : in out Sites.Site);

   package Id_Lists is new Ada.Containers.Doubly_Linked_Lists
     (S_Expressions.Atom_Refs.Immutable_Reference,
      S_Expressions.Atom_Refs."=");

   type Comment_Remover is new Sites.Updates.Site_Update with record
      Container : Container_Refs.Reference;
      Ids : Id_Lists.List;
      Tags : Containers.Atom_Array_Refs.Immutable_Reference;
   end record;

   overriding procedure Update
     (Self : in Comment_Remover;
      Site : in out Sites.Site);

   Empty_List : constant Comment_List
     := (Ada.Finalization.Controlled with
         Backend_Name => S_Expressions.Atom_Refs.Null_Immutable_Reference,
         Backend_Path => S_Expressions.Atom_Refs.Null_Immutable_Reference,
         Parent_Path => S_Expressions.Atom_Refs.Null_Immutable_Reference,
         Comments => Container_Refs.Null_Reference,
         Parent => null,
         Post_Filter => S_Expressions.Atom_Refs.Null_Immutable_Reference,
         Tags => Containers.Atom_Array_Refs.Null_Immutable_Reference,
         Text_Filters => Containers.Atom_Array_Refs.Null_Immutable_Reference,
         Default_Text_Filter
           => S_Expressions.Atom_Refs.Null_Immutable_Reference,
         Flags => (others => False));

end Natools.Web.Comments;

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

------------------------------------------------------------------------------
-- Natools.Web.Comments provides an implementation of user-posted comments  --
-- like is commonly found on blogs.                                         --
------------------------------------------------------------------------------

with Natools.S_Expressions.Atom_Refs;
with Natools.S_Expressions.Lockable;
with Natools.S_Expressions.Printers;
with Natools.Web.Sites;
with Natools.Web.Tags;

private with Ada.Calendar.Time_Zones;
private with Ada.Containers.Doubly_Linked_Lists;
private with Ada.Finalization;
private with Natools.Constant_Indefinite_Ordered_Maps;
private with Natools.References;
private with Natools.Storage_Pools;
private with Natools.Web.Containers;
private with Natools.Web.Sites.Updates;

package Natools.Web.Comments is

   type Comment_Ref is new Tags.Visible with private;

   overriding procedure Render
     (Exchange : in out Sites.Exchange;
      Object : in Comment_Ref;
      Expression : in out S_Expressions.Lockable.Descriptor'Class);
      --  Render a comment

   type Comment_List is tagged private;

   function Is_Null (Object : in Comment_List) return Boolean;
      --  Return whether the list is usable (even if empty)

   procedure Load
     (Object : in out Comment_List;
      Builder : in out Sites.Site_Builder;
      Parent : in Tags.Visible_Access := null;
      Parent_Path : in S_Expressions.Atom_Refs.Immutable_Reference
        := S_Expressions.Atom_Refs.Null_Immutable_Reference);
      --  Load comment list from Builder back-end and register all comments

   procedure Render
     (Exchange : in out Sites.Exchange;
      Object : in Comment_List;
      Expression : in out S_Expressions.Lockable.Descriptor'Class);
      --  Render a comment list

   procedure Respond
     (List : in out Comment_List;
      Exchange : in out Sites.Exchange;
      Extra_Path : in S_Expressions.Atom);
      --  Respond to a request for the comment list

   procedure Set
     (List : out Comment_List;
      Expression : in out S_Expressions.Lockable.Descriptor'Class);
      --  (Re)initialize List using data from Expression

private

   package Comment_Atoms is
      type Enum is (Name, Mail, Link, Text, Class, Note, Title, Filter);
      type Set is array (Enum) of S_Expressions.Atom_Refs.Immutable_Reference;
   end Comment_Atoms;

   package Comment_Flags is
      type Enum is (Preprocessed, Ignored);
      type Set is array (Enum) of Boolean with Pack;
   end Comment_Flags;

   package List_Flags is
      type Enum is
        (Ignore_By_Default, Allow_Date_Override, Closed, Allow_Ignore);
      type Set is array (Enum) of Boolean with Pack;
   end List_Flags;

   type Comment_Data is record
      Date : Ada.Calendar.Time;
      Offset : Ada.Calendar.Time_Zones.Time_Offset;
      Id : S_Expressions.Atom_Refs.Immutable_Reference;
      Atoms : Comment_Atoms.Set;
      Flags : Comment_Flags.Set := (others => False);
      Parent : Tags.Visible_Access;
      Rank : Positive;
   end record;

   procedure Preprocess
     (Comment : in out Comment_Data;
      List : in Comment_List;
      Site : in Sites.Site);
   procedure Preprocess
     (Comment : in out Comment_Data;
      List : in Comment_List;
      Builder : in Sites.Site_Builder);
      --  Preprocess comment field contents

   procedure Write
     (Comment : in Comment_Data;
      Output : in out S_Expressions.Printers.Printer'Class);
      --  Serialize a comment into the given S_Expression stream

   package Comment_Maps is new Natools.Constant_Indefinite_Ordered_Maps
     (S_Expressions.Atom, Comment_Data, S_Expressions."<");

   procedure Set_Parent
     (Container : in out Comment_Maps.Updatable_Map;
      Parent : in Tags.Visible_Access);

   procedure Update_Ranks (Container : in out Comment_Maps.Updatable_Map);

   protected type Comment_Container is
      procedure Initialize
        (Data : in Comment_Maps.Unsafe_Maps.Map;
         Parent : in Tags.Visible_Access);

      procedure Insert (Data : in Comment_Data);

      procedure Ignore
        (Id : in S_Expressions.Atom;
         Ref : out S_Expressions.Atom_Refs.Immutable_Reference);

      procedure Orphan;

      function Find (Id : S_Expressions.Atom_Refs.Immutable_Reference)
        return Comment_Maps.Cursor;

      function First return Comment_Maps.Cursor;

      function Iterate
        return Comment_Maps.Map_Iterator_Interfaces.Reversible_Iterator'Class;

      function Length return Natural;
   private
      Map : Comment_Maps.Updatable_Map;
      Parent : Tags.Visible_Access;
   end Comment_Container;

   package Container_Refs is new References
     (Comment_Container,
      Storage_Pools.Access_In_Default_Pool'Storage_Pool,
      Storage_Pools.Access_In_Default_Pool'Storage_Pool);

   type Comment_Ref is new Tags.Visible with record
      Container : Container_Refs.Reference;
      Id : S_Expressions.Atom_Refs.Immutable_Reference;
   end record;

   type Comment_List is new Ada.Finalization.Controlled with record
      Backend_Name : S_Expressions.Atom_Refs.Immutable_Reference;
      Backend_Path : S_Expressions.Atom_Refs.Immutable_Reference;
      Parent_Path : S_Expressions.Atom_Refs.Immutable_Reference;
      Comments : Container_Refs.Reference;
      Post_Filter : S_Expressions.Atom_Refs.Immutable_Reference;
      Tags : Containers.Atom_Array_Refs.Immutable_Reference;
      Text_Filters : Containers.Atom_Array_Refs.Immutable_Reference;
      Default_Text_Filter : S_Expressions.Atom_Refs.Immutable_Reference;
      Flags : List_Flags.Set := (others => False);
      Parent : Web.Tags.Visible_Access;
   end record;

   overriding procedure Finalize (Object : in out Comment_List);

   function Is_Null (Object : in Comment_List) return Boolean
     is (Object.Backend_Name.Is_Empty or else Object.Backend_Path.Is_Empty);

   type Comment_Inserter is new Sites.Updates.Site_Update with record
      Container : Container_Refs.Reference;
      Id : S_Expressions.Atom_Refs.Immutable_Reference;
      Tags : Containers.Atom_Array_Refs.Immutable_Reference;
   end record;

   overriding procedure Update
     (Self : in Comment_Inserter;
      Site : in out Sites.Site);

   package Id_Lists is new Ada.Containers.Doubly_Linked_Lists
     (S_Expressions.Atom_Refs.Immutable_Reference,
      S_Expressions.Atom_Refs."=");

   type Comment_Remover is new Sites.Updates.Site_Update with record
      Container : Container_Refs.Reference;
      Ids : Id_Lists.List;
      Tags : Containers.Atom_Array_Refs.Immutable_Reference;
   end record;

   overriding procedure Update
     (Self : in Comment_Remover;
      Site : in out Sites.Site);

   Empty_List : constant Comment_List
     := (Ada.Finalization.Controlled with
         Backend_Name => S_Expressions.Atom_Refs.Null_Immutable_Reference,
         Backend_Path => S_Expressions.Atom_Refs.Null_Immutable_Reference,
         Parent_Path => S_Expressions.Atom_Refs.Null_Immutable_Reference,
         Comments => Container_Refs.Null_Reference,
         Parent => null,
         Post_Filter => S_Expressions.Atom_Refs.Null_Immutable_Reference,
         Tags => Containers.Atom_Array_Refs.Null_Immutable_Reference,
         Text_Filters => Containers.Atom_Array_Refs.Null_Immutable_Reference,
         Default_Text_Filter
           => S_Expressions.Atom_Refs.Null_Immutable_Reference,
         Flags => (others => False));

end Natools.Web.Comments;

comments: add a primitive to test whether a comment list is usable


-----------------------------------------------------------------------
--  wiki-render-html -- Wiki HTML renderer
--  Copyright (C) 2011, 2012, 2013, 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 Ada.Characters.Conversions;
with Util.Strings;

package body Wiki.Render.Html is

   --  ------------------------------
   --  Set the output writer.
   --  ------------------------------
   procedure Set_Writer (Document : in out Html_Renderer;
                         Writer   : in Wiki.Writers.Html_Writer_Type_Access) is
   begin
      Document.Writer := Writer;
   end Set_Writer;

   --  ------------------------------
   --  Set the link renderer.
   --  ------------------------------
   procedure Set_Link_Renderer (Document : in out Html_Renderer;
                                Links    : in Link_Renderer_Access) is
   begin
      Document.Links := Links;
   end Set_Link_Renderer;

   --  ------------------------------
   --  Add a section header in the document.
   --  ------------------------------
   overriding
   procedure Add_Header (Document : in out Html_Renderer;
                         Header   : in Unbounded_Wide_Wide_String;
                         Level    : in Positive) is
   begin
      Document.Close_Paragraph;
      Document.Add_Blockquote (0);
      case Level is
         when 1 =>
            Document.Writer.Write_Wide_Element ("h1", Header);

         when 2 =>
            Document.Writer.Write_Wide_Element ("h2", Header);

         when 3 =>
            Document.Writer.Write_Wide_Element ("h3", Header);

         when 4 =>
            Document.Writer.Write_Wide_Element ("h4", Header);

         when 5 =>
            Document.Writer.Write_Wide_Element ("h5", Header);

         when 6 =>
            Document.Writer.Write_Wide_Element ("h6", Header);

         when others =>
            Document.Writer.Write_Wide_Element ("h3", Header);
      end case;
   end Add_Header;

   --  ------------------------------
   --  Add a line break (
).
   --  ------------------------------
   overriding
   procedure Add_Line_Break (Document : in out Html_Renderer) is
   begin
      --  Document.Writer.Write_Raw ("
");
      Document.Writer.Write ("
");
   end Add_Line_Break;

   --  ------------------------------
   --  Add a paragraph (
).  Close the previous paragraph if any.
   --  The paragraph must be closed at the next paragraph or next header.
   --  ------------------------------
   overriding
   procedure Add_Paragraph (Document : in out Html_Renderer) is
   begin
      Document.Close_Paragraph;
      Document.Need_Paragraph := True;
   end Add_Paragraph;

   --  ------------------------------
   --  Add a blockquote (
).  The level indicates the blockquote nested level.
   --  The blockquote must be closed at the next header.
   --  ------------------------------
   overriding
   procedure Add_Blockquote (Document : in out Html_Renderer;
                             Level    : in Natural) is
   begin
      if Document.Quote_Level /= Level then
         Document.Close_Paragraph;
         Document.Need_Paragraph := True;
      end if;
      while Document.Quote_Level < Level loop
         Document.Writer.Start_Element ("blockquote");
         Document.Quote_Level := Document.Quote_Level + 1;
      end loop;
      while Document.Quote_Level > Level loop
         Document.Writer.End_Element ("blockquote");
         Document.Quote_Level := Document.Quote_Level - 1;
      end loop;
   end Add_Blockquote;

   --  ------------------------------
   --  Add a list item (
).  Close the previous paragraph and list item if any.
   --  The list item will be closed at the next list item, next paragraph or next header.
   --  ------------------------------
   overriding
   procedure Add_List_Item (Document : in out Html_Renderer;
                            Level    : in Positive;
                            Ordered  : in Boolean) is
   begin
      if Document.Has_Paragraph then
         Document.Writer.End_Element ("p");
         Document.Has_Paragraph := False;
      end if;
      if Document.Has_Item then
         Document.Writer.End_Element ("li");
         Document.Has_Item := False;
      end if;
      Document.Need_Paragraph := False;
      Document.Open_Paragraph;
      while Document.Current_Level < Level loop
         if Ordered then
            Document.Writer.Start_Element ("ol");
         else
            Document.Writer.Start_Element ("ul");
         end if;
         Document.Current_Level := Document.Current_Level + 1;
         Document.List_Styles (Document.Current_Level) := Ordered;
      end loop;
   end Add_List_Item;

   procedure Close_Paragraph (Document : in out Html_Renderer) is
   begin
      if Document.Html_Level > 0 then
         return;
      end if;
      if Document.Has_Paragraph then
         Document.Writer.End_Element ("p");
      end if;
      if Document.Has_Item then
         Document.Writer.End_Element ("li");
      end if;
      while Document.Current_Level > 0 loop
         if Document.List_Styles (Document.Current_Level) then
            Document.Writer.End_Element ("ol");
         else
            Document.Writer.End_Element ("ul");
         end if;
         Document.Current_Level := Document.Current_Level - 1;
      end loop;
      Document.Has_Paragraph := False;
      Document.Has_Item := False;
   end Close_Paragraph;

   procedure Open_Paragraph (Document : in out Html_Renderer) is
   begin
      if Document.Html_Level > 0 then
         return;
      end if;
      if Document.Need_Paragraph then
         Document.Writer.Start_Element ("p");
         Document.Has_Paragraph  := True;
         Document.Need_Paragraph := False;
      end if;
      if Document.Current_Level > 0 and not Document.Has_Item then
         Document.Writer.Start_Element ("li");
         Document.Has_Item := True;
      end if;
   end Open_Paragraph;

   --  ------------------------------
   --  Add an horizontal rule (
).
   --  ------------------------------
   overriding
   procedure Add_Horizontal_Rule (Document : in out Html_Renderer) is
   begin
      Document.Close_Paragraph;
      Document.Add_Blockquote (0);
      Document.Writer.Start_Element ("hr");
      Document.Writer.End_Element ("hr");
   end Add_Horizontal_Rule;

   --  ------------------------------
   --  Add a link.
   --  ------------------------------
   overriding
   procedure Add_Link (Document : in out Html_Renderer;
                       Name     : in Unbounded_Wide_Wide_String;
                       Link     : in Unbounded_Wide_Wide_String;
                       Language : in Unbounded_Wide_Wide_String;
                       Title    : in Unbounded_Wide_Wide_String) is
      Exists : Boolean;
      URI    : Unbounded_Wide_Wide_String;
   begin
      Document.Open_Paragraph;
      Document.Writer.Start_Element ("a");
      if Length (Title) > 0 then
         Document.Writer.Write_Wide_Attribute ("title", Title);
      end if;
      if Length (Language) > 0 then
         Document.Writer.Write_Wide_Attribute ("lang", Language);
      end if;
      Document.Links.Make_Page_Link (Link, URI, Exists);
      Document.Writer.Write_Wide_Attribute ("href", URI);
      Document.Writer.Write_Wide_Text (Name);
      Document.Writer.End_Element ("a");
   end Add_Link;

   --  ------------------------------
   --  Add an image.
   --  ------------------------------
   overriding
   procedure Add_Image (Document    : in out Html_Renderer;
                        Link        : in Unbounded_Wide_Wide_String;
                        Alt         : in Unbounded_Wide_Wide_String;
                        Position    : in Unbounded_Wide_Wide_String;
                        Description : in Unbounded_Wide_Wide_String) is
      pragma Unreferenced (Position);

      URI    : Unbounded_Wide_Wide_String;
      Width  : Natural;
      Height : Natural;
   begin
      Document.Open_Paragraph;
      Document.Writer.Start_Element ("img");
      if Length (Alt) > 0 then
         Document.Writer.Write_Wide_Attribute ("alt", Alt);
      end if;
      if Length (Description) > 0 then
         Document.Writer.Write_Wide_Attribute ("longdesc", Description);
      end if;
      Document.Links.Make_Image_Link (Link, URI, Width, Height);
      Document.Writer.Write_Wide_Attribute ("src", URI);
      if Width > 0 then
         Document.Writer.Write_Attribute ("width", Natural'Image (Width));
      end if;
      if Height > 0 then
         Document.Writer.Write_Attribute ("height", Natural'Image (Height));
      end if;
      Document.Writer.End_Element ("img");
   end Add_Image;

   --  ------------------------------
   --  Add a quote.
   --  ------------------------------
   overriding
   procedure Add_Quote (Document : in out Html_Renderer;
                        Quote    : in Unbounded_Wide_Wide_String;
                        Link     : in Unbounded_Wide_Wide_String;
                        Language : in Unbounded_Wide_Wide_String) is
   begin
      Document.Open_Paragraph;
      Document.Writer.Start_Element ("q");
      if Length (Language) > 0 then
         Document.Writer.Write_Wide_Attribute ("lang", Language);
      end if;
      if Length (Link) > 0 then
         Document.Writer.Write_Wide_Attribute ("cite", Link);
      end if;
      Document.Writer.Write_Wide_Text (Quote);
      Document.Writer.End_Element ("q");
   end Add_Quote;

   HTML_BOLD        : aliased constant String := "b";
   HTML_ITALIC      : aliased constant String := "i";
   HTML_CODE        : aliased constant String := "tt";
   HTML_SUPERSCRIPT : aliased constant String := "sup";
   HTML_SUBSCRIPT   : aliased constant String := "sub";
   HTML_STRIKEOUT   : aliased constant String := "del";
   --  HTML_UNDERLINE   : aliased constant String := "ins";
   HTML_PREFORMAT   : aliased constant String := "pre";

   type String_Array_Access is array (Documents.Format_Type) of Util.Strings.Name_Access;

   HTML_ELEMENT     : constant String_Array_Access :=
     (Documents.BOLD        => HTML_BOLD'Access,
      Documents.ITALIC      => HTML_ITALIC'Access,
      Documents.CODE        => HTML_CODE'Access,
      Documents.SUPERSCRIPT => HTML_SUPERSCRIPT'Access,
      Documents.SUBSCRIPT   => HTML_SUBSCRIPT'Access,
      Documents.STRIKEOUT   => HTML_STRIKEOUT'Access,
      Documents.PREFORMAT   => HTML_PREFORMAT'Access);

   --  ------------------------------
   --  Add a text block with the given format.
   --  ------------------------------
   overriding
   procedure Add_Text (Document : in out Html_Renderer;
                       Text     : in Unbounded_Wide_Wide_String;
                       Format   : in Wiki.Documents.Format_Map) is
   begin
      Document.Open_Paragraph;
      for I in Format'Range loop
         if Format (I) then
            Document.Writer.Start_Element (HTML_ELEMENT (I).all);
         end if;
      end loop;
      Document.Writer.Write_Wide_Text (Text);
      for I in reverse Format'Range loop
         if Format (I) then
            Document.Writer.End_Element (HTML_ELEMENT (I).all);
         end if;
      end loop;
   end Add_Text;

   --  ------------------------------
   --  Add a text block that is pre-formatted.
   --  ------------------------------
   procedure Add_Preformatted (Document : in out Html_Renderer;
                               Text     : in Unbounded_Wide_Wide_String;
                               Format   : in Unbounded_Wide_Wide_String) is
   begin
      Document.Close_Paragraph;
      if Format = "html" then
         Document.Writer.Write (Text);
      else
         Document.Writer.Start_Element ("pre");
         Document.Writer.Write_Wide_Text (Text);
         Document.Writer.End_Element ("pre");
      end if;
   end Add_Preformatted;

   overriding
   procedure Start_Element (Document   : in out Html_Renderer;
                            Name       : in Unbounded_Wide_Wide_String;
                            Attributes : in Wiki.Attributes.Attribute_List_Type) is
      Iter : Wiki.Attributes.Cursor := Wiki.Attributes.First (Attributes);
   begin
      Document.Html_Level := Document.Html_Level + 1;
      if Name = "p" then
         Document.Has_Paragraph := True;
         Document.Need_Paragraph := False;
      end if;
      Document.Writer.Start_Element (Ada.Characters.Conversions.To_String (To_Wide_Wide_String (Name)));
      while Wiki.Attributes.Has_Element (Iter) loop
         Document.Writer.Write_Wide_Attribute (Name    => Wiki.Attributes.Get_Name (Iter),
                                               Content => Wiki.Attributes.Get_Wide_Value (Iter));
         Wiki.Attributes.Next (Iter);
      end loop;
   end Start_Element;

   overriding
   procedure End_Element (Document : in out Html_Renderer;
                          Name     : in Unbounded_Wide_Wide_String) is
   begin
      Document.Html_Level := Document.Html_Level - 1;
      if Name = "p" then
         Document.Has_Paragraph := False;
         Document.Need_Paragraph := True;
      end if;
      Document.Writer.End_Element (Ada.Characters.Conversions.To_String (To_Wide_Wide_String (Name)));
   end End_Element;

   --  ------------------------------
   --  Finish the document after complete wiki text has been parsed.
   --  ------------------------------
   overriding
   procedure Finish (Document : in out Html_Renderer) is
   begin
      Document.Close_Paragraph;
      Document.Add_Blockquote (0);
   end Finish;

end Wiki.Render.Html;

-----------------------------------------------------------------------
--  wiki-render-html -- Wiki HTML renderer
--  Copyright (C) 2011, 2012, 2013, 2014, 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 Ada.Characters.Conversions;
with Util.Strings;

package body Wiki.Render.Html is

   package ACC renames Ada.Characters.Conversions;

   --  ------------------------------
   --  Set the output writer.
   --  ------------------------------
   procedure Set_Writer (Document : in out Html_Renderer;
                         Writer   : in Wiki.Writers.Html_Writer_Type_Access) is
   begin
      Document.Writer := Writer;
   end Set_Writer;

   --  ------------------------------
   --  Set the link renderer.
   --  ------------------------------
   procedure Set_Link_Renderer (Document : in out Html_Renderer;
                                Links    : in Link_Renderer_Access) is
   begin
      Document.Links := Links;
   end Set_Link_Renderer;

   --  ------------------------------
   --  Add a section header in the document.
   --  ------------------------------
   overriding
   procedure Add_Header (Document : in out Html_Renderer;
                         Header   : in Unbounded_Wide_Wide_String;
                         Level    : in Positive) is
   begin
      Document.Close_Paragraph;
      Document.Add_Blockquote (0);
      case Level is
         when 1 =>
            Document.Writer.Write_Wide_Element ("h1", Header);

         when 2 =>
            Document.Writer.Write_Wide_Element ("h2", Header);

         when 3 =>
            Document.Writer.Write_Wide_Element ("h3", Header);

         when 4 =>
            Document.Writer.Write_Wide_Element ("h4", Header);

         when 5 =>
            Document.Writer.Write_Wide_Element ("h5", Header);

         when 6 =>
            Document.Writer.Write_Wide_Element ("h6", Header);

         when others =>
            Document.Writer.Write_Wide_Element ("h3", Header);
      end case;
   end Add_Header;

   --  ------------------------------
   --  Add a line break (
).
   --  ------------------------------
   overriding
   procedure Add_Line_Break (Document : in out Html_Renderer) is
   begin
      Document.Writer.Write ("
");
   end Add_Line_Break;

   --  ------------------------------
   --  Add a paragraph (
).  Close the previous paragraph if any.
   --  The paragraph must be closed at the next paragraph or next header.
   --  ------------------------------
   overriding
   procedure Add_Paragraph (Document : in out Html_Renderer) is
   begin
      Document.Close_Paragraph;
      Document.Need_Paragraph := True;
   end Add_Paragraph;

   --  ------------------------------
   --  Add a blockquote (
).  The level indicates the blockquote nested level.
   --  The blockquote must be closed at the next header.
   --  ------------------------------
   overriding
   procedure Add_Blockquote (Document : in out Html_Renderer;
                             Level    : in Natural) is
   begin
      if Document.Quote_Level /= Level then
         Document.Close_Paragraph;
         Document.Need_Paragraph := True;
      end if;
      while Document.Quote_Level < Level loop
         Document.Writer.Start_Element ("blockquote");
         Document.Quote_Level := Document.Quote_Level + 1;
      end loop;
      while Document.Quote_Level > Level loop
         Document.Writer.End_Element ("blockquote");
         Document.Quote_Level := Document.Quote_Level - 1;
      end loop;
   end Add_Blockquote;

   --  ------------------------------
   --  Add a list item (
).  Close the previous paragraph and list item if any.
   --  The list item will be closed at the next list item, next paragraph or next header.
   --  ------------------------------
   overriding
   procedure Add_List_Item (Document : in out Html_Renderer;
                            Level    : in Positive;
                            Ordered  : in Boolean) is
   begin
      if Document.Has_Paragraph then
         Document.Writer.End_Element ("p");
         Document.Has_Paragraph := False;
      end if;
      if Document.Has_Item then
         Document.Writer.End_Element ("li");
         Document.Has_Item := False;
      end if;
      Document.Need_Paragraph := False;
      Document.Open_Paragraph;
      while Document.Current_Level < Level loop
         if Ordered then
            Document.Writer.Start_Element ("ol");
         else
            Document.Writer.Start_Element ("ul");
         end if;
         Document.Current_Level := Document.Current_Level + 1;
         Document.List_Styles (Document.Current_Level) := Ordered;
      end loop;
   end Add_List_Item;

   procedure Close_Paragraph (Document : in out Html_Renderer) is
   begin
      if Document.Html_Level > 0 then
         return;
      end if;
      if Document.Has_Paragraph then
         Document.Writer.End_Element ("p");
      end if;
      if Document.Has_Item then
         Document.Writer.End_Element ("li");
      end if;
      while Document.Current_Level > 0 loop
         if Document.List_Styles (Document.Current_Level) then
            Document.Writer.End_Element ("ol");
         else
            Document.Writer.End_Element ("ul");
         end if;
         Document.Current_Level := Document.Current_Level - 1;
      end loop;
      Document.Has_Paragraph := False;
      Document.Has_Item := False;
   end Close_Paragraph;

   procedure Open_Paragraph (Document : in out Html_Renderer) is
   begin
      if Document.Html_Level > 0 then
         return;
      end if;
      if Document.Need_Paragraph then
         Document.Writer.Start_Element ("p");
         Document.Has_Paragraph  := True;
         Document.Need_Paragraph := False;
      end if;
      if Document.Current_Level > 0 and not Document.Has_Item then
         Document.Writer.Start_Element ("li");
         Document.Has_Item := True;
      end if;
   end Open_Paragraph;

   --  ------------------------------
   --  Add an horizontal rule (
).
   --  ------------------------------
   overriding
   procedure Add_Horizontal_Rule (Document : in out Html_Renderer) is
   begin
      Document.Close_Paragraph;
      Document.Add_Blockquote (0);
      Document.Writer.Start_Element ("hr");
      Document.Writer.End_Element ("hr");
   end Add_Horizontal_Rule;

   --  ------------------------------
   --  Add a link.
   --  ------------------------------
   overriding
   procedure Add_Link (Document : in out Html_Renderer;
                       Name     : in Unbounded_Wide_Wide_String;
                       Link     : in Unbounded_Wide_Wide_String;
                       Language : in Unbounded_Wide_Wide_String;
                       Title    : in Unbounded_Wide_Wide_String) is
      Exists : Boolean;
      URI    : Unbounded_Wide_Wide_String;
   begin
      Document.Open_Paragraph;
      Document.Writer.Start_Element ("a");
      if Length (Title) > 0 then
         Document.Writer.Write_Wide_Attribute ("title", Title);
      end if;
      if Length (Language) > 0 then
         Document.Writer.Write_Wide_Attribute ("lang", Language);
      end if;
      Document.Links.Make_Page_Link (Link, URI, Exists);
      Document.Writer.Write_Wide_Attribute ("href", URI);
      Document.Writer.Write_Wide_Text (Name);
      Document.Writer.End_Element ("a");
   end Add_Link;

   --  ------------------------------
   --  Add an image.
   --  ------------------------------
   overriding
   procedure Add_Image (Document    : in out Html_Renderer;
                        Link        : in Unbounded_Wide_Wide_String;
                        Alt         : in Unbounded_Wide_Wide_String;
                        Position    : in Unbounded_Wide_Wide_String;
                        Description : in Unbounded_Wide_Wide_String) is
      pragma Unreferenced (Position);

      URI    : Unbounded_Wide_Wide_String;
      Width  : Natural;
      Height : Natural;
   begin
      Document.Open_Paragraph;
      Document.Writer.Start_Element ("img");
      if Length (Alt) > 0 then
         Document.Writer.Write_Wide_Attribute ("alt", Alt);
      end if;
      if Length (Description) > 0 then
         Document.Writer.Write_Wide_Attribute ("longdesc", Description);
      end if;
      Document.Links.Make_Image_Link (Link, URI, Width, Height);
      Document.Writer.Write_Wide_Attribute ("src", URI);
      if Width > 0 then
         Document.Writer.Write_Attribute ("width", Natural'Image (Width));
      end if;
      if Height > 0 then
         Document.Writer.Write_Attribute ("height", Natural'Image (Height));
      end if;
      Document.Writer.End_Element ("img");
   end Add_Image;

   --  ------------------------------
   --  Add a quote.
   --  ------------------------------
   overriding
   procedure Add_Quote (Document : in out Html_Renderer;
                        Quote    : in Unbounded_Wide_Wide_String;
                        Link     : in Unbounded_Wide_Wide_String;
                        Language : in Unbounded_Wide_Wide_String) is
   begin
      Document.Open_Paragraph;
      Document.Writer.Start_Element ("q");
      if Length (Language) > 0 then
         Document.Writer.Write_Wide_Attribute ("lang", Language);
      end if;
      if Length (Link) > 0 then
         Document.Writer.Write_Wide_Attribute ("cite", Link);
      end if;
      Document.Writer.Write_Wide_Text (Quote);
      Document.Writer.End_Element ("q");
   end Add_Quote;

   HTML_BOLD        : aliased constant String := "b";
   HTML_ITALIC      : aliased constant String := "i";
   HTML_CODE        : aliased constant String := "tt";
   HTML_SUPERSCRIPT : aliased constant String := "sup";
   HTML_SUBSCRIPT   : aliased constant String := "sub";
   HTML_STRIKEOUT   : aliased constant String := "del";
   --  HTML_UNDERLINE   : aliased constant String := "ins";
   HTML_PREFORMAT   : aliased constant String := "pre";

   type String_Array_Access is array (Documents.Format_Type) of Util.Strings.Name_Access;

   HTML_ELEMENT     : constant String_Array_Access :=
     (Documents.BOLD        => HTML_BOLD'Access,
      Documents.ITALIC      => HTML_ITALIC'Access,
      Documents.CODE        => HTML_CODE'Access,
      Documents.SUPERSCRIPT => HTML_SUPERSCRIPT'Access,
      Documents.SUBSCRIPT   => HTML_SUBSCRIPT'Access,
      Documents.STRIKEOUT   => HTML_STRIKEOUT'Access,
      Documents.PREFORMAT   => HTML_PREFORMAT'Access);

   --  ------------------------------
   --  Add a text block with the given format.
   --  ------------------------------
   overriding
   procedure Add_Text (Document : in out Html_Renderer;
                       Text     : in Unbounded_Wide_Wide_String;
                       Format   : in Wiki.Documents.Format_Map) is
   begin
      Document.Open_Paragraph;
      for I in Format'Range loop
         if Format (I) then
            Document.Writer.Start_Element (HTML_ELEMENT (I).all);
         end if;
      end loop;
      Document.Writer.Write_Wide_Text (Text);
      for I in reverse Format'Range loop
         if Format (I) then
            Document.Writer.End_Element (HTML_ELEMENT (I).all);
         end if;
      end loop;
   end Add_Text;

   --  ------------------------------
   --  Add a text block that is pre-formatted.
   --  ------------------------------
   procedure Add_Preformatted (Document : in out Html_Renderer;
                               Text     : in Unbounded_Wide_Wide_String;
                               Format   : in Unbounded_Wide_Wide_String) is
   begin
      Document.Close_Paragraph;
      if Format = "html" then
         Document.Writer.Write (Text);
      else
         Document.Writer.Start_Element ("pre");
         Document.Writer.Write_Wide_Text (Text);
         Document.Writer.End_Element ("pre");
      end if;
   end Add_Preformatted;

   overriding
   procedure Start_Element (Document   : in out Html_Renderer;
                            Name       : in Unbounded_Wide_Wide_String;
                            Attributes : in Wiki.Attributes.Attribute_List_Type) is
      Iter : Wiki.Attributes.Cursor := Wiki.Attributes.First (Attributes);
   begin
      Document.Html_Level := Document.Html_Level + 1;
      if Name = "p" then
         Document.Has_Paragraph := True;
         Document.Need_Paragraph := False;
      end if;
      Document.Writer.Start_Element (ACC.To_String (To_Wide_Wide_String (Name)));
      while Wiki.Attributes.Has_Element (Iter) loop
         Document.Writer.Write_Wide_Attribute (Name    => Wiki.Attributes.Get_Name (Iter),
                                               Content => Wiki.Attributes.Get_Wide_Value (Iter));
         Wiki.Attributes.Next (Iter);
      end loop;
   end Start_Element;

   overriding
   procedure End_Element (Document : in out Html_Renderer;
                          Name     : in Unbounded_Wide_Wide_String) is
   begin
      Document.Html_Level := Document.Html_Level - 1;
      if Name = "p" then
         Document.Has_Paragraph := False;
         Document.Need_Paragraph := True;
      end if;
      Document.Writer.End_Element (ACC.To_String (To_Wide_Wide_String (Name)));
   end End_Element;

   --  ------------------------------
   --  Finish the document after complete wiki text has been parsed.
   --  ------------------------------
   overriding
   procedure Finish (Document : in out Html_Renderer) is
   begin
      Document.Close_Paragraph;
      Document.Add_Blockquote (0);
   end Finish;

end Wiki.Render.Html;

Fix compilation warning

Fix compilation warning


-----------------------------------------------------------------------
--  util-serialize-tools -- Tools to Serialize objects in various formats
--  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 Util.Beans.Objects.Maps;
with Util.Serialize.IO.JSON;
package Util.Serialize.Tools is

   --  Serialize the objects defined in the object map Map into the Output
   --  JSON stream.  Use the Name as the name of the JSON object.
   procedure To_JSON (Output : in out Util.Serialize.IO.JSON.Output_Stream;
                      Name   : in String;
                      Map    : in Util.Beans.Objects.Maps.Map);

   --  Deserializes the JSON content passed in Content and restore the object map
   --  with their values.  The object map passed in Map can contain existing values.
   --  They will be overriden by the JSON values.
   procedure From_JSON (Content : in String;
                        Map     : in out Util.Beans.Objects.Maps.Map);

   --  Serialize the objects defined in the object map Map into an JSON stream.
   --  Returns the JSON string that contains a serialization of the object maps.
   function To_JSON (Map : in Util.Beans.Objects.Maps.Map) return String;

   --  Deserializes the XML content passed in Content and restore the object map
   --  with their values.
   --  Returns the object map that was restored.
   function From_JSON (Content : in String) return Util.Beans.Objects.Maps.Map;

end Util.Serialize.Tools;

-----------------------------------------------------------------------
--  util-serialize-tools -- Tools to Serialize objects in various formats
--  Copyright (C) 2012, 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 Util.Beans.Objects.Maps;
with Util.Serialize.IO.JSON;
package Util.Serialize.Tools is

   --  Serialize the objects defined in the object map Map into the Output
   --  JSON stream.  Use the Name as the name of the JSON object.
   procedure To_JSON (Output : in out Util.Serialize.IO.JSON.Output_Stream'Class;
                      Name   : in String;
                      Map    : in Util.Beans.Objects.Maps.Map);

   --  Deserializes the JSON content passed in Content and restore the object map
   --  with their values.  The object map passed in Map can contain existing values.
   --  They will be overriden by the JSON values.
   procedure From_JSON (Content : in String;
                        Map     : in out Util.Beans.Objects.Maps.Map);

   --  Serialize the objects defined in the object map Map into an JSON stream.
   --  Returns the JSON string that contains a serialization of the object maps.
   function To_JSON (Map : in Util.Beans.Objects.Maps.Map) return String;

   --  Deserializes the XML content passed in Content and restore the object map
   --  with their values.
   --  Returns the object map that was restored.
   function From_JSON (Content : in String) return Util.Beans.Objects.Maps.Map;

end Util.Serialize.Tools;

Change TO_JSON to accept class wide JSON Output_Stream


-----------------------------------------------------------------------
--  wiki-helpers -- Helper operations for wiki parsers and renderer
--  Copyright (C) 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.
-----------------------------------------------------------------------

package Wiki.Helpers is

   LF : constant Wide_Wide_Character := Wide_Wide_Character'Val (16#0A#);
   HT : constant Wide_Wide_Character := Wide_Wide_Character'Val (16#09#);

   --  Returns True if the character is a space or tab.
   function Is_Space (C : in Wide_Wide_Character) return Boolean;

   --  Returns True if the character is a space, tab or a newline.
   function Is_Space_Or_Newline (C : in Wide_Wide_Character) return Boolean;

end Wiki.Helpers;

-----------------------------------------------------------------------
--  wiki-helpers -- Helper operations for wiki parsers and renderer
--  Copyright (C) 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.
-----------------------------------------------------------------------

package Wiki.Helpers is

   LF : constant Wide_Wide_Character := Wide_Wide_Character'Val (16#0A#);
   HT : constant Wide_Wide_Character := Wide_Wide_Character'Val (16#09#);

   --  Returns True if the character is a space or tab.
   function Is_Space (C : in Wide_Wide_Character) return Boolean;

   --  Returns True if the character is a space, tab or a newline.
   function Is_Space_Or_Newline (C : in Wide_Wide_Character) return Boolean;

   --  Returns True if the text is a valid URL
   function Is_Url (Text : in Wide_Wide_String) return Boolean;

end Wiki.Helpers;

Declare the Is_Url function

Declare the Is_Url function