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

with Util.Log.Loggers;

with ADO.Objects;
with ADO.Queries;
with ADO.Statements;
with ADO.Sessions.Entities;

with AWA.Services.Contexts;
with AWA.Workspaces.Models;
with AWA.Workspaces.Modules;
with AWA.Permissions;
package body AWA.Storages.Services is

   use AWA.Services;

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("AWA.Storages.Services");

   --  ------------------------------
   --  Get the persistent store that manages the data represented by <tt>Data</tt>.
   --  ------------------------------
   function Get_Store (Service : in Storage_Service;
                       Data    : in AWA.Storages.Models.Storage_Ref'Class)
                       return AWA.Storages.Stores.Store_Access is
   begin
      return Service.Stores (Data.Get_Storage);
   end Get_Store;

   --  ------------------------------
   --  Initializes the storage service.
   --  ------------------------------
   overriding
   procedure Initialize (Service : in out Storage_Service;
                         Module  : in AWA.Modules.Module'Class) is
   begin
      AWA.Modules.Module_Manager (Service).Initialize (Module);
      Service.Stores (AWA.Storages.Models.DATABASE) := Service.Database_Store'Unchecked_Access;
   end Initialize;

   --  ------------------------------
   --  Save the data object contained in the Data part element into the
   --  target storage represented by Into.
   --  ------------------------------
   procedure Save (Service : in Storage_Service;
                   Into    : in out AWA.Storages.Models.Storage_Ref'Class;
                   Data    : in ASF.Parts.Part'Class;
                   Storage : in AWA.Storages.Models.Storage_Type) is
   begin
      Storage_Service'Class (Service).Save (Into, Data.Get_Local_Filename, Storage);
   end Save;

   --  ------------------------------
   --  Save the file pointed to by the Path string in the storage
   --  object represented by Into and managed by the storage service.
   --  ------------------------------
   procedure Save (Service : in Storage_Service;
                   Into    : in out AWA.Storages.Models.Storage_Ref'Class;
                   Path    : in String;
                   Storage : in AWA.Storages.Models.Storage_Type) is
      use type AWA.Storages.Models.Storage_Type;
      use type Stores.Store_Access;

      Ctx       : constant Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      DB        : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
      Workspace : AWA.Workspaces.Models.Workspace_Ref;
      Store     : Stores.Store_Access;
   begin
      Log.Info ("Save {0} in storage space", Path);

      Into.Set_Storage (Storage);
      Store := Storage_Service'Class (Service).Get_Store (Into);
      if Store = null then
         Log.Error ("There is no store for storage {0}", Models.Storage_Type'Image (Storage));
      end if;

      if not Into.Is_Null then
         Workspace := AWA.Workspaces.Models.Workspace_Ref (Into.Get_Workspace);
      end if;
      if Workspace.Is_Null then
         AWA.Workspaces.Modules.Get_Workspace (DB, Ctx, Workspace);
         Into.Set_Workspace (Workspace);
      end if;

      --  Check that the user has the create storage permission on the given workspace.
      AWA.Permissions.Check (Permission => ACL_Create_Storage.Permission,
                             Entity     => Workspace.Get_Id);

      Ctx.Start;
      if not Into.Is_Inserted then
         Into.Set_Create_Date (Ada.Calendar.Clock);
      end if;
      Store.Save (DB, Into, Path);
      Into.Save (DB);
      Ctx.Commit;
   end Save;

   --  Load the storage content identified by From in a local file
   --  that will be identified by Into.
   procedure Load (Service : in Storage_Service;
                   From    : in AWA.Storages.Models.Storage_Ref'Class;
                   Into    : in out AWA.Storages.Models.Store_Local_Ref'Class) is
   begin
      null;
   end Load;

   --  ------------------------------
   --  Load the storage content identified by From into the blob descriptor Into.
   --  Raises the NOT_FOUND exception if there is no such storage.
   --  ------------------------------
   procedure Load (Service : in Storage_Service;
                   From    : in ADO.Identifier;
                   Into    : out ADO.Blob_Ref) is
      pragma Unreferenced (Service);

      Ctx   : constant Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      User  : constant ADO.Identifier := Ctx.Get_User_Identifier;
      DB    : constant ADO.Sessions.Session := AWA.Services.Contexts.Get_Session (Ctx);
      Query : ADO.Statements.Query_Statement
        := DB.Create_Statement (Models.Query_Storage_Get_Data);
   begin
      Query.Bind_Param ("store_id", From);
      Query.Bind_Param ("user_id", User);
      ADO.Sessions.Entities.Bind_Param (Query, "table",
                                        AWA.Workspaces.Models.WORKSPACE_TABLE'Access, DB);

      Query.Execute;
      Into := Query.Get_Result_Blob;
   end Load;

   --  Load the storage content into a file.  If the data is not stored in a file, a temporary
   --  file is created with the data content fetched from the store (ex: the database).
   --  The `Mode` parameter indicates whether the file will be read or written.
   --  The `Expire` parameter allows to control the expiration of the temporary file.
   procedure Load (Service : in Storage_Service;
                   From    : in ADO.Identifier;
                   Into    : out AWA.Storages.Models.Store_Local_Ref;
                   Mode    : in Read_Mode := READ;
                   Expire  : in Expire_Type := ONE_DAY) is
      use type Stores.Store_Access;
      use type Models.Storage_Type;

      Ctx     : constant Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      User    : constant ADO.Identifier := Ctx.Get_User_Identifier;
      DB      : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
      Query   : ADO.Queries.Context;
      Found   : Boolean;
      Storage : AWA.Storages.Models.Storage_Ref;
      Store   : Stores.Store_Access;
   begin
      if Mode = READ then
         Query.Set_Query (AWA.Storages.Models.Query_Storage_Get_Local);
         Query.Bind_Param ("store_id", From);
         Query.Bind_Param ("user_id", User);
         Into.Find (DB, Query, Found);
         if Found then
            return;
         end if;
      end if;

      Query.Set_Query (AWA.Storages.Models.Query_Storage_Get_Storage);
      Query.Bind_Param ("store_id", From);
      Query.Bind_Param ("user_id", User);
      Storage.Find (DB, Query, Found);
      if not Found then
         raise ADO.Objects.NOT_FOUND;
      end if;

      if Storage.Get_Storage = AWA.Storages.Models.FILE then
         Into.Set_Path (String '(Storage.Get_Uri));
         return;
      end if;
      Store := Storage_Service'Class (Service).Get_Store (Storage);
      Store.Load (Session => DB,
                  From    => Storage,
                  Into    => Into.Get_Path);
   end Load;

   --  ------------------------------
   --  Deletes the storage instance.
   --  ------------------------------
   procedure Delete (Service : in Storage_Service;
                     Storage : in out AWA.Storages.Models.Storage_Ref'Class) is
      pragma Unreferenced (Service);

      Ctx : constant Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      DB  : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
      Id  : constant ADO.Identifier := ADO.Objects.Get_Value (Storage.Get_Key);
   begin
      Log.Info ("Delete storage {0}", ADO.Identifier'Image (Id));

      --  Check that the user has the delete storage permission on the given workspace.
      AWA.Permissions.Check (Permission => ACL_Delete_Storage.Permission,
                             Entity     => Id);

      Ctx.Start;
      Storage.Delete (DB);
      Ctx.Commit;
   end Delete;

   --  ------------------------------
   --  Deletes the storage instance.
   --  ------------------------------
   procedure Delete (Service : in Storage_Service;
                     Storage : in ADO.Identifier) is
      use type Stores.Store_Access;

      Ctx  : constant Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      DB   : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
      S    : AWA.Storages.Models.Storage_Ref;
      Query : ADO.Statements.Query_Statement
        := DB.Create_Statement (AWA.Storages.Models.Query_Storage_Delete_Local);
      Store : Stores.Store_Access;
   begin
      Log.Info ("Delete storage {0}", ADO.Identifier'Image (Storage));

      --  Check that the user has the delete storage permission on the given workspace.
      AWA.Permissions.Check (Permission => ACL_Delete_Storage.Permission,
                             Entity     => Storage);

      Ctx.Start;
      S.Load (Id => Storage, Session => DB);

      Store := Storage_Service'Class (Service).Get_Store (S);
      if Store = null then
         Log.Error ("There is no store associated with storage item {0}",
                    ADO.Identifier'Image (Storage));
      else
         Store.Delete (DB, S);
      end if;

      --  Delete the local storage instances.
      Query.Bind_Param ("store_id", Storage);
      Query.Execute;
      S.Delete (DB);
      Ctx.Commit;
   end Delete;

end AWA.Storages.Services;

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

with Util.Log.Loggers;

with ADO.Objects;
with ADO.Queries;
with ADO.Statements;
with ADO.Sessions.Entities;

with AWA.Services.Contexts;
with AWA.Workspaces.Models;
with AWA.Workspaces.Modules;
with AWA.Permissions;
package body AWA.Storages.Services is

   use AWA.Services;

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("AWA.Storages.Services");

   --  ------------------------------
   --  Get the persistent store that manages the data represented by <tt>Data</tt>.
   --  ------------------------------
   function Get_Store (Service : in Storage_Service;
                       Data    : in AWA.Storages.Models.Storage_Ref'Class)
                       return AWA.Storages.Stores.Store_Access is
   begin
      return Service.Stores (Data.Get_Storage);
   end Get_Store;

   --  ------------------------------
   --  Initializes the storage service.
   --  ------------------------------
   overriding
   procedure Initialize (Service : in out Storage_Service;
                         Module  : in AWA.Modules.Module'Class) is
   begin
      AWA.Modules.Module_Manager (Service).Initialize (Module);
      Service.Stores (AWA.Storages.Models.DATABASE) := Service.Database_Store'Unchecked_Access;
   end Initialize;

   --  ------------------------------
   --  Save the data object contained in the Data part element into the
   --  target storage represented by Into.
   --  ------------------------------
   procedure Save (Service : in Storage_Service;
                   Into    : in out AWA.Storages.Models.Storage_Ref'Class;
                   Data    : in ASF.Parts.Part'Class;
                   Storage : in AWA.Storages.Models.Storage_Type) is
   begin
      Storage_Service'Class (Service).Save (Into, Data.Get_Local_Filename, Storage);
   end Save;

   --  ------------------------------
   --  Save the file pointed to by the Path string in the storage
   --  object represented by Into and managed by the storage service.
   --  ------------------------------
   procedure Save (Service : in Storage_Service;
                   Into    : in out AWA.Storages.Models.Storage_Ref'Class;
                   Path    : in String;
                   Storage : in AWA.Storages.Models.Storage_Type) is
      use type AWA.Storages.Models.Storage_Type;
      use type Stores.Store_Access;

      Ctx       : constant Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      DB        : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
      Workspace : AWA.Workspaces.Models.Workspace_Ref;
      Store     : Stores.Store_Access;
   begin
      Log.Info ("Save {0} in storage space", Path);

      Into.Set_Storage (Storage);
      Store := Storage_Service'Class (Service).Get_Store (Into);
      if Store = null then
         Log.Error ("There is no store for storage {0}", Models.Storage_Type'Image (Storage));
      end if;

      if not Into.Is_Null then
         Workspace := AWA.Workspaces.Models.Workspace_Ref (Into.Get_Workspace);
      end if;
      if Workspace.Is_Null then
         AWA.Workspaces.Modules.Get_Workspace (DB, Ctx, Workspace);
         Into.Set_Workspace (Workspace);
      end if;

      --  Check that the user has the create storage permission on the given workspace.
      AWA.Permissions.Check (Permission => ACL_Create_Storage.Permission,
                             Entity     => Workspace.Get_Id);

      Ctx.Start;
      if not Into.Is_Inserted then
         Into.Set_Create_Date (Ada.Calendar.Clock);
      end if;
      Into.Save (DB);
      Store.Save (DB, Into, Path);
      Into.Save (DB);
      Ctx.Commit;
   end Save;

   --  Load the storage content identified by From in a local file
   --  that will be identified by Into.
   procedure Load (Service : in Storage_Service;
                   From    : in AWA.Storages.Models.Storage_Ref'Class;
                   Into    : in out AWA.Storages.Models.Store_Local_Ref'Class) is
   begin
      null;
   end Load;

   --  ------------------------------
   --  Load the storage content identified by From into the blob descriptor Into.
   --  Raises the NOT_FOUND exception if there is no such storage.
   --  ------------------------------
   procedure Load (Service : in Storage_Service;
                   From    : in ADO.Identifier;
                   Into    : out ADO.Blob_Ref) is
      pragma Unreferenced (Service);

      Ctx   : constant Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      User  : constant ADO.Identifier := Ctx.Get_User_Identifier;
      DB    : constant ADO.Sessions.Session := AWA.Services.Contexts.Get_Session (Ctx);
      Query : ADO.Statements.Query_Statement
        := DB.Create_Statement (Models.Query_Storage_Get_Data);
   begin
      Query.Bind_Param ("store_id", From);
      Query.Bind_Param ("user_id", User);
      ADO.Sessions.Entities.Bind_Param (Query, "table",
                                        AWA.Workspaces.Models.WORKSPACE_TABLE'Access, DB);

      Query.Execute;
      Into := Query.Get_Result_Blob;
   end Load;

   --  Load the storage content into a file.  If the data is not stored in a file, a temporary
   --  file is created with the data content fetched from the store (ex: the database).
   --  The `Mode` parameter indicates whether the file will be read or written.
   --  The `Expire` parameter allows to control the expiration of the temporary file.
   procedure Load (Service : in Storage_Service;
                   From    : in ADO.Identifier;
                   Into    : out AWA.Storages.Models.Store_Local_Ref;
                   Mode    : in Read_Mode := READ;
                   Expire  : in Expire_Type := ONE_DAY) is
      use type Stores.Store_Access;
      use type Models.Storage_Type;

      Ctx     : constant Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      User    : constant ADO.Identifier := Ctx.Get_User_Identifier;
      DB      : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
      Query   : ADO.Queries.Context;
      Found   : Boolean;
      Storage : AWA.Storages.Models.Storage_Ref;
      Store   : Stores.Store_Access;
   begin
      if Mode = READ then
         Query.Set_Query (AWA.Storages.Models.Query_Storage_Get_Local);
         Query.Bind_Param ("store_id", From);
         Query.Bind_Param ("user_id", User);
         Into.Find (DB, Query, Found);
         if Found then
            return;
         end if;
      end if;

      Query.Set_Query (AWA.Storages.Models.Query_Storage_Get_Storage);
      Query.Bind_Param ("store_id", From);
      Query.Bind_Param ("user_id", User);
      Storage.Find (DB, Query, Found);
      if not Found then
         raise ADO.Objects.NOT_FOUND;
      end if;

      if Storage.Get_Storage = AWA.Storages.Models.FILE then
         Into.Set_Path (String '(Storage.Get_Uri));
         return;
      end if;
      Store := Storage_Service'Class (Service).Get_Store (Storage);
      Store.Load (Session => DB,
                  From    => Storage,
                  Into    => Into.Get_Path);
   end Load;

   --  ------------------------------
   --  Deletes the storage instance.
   --  ------------------------------
   procedure Delete (Service : in Storage_Service;
                     Storage : in out AWA.Storages.Models.Storage_Ref'Class) is
      pragma Unreferenced (Service);

      Ctx : constant Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      DB  : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
      Id  : constant ADO.Identifier := ADO.Objects.Get_Value (Storage.Get_Key);
   begin
      Log.Info ("Delete storage {0}", ADO.Identifier'Image (Id));

      --  Check that the user has the delete storage permission on the given workspace.
      AWA.Permissions.Check (Permission => ACL_Delete_Storage.Permission,
                             Entity     => Id);

      Ctx.Start;
      Storage.Delete (DB);
      Ctx.Commit;
   end Delete;

   --  ------------------------------
   --  Deletes the storage instance.
   --  ------------------------------
   procedure Delete (Service : in Storage_Service;
                     Storage : in ADO.Identifier) is
      use type Stores.Store_Access;

      Ctx  : constant Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      DB   : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
      S    : AWA.Storages.Models.Storage_Ref;
      Query : ADO.Statements.Query_Statement
        := DB.Create_Statement (AWA.Storages.Models.Query_Storage_Delete_Local);
      Store : Stores.Store_Access;
   begin
      Log.Info ("Delete storage {0}", ADO.Identifier'Image (Storage));

      --  Check that the user has the delete storage permission on the given workspace.
      AWA.Permissions.Check (Permission => ACL_Delete_Storage.Permission,
                             Entity     => Storage);

      Ctx.Start;
      S.Load (Id => Storage, Session => DB);

      Store := Storage_Service'Class (Service).Get_Store (S);
      if Store = null then
         Log.Error ("There is no store associated with storage item {0}",
                    ADO.Identifier'Image (Storage));
      else
         Store.Delete (DB, S);
      end if;

      --  Delete the local storage instances.
      Query.Bind_Param ("store_id", Storage);
      Query.Execute;
      S.Delete (DB);
      Ctx.Commit;
   end Delete;

end AWA.Storages.Services;

Save the file before invoking the store specific save operation


-- The Cupcake GUI Toolkit
-- (c) Kristian Klomsten Skordal 2012 <kristian.skordal@gmail.com>
-- Report bugs and issues on <http://github.com/skordal/cupcake/issues>

with Ada.Text_IO;
with Ada.Unchecked_Deallocation;
with Interfaces.C.Strings;

package body Cupcake.Windows is
	package C renames Interfaces.C;

	-- Available backend functions:
	function Backend_Window_Create(Parent : in Backend_Data_Ptr;
		Width, Height : in Positive) return Backend_Data_Ptr;
	procedure Backend_Window_Finalize(Window : in Backend_Data_Ptr);
	procedure Backend_Window_Set_Title(Window : in Backend_Data_Ptr;
		Title : in C.Strings.chars_ptr);
	function Backend_Window_Get_ID(Window : in Backend_Data_Ptr) return Window_ID_Type;
	procedure Backend_Window_Show(Window : in Backend_Data_Ptr);
	procedure Backend_Window_Close(Window : in Backend_Data_Ptr);

	pragma Import(C, Backend_Window_Create, "backend_window_create");
	pragma Import(C, Backend_Window_Finalize, "backend_window_finalize");
	pragma Import(C, Backend_Window_Set_Title, "backend_window_set_title");
	pragma Import(C, Backend_Window_Get_ID, "backend_window_get_id");
	pragma Import(C, Backend_Window_Show, "backend_window_show");
	pragma import(C, Backend_Window_Close, "backend_window_close");

	-- Creates a new window:
	function New_Window(Width, Height : in Positive; Title : in String) return Window is
		Size : constant Primitives.Dimension := (Width, Height);
	begin
		return New_Window(Size, Title);
	end New_Window;

	-- Creates a new window:
	function New_Window(Size : in Primitives.Dimension; Title : in String) return Window is
		Retval : constant Window := new Window_Record;
		C_Title : C.Strings.chars_ptr := C.Strings.New_String(Title);
	begin
		Retval.Backend_Data := Backend_Window_Create(System.Null_Address,
			Size.Width, Size.Height);
		Retval.Window_ID := Backend_Window_Get_ID(Retval.Backend_Data);
		Retval.Size := Size;

		Backend_Window_Set_Title(Retval.Backend_Data, C_Title);
		C.Strings.Free(C_Title);

		Retval.Graphics_Context := Graphics.New_Context(Retval.Backend_Data, Size);

		Window_List.Append(Retval);

		return Retval;
	end New_Window;

	-- Destroys a window:
	procedure Destroy(Object : not null access Window_Record) is
		use Cupcake.Layouts;

		-- Deallocation procedure for window records:
		type Window_Access is access all Window_Record;
		procedure Free is new Ada.Unchecked_Deallocation(Object => Window_Record,
			Name => Window_Access);

		Win : Window_Access := Window_Access(Object);
	begin
		if Object.Layout /= null then
			Layouts.Destroy(Object.Layout);
		end if;

		Object.Close;
		Backend_Window_Finalize(Object.Backend_Data);
		Free(Win);
	end Destroy;

	-- Shows a window:
	procedure Show(This : in Window_Record'Class) is
	begin
		Backend_Window_Show(This.Backend_Data);
	end Show;

	-- Closes a window:
	procedure Close(This : in Window_Record'Class) is
	begin
		Backend_Window_Close(This.Backend_Data);
	end Close;

	-- Gets the window ID:
	function Get_ID(This : in Window_Record'Class) return Window_ID_Type is
	begin
		return This.Window_ID;
	end Get_ID;

	-- Gets the size of a window:
	function Get_Size(This : in Window_Record'Class) return Primitives.Dimension is
	begin
		return This.Size;
	end Get_Size;

	-- Gets the background color of a window:
	function Get_Background_Color(This : in Window_Record'Class) return Colors.Color is
	begin
		return This.Background_Color;
	end Get_Background_Color;

	-- Sets the background color of a window:
	procedure Set_Background_Color(This : out Window_Record'Class; Color : in Colors.Color) is
	begin
		This.Background_Color := Color;
	end Set_Background_Color;

	-- Sets the layout of a window:
	procedure Set_Layout(This : out Window_Record'Class; Layout : in Layouts.Layout) is
	begin
		This.Layout := Layout;
	end Set_Layout;

	-- Gets the layout of a window:
	function Get_Layout(This : in Window_Record'Class) return Layouts.Layout is
	begin
		return This.Layout;
	end Get_Layout;

	-- Expose handlers for windows:
	procedure Expose_Handler(This : in out Window_Record; Graphics_Context : in Graphics.Context) is
		use Cupcake.Layouts;
		Entire_Window : constant Primitives.Rectangle := ((0, 0), This.Get_Size);
	begin
		Graphics_Context.Fill(This.Get_Background_Color, Entire_Window);
		if This.Layout /= null then
			if Debug_Mode then
				Ada.Text_IO.Put_Line(
					"[Window_Record => Expose_Handler] Propagating expose event to layout");
			end if;
			This.Layout.Expose_Handler(Graphics_Context);
		end if;
	end Expose_Handler;

	-- Resize handler for windows:
	procedure Resize_Handler(This : in out Window_Record; New_Size : in Primitives.Dimension) is
		use Cupcake.Layouts;
	begin
		This.Size := New_Size;
		This.Graphics_Context.Set_Size(New_Size);

		if This.Layout /= null then
			if Debug_Mode then
				Ada.Text_IO.Put_Line(
					"[Window_Record => Resize_Handler] Propagating resize event to layout");
			end if;
			This.Layout.Resize_Handler(New_Size);
		end if;
	end Resize_Handler;

	-- Mouse event handler:
	function Mouse_Handler(This : in Window_Record; Mouse_Event : in Events.Mouse_Event_Record)
		return Boolean is
	begin
		return true;
	end Mouse_Handler;

	-- Keyboard event handler:
	function Keyboard_Handler(This : in Window_Record; Keyboard_Event : in Events.Keyboard_Event_Record)
		return Boolean is
	begin
		return true;
	end Keyboard_Handler;

	-- Window closing handler:
	function Window_Closing_Handler(This : in Window_Record) return Boolean is
	begin
		return true;
	end Window_Closing_Handler;

	-- Finds a window by its ID:
	function Find_Window_By_ID(ID : in Window_ID_Type) return Window is
		use Window_Lists;
		Window_Cursor : Cursor := Window_List.First;
	begin
		while Has_Element(Window_Cursor) loop
			if Element(Window_Cursor).Window_ID = ID then
				return Element(Window_Cursor);
			end if;
			Window_Cursor := Next(Window_Cursor);
		end loop;

		return null;
	end Find_Window_By_ID;

	-- Gets the backend specific data pointer from a window by its ID:
	function Get_Backend_Data_For_Window_By_ID(ID : in Window_ID_Type) return Backend_Data_Ptr is
		Target : constant Window := Find_Window_By_ID(ID);
	begin
		return Target.Backend_Data;
	end Get_Backend_Data_For_Window_By_ID;

	-- Posts an expose event to a window:
	procedure Post_Expose(ID : in Window_ID_Type) is
		use Cupcake.Events;
		Target : constant Window := Find_Window_By_ID(ID);
	begin
		if Debug_Mode then
			Ada.Text_IO.Put_Line("Expose event received for window"
				& Window_ID_Type'Image(ID));
		end if;

		if Target = null then
			Ada.Text_IO.Put_Line("Invalid window ID" & Window_ID_Type'Image(ID));
		else
			Target.Expose_Handler(Target.Graphics_Context);
		end if;
	end Post_Expose;

	-- Posts a resize event to a window:
	procedure Post_Resize(ID : in Window_ID_Type; Width, Height : in Natural) is
		Target : constant Window := Find_Window_By_ID(ID);
	begin
		if Debug_Mode then
			Ada.Text_IO.Put_Line("Resize event received for window " & Window_ID_Type'Image(ID)
				& " with width " & Natural'Image(Width) & " and height " & Natural'Image(Height));
		end if;

		if Target = null then
			Ada.Text_IO.Put_Line("Invalid window ID" & Window_ID_Type'Image(ID));
		else
			Target.Resize_Handler((Width, Height));
		end if;
	end Post_Resize;

	-- Posts a window close event to a window:
	function Post_Window_Close(ID : in Window_ID_Type) return Integer is
		use Cupcake.Events;
		Target : constant Window := Find_Window_By_ID(ID);
		Target_Cursor : Window_Lists.Cursor := Window_List.Find(Target);
		Closing : Boolean := false;
	begin
		if Debug_Mode then
			Ada.Text_IO.Put_Line("Window close event received for window"
				& Window_ID_Type'Image(ID));
		end if;

		if Target = null or not Window_Lists.Has_Element(Target_Cursor) then
			Ada.Text_IO.Put_Line("Invalid window ID or not visible window: "
				& Window_ID_Type'Image(ID));
			return 0;
		end if;

		Closing := Target.Window_Closing_Handler;

		if Closing then
			Window_List.Delete(Target_Cursor);
			return 1;
		else
			return 0;
		end if;
	end Post_Window_Close;

	-- Gets the number of windows remaining:
	function Get_Num_Windows_Remaining return Natural is
	begin
		return Natural(Window_List.Length);
	end Get_Num_Windows_Remaining;

end Cupcake.Windows;

-- The Cupcake GUI Toolkit
-- (c) Kristian Klomsten Skordal 2012 <kristian.skordal@gmail.com>
-- Report bugs and issues on <http://github.com/skordal/cupcake/issues>

with Ada.Text_IO;
with Ada.Unchecked_Deallocation;
with Interfaces.C.Strings;

package body Cupcake.Windows is
	package C renames Interfaces.C;

	-- Available backend functions:
	function Backend_Window_Create(Parent : in Backend_Data_Ptr;
		Width, Height : in Positive) return Backend_Data_Ptr;
	procedure Backend_Window_Finalize(Window : in Backend_Data_Ptr);
	procedure Backend_Window_Set_Title(Window : in Backend_Data_Ptr;
		Title : in C.Strings.chars_ptr);
	function Backend_Window_Get_ID(Window : in Backend_Data_Ptr) return Window_ID_Type;
	procedure Backend_Window_Show(Window : in Backend_Data_Ptr);
	procedure Backend_Window_Close(Window : in Backend_Data_Ptr);

	pragma Import(C, Backend_Window_Create, "backend_window_create");
	pragma Import(C, Backend_Window_Finalize, "backend_window_finalize");
	pragma Import(C, Backend_Window_Set_Title, "backend_window_set_title");
	pragma Import(C, Backend_Window_Get_ID, "backend_window_get_id");
	pragma Import(C, Backend_Window_Show, "backend_window_show");
	pragma import(C, Backend_Window_Close, "backend_window_close");

	-- Creates a new window:
	function New_Window(Width, Height : in Positive; Title : in String) return Window is
		Size : constant Primitives.Dimension := (Width, Height);
	begin
		return New_Window(Size, Title);
	end New_Window;

	-- Creates a new window:
	function New_Window(Size : in Primitives.Dimension; Title : in String) return Window is
		Retval : constant Window := new Window_Record;
		C_Title : C.Strings.chars_ptr := C.Strings.New_String(Title);
	begin
		Retval.Backend_Data := Backend_Window_Create(System.Null_Address,
			Size.Width, Size.Height);
		Retval.Window_ID := Backend_Window_Get_ID(Retval.Backend_Data);
		Retval.Size := Size;

		Backend_Window_Set_Title(Retval.Backend_Data, C_Title);
		C.Strings.Free(C_Title);

		Retval.Graphics_Context := Graphics.New_Context(Retval.Backend_Data, Size);

		Window_List.Append(Retval);

		return Retval;
	end New_Window;

	-- Destroys a window:
	procedure Destroy(Object : not null access Window_Record) is
		use Cupcake.Layouts;

		-- Deallocation procedure for window records:
		type Window_Access is access all Window_Record;
		procedure Free is new Ada.Unchecked_Deallocation(Object => Window_Record,
			Name => Window_Access);

		Win : Window_Access := Window_Access(Object);
	begin
		if Object.Layout /= null then
			Layouts.Destroy(Object.Layout);
		end if;

		Object.Close;
		Backend_Window_Finalize(Object.Backend_Data);
		Free(Win);
	end Destroy;

	-- Shows a window:
	procedure Show(This : in Window_Record'Class) is
	begin
		Backend_Window_Show(This.Backend_Data);
	end Show;

	-- Closes a window:
	procedure Close(This : in Window_Record'Class) is
	begin
		Backend_Window_Close(This.Backend_Data);
	end Close;

	-- Gets the window ID:
	function Get_ID(This : in Window_Record'Class) return Window_ID_Type is
	begin
		return This.Window_ID;
	end Get_ID;

	-- Gets the size of a window:
	function Get_Size(This : in Window_Record'Class) return Primitives.Dimension is
	begin
		return This.Size;
	end Get_Size;

	-- Gets the background color of a window:
	function Get_Background_Color(This : in Window_Record'Class) return Colors.Color is
	begin
		return This.Background_Color;
	end Get_Background_Color;

	-- Sets the background color of a window:
	procedure Set_Background_Color(This : out Window_Record'Class; Color : in Colors.Color) is
	begin
		This.Background_Color := Color;
	end Set_Background_Color;

	-- Sets the layout of a window:
	procedure Set_Layout(This : out Window_Record'Class; Layout : in Layouts.Layout) is
	begin
		This.Layout := Layout;
	end Set_Layout;

	-- Gets the layout of a window:
	function Get_Layout(This : in Window_Record'Class) return Layouts.Layout is
	begin
		return This.Layout;
	end Get_Layout;

	-- Expose handlers for windows:
	procedure Expose_Handler(This : in out Window_Record; Graphics_Context : in Graphics.Context) is
		use Cupcake.Layouts;
		Entire_Window : constant Primitives.Rectangle := ((0, 0), This.Get_Size);
	begin
		Graphics_Context.Fill(This.Get_Background_Color, Entire_Window);
		if This.Layout /= null then
			if Debug_Mode then
				Ada.Text_IO.Put_Line(
					"[Window_Record => Expose_Handler] Propagating expose event to layout");
			end if;
			This.Layout.Expose_Handler(Graphics_Context);
		end if;
	end Expose_Handler;

	-- Resize handler for windows:
	procedure Resize_Handler(This : in out Window_Record; New_Size : in Primitives.Dimension) is
		use Cupcake.Layouts;
	begin
		This.Size := New_Size;
		This.Graphics_Context.Set_Size(New_Size);

		if This.Layout /= null then
			if Debug_Mode then
				Ada.Text_IO.Put_Line(
					"[Window_Record => Resize_Handler] Propagating resize event to layout");
			end if;
			This.Layout.Resize_Handler(New_Size);
		end if;
	end Resize_Handler;

	-- Mouse event handler:
	function Mouse_Handler(This : in Window_Record; Mouse_Event : in Events.Mouse_Event_Record)
		return Boolean is
	begin
		return true;
	end Mouse_Handler;

	-- Keyboard event handler:
	function Keyboard_Handler(This : in Window_Record; Keyboard_Event : in Events.Keyboard_Event_Record)
		return Boolean is
	begin
		return true;
	end Keyboard_Handler;

	-- Window closing handler:
	function Window_Closing_Handler(This : in Window_Record) return Boolean is
	begin
		return true;
	end Window_Closing_Handler;

	-- Window closing message handler:

	-- Finds a window by its ID:
	function Find_Window_By_ID(ID : in Window_ID_Type) return Window is
		use Window_Lists;
		Window_Cursor : Cursor := Window_List.First;
	begin
		while Has_Element(Window_Cursor) loop
			if Element(Window_Cursor).Window_ID = ID then
				return Element(Window_Cursor);
			end if;
			Window_Cursor := Next(Window_Cursor);
		end loop;

		return null;
	end Find_Window_By_ID;

	-- Gets the backend specific data pointer from a window by its ID:
	function Get_Backend_Data_For_Window_By_ID(ID : in Window_ID_Type) return Backend_Data_Ptr is
		Target : constant Window := Find_Window_By_ID(ID);
	begin
		return Target.Backend_Data;
	end Get_Backend_Data_For_Window_By_ID;

	-- Posts an expose event to a window:
	procedure Post_Expose(ID : in Window_ID_Type) is
		use Cupcake.Events;
		Target : constant Window := Find_Window_By_ID(ID);
	begin
		if Debug_Mode then
			Ada.Text_IO.Put_Line("Expose event received for window"
				& Window_ID_Type'Image(ID));
		end if;

		if Target = null then
			Ada.Text_IO.Put_Line("Invalid window ID" & Window_ID_Type'Image(ID));
		else
			Target.Expose_Handler(Target.Graphics_Context);
		end if;
	end Post_Expose;

	-- Posts a resize event to a window:
	procedure Post_Resize(ID : in Window_ID_Type; Width, Height : in Natural) is
		Target : constant Window := Find_Window_By_ID(ID);
	begin
		if Debug_Mode then
			Ada.Text_IO.Put_Line("Resize event received for window " & Window_ID_Type'Image(ID)
				& " with width " & Natural'Image(Width) & " and height " & Natural'Image(Height));
		end if;

		if Target = null then
			Ada.Text_IO.Put_Line("Invalid window ID" & Window_ID_Type'Image(ID));
		else
			Target.Resize_Handler((Width, Height));
		end if;
	end Post_Resize;

	-- Posts a window close event to a window:
	function Post_Window_Close(ID : in Window_ID_Type) return Integer is
		use Cupcake.Events;
		Target : constant Window := Find_Window_By_ID(ID);
		Target_Cursor : Window_Lists.Cursor := Window_List.Find(Target);
		Closing : Boolean := false;
	begin
		if Debug_Mode then
			Ada.Text_IO.Put_Line("Window close event received for window"
				& Window_ID_Type'Image(ID));
		end if;

		if Target = null or not Window_Lists.Has_Element(Target_Cursor) then
			Ada.Text_IO.Put_Line("Invalid window ID or not visible window: "
				& Window_ID_Type'Image(ID));
			return 0;
		end if;

		Closing := Target.Window_Closing_Handler;

		if Closing then
			Window_List.Delete(Target_Cursor);
			return 1;
		else
			return 0;
		end if;
	end Post_Window_Close;

	-- Gets the number of windows remaining:
	function Get_Num_Windows_Remaining return Natural is
	begin
		return Natural(Window_List.Length);
	end Get_Num_Windows_Remaining;

end Cupcake.Windows;

Revert "Removed an incorrect comment" due to collision with new backend code

This reverts commit 03a3feb87e092822c091fd67feefb1b22f3bca07.


-----------------------------------------------------------------------
--  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 stream.
   --  ------------------------------
   procedure Set_Output_Stream (Engine : in out Html_Renderer;
                                Stream : in Wiki.Streams.Html.Html_Output_Stream_Access) is
   begin
      Engine.Output := Stream;
   end Set_Output_Stream;

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

   --  ------------------------------
   --  Render the node instance from the document.
   --  ------------------------------
   overriding
   procedure Render (Engine : in out Html_Renderer;
                     Doc    : in Wiki.Nodes.Document;
                     Node   : in Wiki.Nodes.Node_Type) is
      use type Wiki.Nodes.Html_Tag_Type;
      use type Wiki.Nodes.Node_List_Access;
   begin
      case Node.Kind is
         when Wiki.Nodes.N_HEADER =>
            Engine.Render_Header (Header => Node.Header,
                                  Level  => Node.Level);

         when Wiki.Nodes.N_LINE_BREAK =>
            Engine.Output.Start_Element ("br");
            Engine.Output.End_Element ("br");

         when Wiki.Nodes.N_HORIZONTAL_RULE =>
            Engine.Close_Paragraph;
            Engine.Add_Blockquote (0);
            Engine.Output.Start_Element ("hr");
            Engine.Output.End_Element ("hr");

         when Wiki.Nodes.N_PARAGRAPH =>
            Engine.Close_Paragraph;
            Engine.Need_Paragraph := True;

         when Wiki.Nodes.N_PREFORMAT =>
            Engine.Render_Preformatted (Doc, Node.Preformatted, "");

         when Wiki.Nodes.N_INDENT =>
            -- Engine.Indent_Level := Node.Level;
            null;

         when Wiki.Nodes.N_TEXT =>
            Engine.Add_Text (Text   => Node.Text,
                             Format => Node.Format);

         when Wiki.Nodes.N_QUOTE =>
            Engine.Render_Quote (Doc, Node.Title, Node.Link_Attr);

         when Wiki.Nodes.N_LINK =>
            Engine.Render_Link (Doc, Node.Title, Node.Link_Attr);

         when Wiki.Nodes.N_IMAGE =>
            Engine.Render_Image (Doc, Node.Title, Node.Link_Attr);

         when Wiki.Nodes.N_BLOCKQUOTE =>
            Engine.Add_Blockquote (Node.Level);

         when Wiki.Nodes.N_TAG_START =>
            Engine.Render_Tag (Doc, Node);

      end case;
   end Render;

   procedure Render_Tag (Engine : in out Html_Renderer;
                         Doc    : in Wiki.Nodes.Document;
                         Node   : in Wiki.Nodes.Node_Type) is
      use type Wiki.Nodes.Html_Tag_Type;

      Name : constant Wiki.Nodes.String_Access := Wiki.Nodes.Get_Tag_Name (Node.Tag_Start);
      Iter : Wiki.Attributes.Cursor := Wiki.Attributes.First (Node.Attributes);
   begin
      if Node.Tag_Start = Wiki.Nodes.P_TAG then
         Engine.Has_Paragraph := True;
         Engine.Need_Paragraph := False;
      end if;
      Engine.Output.Start_Element (Name.all);
      while Wiki.Attributes.Has_Element (Iter) loop
         Engine.Output.Write_Wide_Attribute (Name    => Wiki.Attributes.Get_Name (Iter),
                                             Content => Wiki.Attributes.Get_Wide_Value (Iter));
         Wiki.Attributes.Next (Iter);
      end loop;
      Engine.Render (Doc, Node.Children);
      if Node.Tag_Start = Wiki.Nodes.P_TAG then
         Engine.Has_Paragraph := False;
         Engine.Need_Paragraph := True;
      end if;
      Engine.Output.End_Element (Name.all);
   end Render_Tag;

   --  ------------------------------
   --  Render a section header in the document.
   --  ------------------------------
   procedure Render_Header (Engine : in out Html_Renderer;
                            Header : in Wiki.Strings.WString;
                            Level  : in Positive) is
   begin
      Engine.Close_Paragraph;
      Engine.Add_Blockquote (0);
      case Level is
         when 1 =>
            Engine.Output.Write_Wide_Element ("h1", Header);

         when 2 =>
            Engine.Output.Write_Wide_Element ("h2", Header);

         when 3 =>
            Engine.Output.Write_Wide_Element ("h3", Header);

         when 4 =>
            Engine.Output.Write_Wide_Element ("h4", Header);

         when 5 =>
            Engine.Output.Write_Wide_Element ("h5", Header);

         when 6 =>
            Engine.Output.Write_Wide_Element ("h6", Header);

         when others =>
            Engine.Output.Write_Wide_Element ("h3", Header);
      end case;
   end Render_Header;

   --  ------------------------------
   --  Add a blockquote (<blockquote>).  The level indicates the blockquote nested level.
   --  The blockquote must be closed at the next header.
   --  ------------------------------
   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.Output.Start_Element ("blockquote");
         Document.Quote_Level := Document.Quote_Level + 1;
      end loop;
      while Document.Quote_Level > Level loop
         Document.Output.End_Element ("blockquote");
         Document.Quote_Level := Document.Quote_Level - 1;
      end loop;
   end Add_Blockquote;

   --  ------------------------------
   --  Add a list item (<li>).  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.
   --  ------------------------------
   procedure Add_List_Item (Document : in out Html_Renderer;
                            Level    : in Positive;
                            Ordered  : in Boolean) is
   begin
      if Document.Has_Paragraph then
         Document.Output.End_Element ("p");
         Document.Has_Paragraph := False;
      end if;
      if Document.Has_Item then
         Document.Output.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.Output.Start_Element ("ol");
         else
            Document.Output.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.Output.End_Element ("p");
      end if;
      if Document.Has_Item then
         Document.Output.End_Element ("li");
      end if;
      while Document.Current_Level > 0 loop
         if Document.List_Styles (Document.Current_Level) then
            Document.Output.End_Element ("ol");
         else
            Document.Output.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.Output.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.Output.Start_Element ("li");
         Document.Has_Item := True;
      end if;
   end Open_Paragraph;

   --  ------------------------------
   --  Render a link.
   --  ------------------------------
   procedure Render_Link (Engine : in out Html_Renderer;
                          Doc    : in Wiki.Nodes.Document;
                          Title  : in Wiki.Strings.WString;
                          Attr   : in Wiki.Attributes.Attribute_List_Type) is

      procedure Render_Attribute (Name  : in String;
                                  Value : in Wide_Wide_String) is
      begin
         if Name = "href" then
            declare
               URI    : Unbounded_Wide_Wide_String;
               Exists : Boolean;
            begin
               Engine.Links.Make_Page_Link (Value, URI, Exists);
               Engine.Output.Write_Wide_Attribute ("href", URI);
            end;

         elsif Value'Length = 0 then
            return;

         elsif Name = "hreflang" or Name = "title" or Name = "rel" or Name = "target"
         or Name = "style" or Name = "class" then
            Engine.Output.Write_Wide_Attribute (Name, Value);
         end if;
      end Render_Attribute;

   begin
      Engine.Open_Paragraph;
      Engine.Output.Start_Element ("a");
      Wiki.Attributes.Iterate (Attr, Render_Attribute'Access);
      Engine.Output.Write_Wide_Text (Title);
      Engine.Output.End_Element ("a");
   end Render_Link;

   --  ------------------------------
   --  Render an image.
   --  ------------------------------
   procedure Render_Image (Engine : in out Html_Renderer;
                           Doc    : in Wiki.Nodes.Document;
                           Title  : in Wiki.Strings.WString;
                           Attr   : in Wiki.Attributes.Attribute_List_Type) is
      Link   : Unbounded_Wide_Wide_String := Wiki.Attributes.Get_Attribute (Attr, "href");
      URI    : Unbounded_Wide_Wide_String;
      Width  : Natural;
      Height : Natural;

      procedure Render_Attribute (Name  : in String;
                                  Value : in Wide_Wide_String) is
      begin
         if Name = "alt" or Name = "longdesc"
           or Name = "style" or Name = "class" then
            Engine.Output.Write_Wide_Attribute (Name, Value);
         end if;
      end Render_Attribute;

   begin
      Engine.Open_Paragraph;
      Engine.Output.Start_Element ("img");
      Engine.Links.Make_Image_Link (Link, URI, Width, Height);
      Engine.Output.Write_Wide_Attribute ("src", URI);
      if Width > 0 then
         Engine.Output.Write_Attribute ("width", Natural'Image (Width));
      end if;
      if Height > 0 then
         Engine.Output.Write_Attribute ("height", Natural'Image (Height));
      end if;
      Wiki.Attributes.Iterate (Attr, Render_Attribute'Access);
      Engine.Output.End_Element ("img");
   end Render_Image;

   --  ------------------------------
   --  Render a quote.
   --  ------------------------------
   procedure Render_Quote (Engine : in out Html_Renderer;
                           Doc    : in Wiki.Nodes.Document;
                           Title  : in Wiki.Strings.WString;
                           Attr   : in Wiki.Attributes.Attribute_List_Type) is

      procedure Render_Attribute (Name  : in String;
                                  Value : in Wide_Wide_String) is
      begin
         if Value'Length = 0 then
            return;

         elsif Name = "cite" or Name = "title" or Name = "lang" or Name = "style" or Name = "class" then
            Engine.Output.Write_Wide_Attribute (Name, Value);
         end if;
      end Render_Attribute;

   begin
      Engine.Open_Paragraph;
      Engine.Output.Start_Element ("q");
      Wiki.Attributes.Iterate (Attr, Render_Attribute'Access);
      Engine.Output.Write_Wide_Text (Title);
      Engine.Output.End_Element ("q");
   end Render_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 (Format_Type) of Util.Strings.Name_Access;

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

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

   --  ------------------------------
   --  Render a text block that is pre-formatted.
   --  ------------------------------
   procedure Render_Preformatted (Engine : in out Html_Renderer;
                                  Text   : in Wiki.Strings.WString;
                                  Format : in Unbounded_Wide_Wide_String) is
   begin
      Engine.Close_Paragraph;
      if Format = "html" then
         Engine.Output.Write (Text);
      else
         Engine.Output.Start_Element ("pre");
         Engine.Output.Write_Wide_Text (Text);
         Engine.Output.End_Element ("pre");
      end if;
   end Render_Preformatted;

   --  ------------------------------
   --  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 stream.
   --  ------------------------------
   procedure Set_Output_Stream (Engine : in out Html_Renderer;
                                Stream : in Wiki.Streams.Html.Html_Output_Stream_Access) is
   begin
      Engine.Output := Stream;
   end Set_Output_Stream;

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

   --  ------------------------------
   --  Render the node instance from the document.
   --  ------------------------------
   overriding
   procedure Render (Engine : in out Html_Renderer;
                     Doc    : in Wiki.Nodes.Document;
                     Node   : in Wiki.Nodes.Node_Type) is
      use type Wiki.Nodes.Html_Tag_Type;
      use type Wiki.Nodes.Node_List_Access;
   begin
      case Node.Kind is
         when Wiki.Nodes.N_HEADER =>
            Engine.Render_Header (Header => Node.Header,
                                  Level  => Node.Level);

         when Wiki.Nodes.N_LINE_BREAK =>
            Engine.Output.Start_Element ("br");
            Engine.Output.End_Element ("br");

         when Wiki.Nodes.N_HORIZONTAL_RULE =>
            Engine.Close_Paragraph;
            Engine.Add_Blockquote (0);
            Engine.Output.Start_Element ("hr");
            Engine.Output.End_Element ("hr");

         when Wiki.Nodes.N_PARAGRAPH =>
            Engine.Close_Paragraph;
            Engine.Need_Paragraph := True;

         when Wiki.Nodes.N_PREFORMAT =>
            Engine.Render_Preformatted (Node.Preformatted, "");

         when Wiki.Nodes.N_INDENT =>
            -- Engine.Indent_Level := Node.Level;
            null;

         when Wiki.Nodes.N_LIST =>
            Engine.Render_List_Item (Node.Level, False);

         when Wiki.Nodes.N_NUM_LIST =>
            Engine.Render_List_Item (Node.Level, True);

         when Wiki.Nodes.N_TEXT =>
            Engine.Add_Text (Text   => Node.Text,
                             Format => Node.Format);

         when Wiki.Nodes.N_QUOTE =>
            Engine.Render_Quote (Doc, Node.Title, Node.Link_Attr);

         when Wiki.Nodes.N_LINK =>
            Engine.Render_Link (Doc, Node.Title, Node.Link_Attr);

         when Wiki.Nodes.N_IMAGE =>
            Engine.Render_Image (Doc, Node.Title, Node.Link_Attr);

         when Wiki.Nodes.N_BLOCKQUOTE =>
            Engine.Add_Blockquote (Node.Level);

         when Wiki.Nodes.N_TAG_START =>
            Engine.Render_Tag (Doc, Node);

      end case;
   end Render;

   procedure Render_Tag (Engine : in out Html_Renderer;
                         Doc    : in Wiki.Nodes.Document;
                         Node   : in Wiki.Nodes.Node_Type) is
      use type Wiki.Nodes.Html_Tag_Type;

      Name : constant Wiki.Nodes.String_Access := Wiki.Nodes.Get_Tag_Name (Node.Tag_Start);
      Iter : Wiki.Attributes.Cursor := Wiki.Attributes.First (Node.Attributes);
   begin
      if Node.Tag_Start = Wiki.Nodes.P_TAG then
         Engine.Has_Paragraph := True;
         Engine.Need_Paragraph := False;
      end if;
      Engine.Output.Start_Element (Name.all);
      while Wiki.Attributes.Has_Element (Iter) loop
         Engine.Output.Write_Wide_Attribute (Name    => Wiki.Attributes.Get_Name (Iter),
                                             Content => Wiki.Attributes.Get_Wide_Value (Iter));
         Wiki.Attributes.Next (Iter);
      end loop;
      Engine.Render (Doc, Node.Children);
      if Node.Tag_Start = Wiki.Nodes.P_TAG then
         Engine.Has_Paragraph := False;
         Engine.Need_Paragraph := True;
      end if;
      Engine.Output.End_Element (Name.all);
   end Render_Tag;

   --  ------------------------------
   --  Render a section header in the document.
   --  ------------------------------
   procedure Render_Header (Engine : in out Html_Renderer;
                            Header : in Wiki.Strings.WString;
                            Level  : in Positive) is
   begin
      Engine.Close_Paragraph;
      Engine.Add_Blockquote (0);
      case Level is
         when 1 =>
            Engine.Output.Write_Wide_Element ("h1", Header);

         when 2 =>
            Engine.Output.Write_Wide_Element ("h2", Header);

         when 3 =>
            Engine.Output.Write_Wide_Element ("h3", Header);

         when 4 =>
            Engine.Output.Write_Wide_Element ("h4", Header);

         when 5 =>
            Engine.Output.Write_Wide_Element ("h5", Header);

         when 6 =>
            Engine.Output.Write_Wide_Element ("h6", Header);

         when others =>
            Engine.Output.Write_Wide_Element ("h3", Header);
      end case;
   end Render_Header;

   --  ------------------------------
   --  Add a blockquote (<blockquote>).  The level indicates the blockquote nested level.
   --  The blockquote must be closed at the next header.
   --  ------------------------------
   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.Output.Start_Element ("blockquote");
         Document.Quote_Level := Document.Quote_Level + 1;
      end loop;
      while Document.Quote_Level > Level loop
         Document.Output.End_Element ("blockquote");
         Document.Quote_Level := Document.Quote_Level - 1;
      end loop;
   end Add_Blockquote;

   --  ------------------------------
   --  Render a list item (<li>).  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.
   --  ------------------------------
   procedure Render_List_Item (Engine   : in out Html_Renderer;
                               Level    : in Positive;
                               Ordered  : in Boolean) is
   begin
      if Engine.Has_Paragraph then
         Engine.Output.End_Element ("p");
         Engine.Has_Paragraph := False;
      end if;
      if Engine.Has_Item then
         Engine.Output.End_Element ("li");
         Engine.Has_Item := False;
      end if;
      Engine.Need_Paragraph := False;
      Engine.Open_Paragraph;
      while Engine.Current_Level < Level loop
         if Ordered then
            Engine.Output.Start_Element ("ol");
         else
            Engine.Output.Start_Element ("ul");
         end if;
         Engine.Current_Level := Engine.Current_Level + 1;
         Engine.List_Styles (Engine.Current_Level) := Ordered;
      end loop;
   end Render_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.Output.End_Element ("p");
      end if;
      if Document.Has_Item then
         Document.Output.End_Element ("li");
      end if;
      while Document.Current_Level > 0 loop
         if Document.List_Styles (Document.Current_Level) then
            Document.Output.End_Element ("ol");
         else
            Document.Output.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.Output.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.Output.Start_Element ("li");
         Document.Has_Item := True;
      end if;
   end Open_Paragraph;

   --  ------------------------------
   --  Render a link.
   --  ------------------------------
   procedure Render_Link (Engine : in out Html_Renderer;
                          Doc    : in Wiki.Nodes.Document;
                          Title  : in Wiki.Strings.WString;
                          Attr   : in Wiki.Attributes.Attribute_List_Type) is

      procedure Render_Attribute (Name  : in String;
                                  Value : in Wide_Wide_String) is
      begin
         if Name = "href" then
            declare
               URI    : Unbounded_Wide_Wide_String;
               Exists : Boolean;
            begin
               Engine.Links.Make_Page_Link (Value, URI, Exists);
               Engine.Output.Write_Wide_Attribute ("href", URI);
            end;

         elsif Value'Length = 0 then
            return;

         elsif Name = "lang" or Name = "title" or Name = "rel" or Name = "target"
         or Name = "style" or Name = "class" then
            Engine.Output.Write_Wide_Attribute (Name, Value);
         end if;
      end Render_Attribute;

   begin
      Engine.Open_Paragraph;
      Engine.Output.Start_Element ("a");
      Wiki.Attributes.Iterate (Attr, Render_Attribute'Access);
      Engine.Output.Write_Wide_Text (Title);
      Engine.Output.End_Element ("a");
   end Render_Link;

   --  ------------------------------
   --  Render an image.
   --  ------------------------------
   procedure Render_Image (Engine : in out Html_Renderer;
                           Doc    : in Wiki.Nodes.Document;
                           Title  : in Wiki.Strings.WString;
                           Attr   : in Wiki.Attributes.Attribute_List_Type) is
      Link   : Unbounded_Wide_Wide_String := Wiki.Attributes.Get_Attribute (Attr, "href");
      URI    : Unbounded_Wide_Wide_String;
      Width  : Natural;
      Height : Natural;

      procedure Render_Attribute (Name  : in String;
                                  Value : in Wide_Wide_String) is
      begin
         if Name = "alt" or Name = "longdesc"
           or Name = "style" or Name = "class" then
            Engine.Output.Write_Wide_Attribute (Name, Value);
         end if;
      end Render_Attribute;

   begin
      Engine.Open_Paragraph;
      Engine.Output.Start_Element ("img");
      Engine.Links.Make_Image_Link (Link, URI, Width, Height);
      Engine.Output.Write_Wide_Attribute ("src", URI);
      if Width > 0 then
         Engine.Output.Write_Attribute ("width", Natural'Image (Width));
      end if;
      if Height > 0 then
         Engine.Output.Write_Attribute ("height", Natural'Image (Height));
      end if;
      Wiki.Attributes.Iterate (Attr, Render_Attribute'Access);
      Engine.Output.End_Element ("img");
   end Render_Image;

   --  ------------------------------
   --  Render a quote.
   --  ------------------------------
   procedure Render_Quote (Engine : in out Html_Renderer;
                           Doc    : in Wiki.Nodes.Document;
                           Title  : in Wiki.Strings.WString;
                           Attr   : in Wiki.Attributes.Attribute_List_Type) is

      procedure Render_Attribute (Name  : in String;
                                  Value : in Wide_Wide_String) is
      begin
         if Value'Length = 0 then
            return;

         elsif Name = "cite" or Name = "title" or Name = "lang" or Name = "style" or Name = "class" then
            Engine.Output.Write_Wide_Attribute (Name, Value);
         end if;
      end Render_Attribute;

   begin
      Engine.Open_Paragraph;
      Engine.Output.Start_Element ("q");
      Wiki.Attributes.Iterate (Attr, Render_Attribute'Access);
      Engine.Output.Write_Wide_Text (Title);
      Engine.Output.End_Element ("q");
   end Render_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 (Format_Type) of Util.Strings.Name_Access;

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

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

   --  ------------------------------
   --  Render a text block that is pre-formatted.
   --  ------------------------------
   procedure Render_Preformatted (Engine : in out Html_Renderer;
                                  Text   : in Wiki.Strings.WString;
                                  Format : in Wiki.Strings.WString) is
   begin
      Engine.Close_Paragraph;
      if Format = "html" then
         Engine.Output.Write (Text);
      else
         Engine.Output.Start_Element ("pre");
         Engine.Output.Write_Wide_Text (Text);
         Engine.Output.End_Element ("pre");
      end if;
   end Render_Preformatted;

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

Handle the N_LIST and N_NUM_LIST nodes

Handle the N_LIST and N_NUM_LIST nodes


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

with AWA.Storages.Models;
with AWA.Storages.Modules;

with ASF.Parts;

with Util.Beans.Objects;
with Util.Beans.Basic;
package AWA.Storages.Beans is

   FOLDER_ID_PARAMETER : constant String := "folderId";

   --  ------------------------------
   --  Upload Bean
   --  ------------------------------
   --  The Upload_Bean allows to upload a file in the storage space.
   type Upload_Bean is new AWA.Storages.Models.Storage_Ref
     and Util.Beans.Basic.Bean with record
      Module  : AWA.Storages.Modules.Storage_Module_Access := null;
   end record;
   type Upload_Bean_Access is access all Upload_Bean'Class;

   --  Get the value identified by the name.
   overriding
   function Get_Value (From : in Upload_Bean;
                       Name : in String) return Util.Beans.Objects.Object;

   --  Set the value identified by the name.
   overriding
   procedure Set_Value (From  : in out Upload_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object);

   --  Save the uploaded file in the storage service.
   --  @method
   procedure Save_Part (Bean : in out Upload_Bean;
                        Part : in ASF.Parts.Part'Class);

   --  Upload the file.
   --  @method
   procedure Upload (Bean    : in out Upload_Bean;
                     Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Delete the file.
   --  @method
   procedure Delete (Bean    : in out Upload_Bean;
                     Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  ------------------------------
   --  Folder Bean
   --  ------------------------------
   --  The Folder_Bean allows to create or update the folder name.
   type Folder_Bean is new AWA.Storages.Models.Storage_Folder_Ref
     and Util.Beans.Basic.Bean with record
      Module  : AWA.Storages.Modules.Storage_Module_Access := null;
   end record;
   type Folder_Bean_Access is access all Folder_Bean'Class;

   --  Get the value identified by the name.
   overriding
   function Get_Value (From : in Folder_Bean;
                       Name : in String) return Util.Beans.Objects.Object;

   --  Set the value identified by the name.
   overriding
   procedure Set_Value (From  : in out Folder_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object);

   --  Create or save the folder.
   procedure Save (Bean    : in out Folder_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   type Init_Flag is (INIT_FOLDER, INIT_FOLDER_LIST, INIT_FILE_LIST);
   type Init_Map is array (Init_Flag) of Boolean;

   --  ------------------------------
   --  Storage List Bean
   --  ------------------------------
   --  This bean represents a list of storage files for a given folder.
   type Storage_List_Bean is new Util.Beans.Basic.Bean with record
      Module           : AWA.Storages.Modules.Storage_Module_Access := null;

      --  Current folder.
      Folder           : aliased Folder_Bean;
      Folder_Bean      : Folder_Bean_Access;

      --  List of folders.
      Folder_List      : aliased AWA.Storages.Models.Folder_Info_List_Bean;
      Folder_List_Bean : AWA.Storages.Models.Folder_Info_List_Bean_Access;

      --  List of files.
      Files_List       : aliased AWA.Storages.Models.Storage_Info_List_Bean;
      Files_List_Bean  : AWA.Storages.Models.Storage_Info_List_Bean_Access;

      Init_Flags       : aliased Init_Map := (others => False);
      Flags            : access Init_Map;
   end record;
   type Storage_List_Bean_Access is access all Storage_List_Bean'Class;

   --  Load the folder instance.
   procedure Load_Folder (Storage : in Storage_List_Bean);

   --  Load the list of folders.
   procedure Load_Folders (Storage : in Storage_List_Bean);

   --  Load the list of files associated with the current folder.
   procedure Load_Files (Storage : in Storage_List_Bean);

   overriding
   function Get_Value (List : in Storage_List_Bean;
                       Name : in String) return Util.Beans.Objects.Object;

   --  Set the value identified by the name.
   overriding
   procedure Set_Value (From  : in out Storage_List_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object);

   --  Create the Folder_List_Bean bean instance.
   function Create_Folder_List_Bean (Module : in AWA.Storages.Modules.Storage_Module_Access)
                                     return Util.Beans.Basic.Readonly_Bean_Access;

   --  Create the Storage_List_Bean bean instance.
   function Create_Storage_List_Bean (Module : in AWA.Storages.Modules.Storage_Module_Access)
                                      return Util.Beans.Basic.Readonly_Bean_Access;

end AWA.Storages.Beans;

-----------------------------------------------------------------------
--  awa-storages-beans -- Storage Ada Beans
--  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 Ada.Strings.Unbounded;

with AWA.Storages.Models;
with AWA.Storages.Modules;

with ASF.Parts;

with ADO;

with Util.Beans.Objects;
with Util.Beans.Basic;
package AWA.Storages.Beans is

   FOLDER_ID_PARAMETER : constant String := "folderId";

   --  ------------------------------
   --  Upload Bean
   --  ------------------------------
   --  The Upload_Bean allows to upload a file in the storage space.
   type Upload_Bean is new AWA.Storages.Models.Storage_Ref
     and Util.Beans.Basic.Bean with record
      Module    : AWA.Storages.Modules.Storage_Module_Access := null;
      Folder_Id : ADO.Identifier;
   end record;
   type Upload_Bean_Access is access all Upload_Bean'Class;

   --  Get the value identified by the name.
   overriding
   function Get_Value (From : in Upload_Bean;
                       Name : in String) return Util.Beans.Objects.Object;

   --  Set the value identified by the name.
   overriding
   procedure Set_Value (From  : in out Upload_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object);

   --  Save the uploaded file in the storage service.
   --  @method
   procedure Save_Part (Bean : in out Upload_Bean;
                        Part : in ASF.Parts.Part'Class);

   --  Upload the file.
   --  @method
   procedure Upload (Bean    : in out Upload_Bean;
                     Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Delete the file.
   --  @method
   procedure Delete (Bean    : in out Upload_Bean;
                     Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  ------------------------------
   --  Folder Bean
   --  ------------------------------
   --  The Folder_Bean allows to create or update the folder name.
   type Folder_Bean is new AWA.Storages.Models.Storage_Folder_Ref
     and Util.Beans.Basic.Bean with record
      Module  : AWA.Storages.Modules.Storage_Module_Access := null;
   end record;
   type Folder_Bean_Access is access all Folder_Bean'Class;

   --  Get the value identified by the name.
   overriding
   function Get_Value (From : in Folder_Bean;
                       Name : in String) return Util.Beans.Objects.Object;

   --  Set the value identified by the name.
   overriding
   procedure Set_Value (From  : in out Folder_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object);

   --  Create or save the folder.
   procedure Save (Bean    : in out Folder_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   type Init_Flag is (INIT_FOLDER, INIT_FOLDER_LIST, INIT_FILE_LIST);
   type Init_Map is array (Init_Flag) of Boolean;

   --  ------------------------------
   --  Storage List Bean
   --  ------------------------------
   --  This bean represents a list of storage files for a given folder.
   type Storage_List_Bean is new Util.Beans.Basic.Bean with record
      Module           : AWA.Storages.Modules.Storage_Module_Access := null;

      --  Current folder.
      Folder           : aliased Folder_Bean;
      Folder_Bean      : Folder_Bean_Access;

      --  List of folders.
      Folder_List      : aliased AWA.Storages.Models.Folder_Info_List_Bean;
      Folder_List_Bean : AWA.Storages.Models.Folder_Info_List_Bean_Access;

      --  List of files.
      Files_List       : aliased AWA.Storages.Models.Storage_Info_List_Bean;
      Files_List_Bean  : AWA.Storages.Models.Storage_Info_List_Bean_Access;

      Init_Flags       : aliased Init_Map := (others => False);
      Flags            : access Init_Map;
   end record;
   type Storage_List_Bean_Access is access all Storage_List_Bean'Class;

   --  Load the folder instance.
   procedure Load_Folder (Storage : in Storage_List_Bean);

   --  Load the list of folders.
   procedure Load_Folders (Storage : in Storage_List_Bean);

   --  Load the list of files associated with the current folder.
   procedure Load_Files (Storage : in Storage_List_Bean);

   overriding
   function Get_Value (List : in Storage_List_Bean;
                       Name : in String) return Util.Beans.Objects.Object;

   --  Set the value identified by the name.
   overriding
   procedure Set_Value (From  : in out Storage_List_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object);

   --  Create the Folder_List_Bean bean instance.
   function Create_Folder_List_Bean (Module : in AWA.Storages.Modules.Storage_Module_Access)
                                     return Util.Beans.Basic.Readonly_Bean_Access;

   --  Create the Storage_List_Bean bean instance.
   function Create_Storage_List_Bean (Module : in AWA.Storages.Modules.Storage_Module_Access)
                                      return Util.Beans.Basic.Readonly_Bean_Access;

end AWA.Storages.Beans;

Add Folder_Id to the Upload_Bean type

Add Folder_Id to the Upload_Bean type


-----------------------------------------------------------------------
--  mat-targets-gtkmat - Gtk target management
--  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 Glib.Error;
with Glib.Object;

with Gtk.Main;
with Gtk.Label;

with MAT.Callbacks;
with MAT.Consoles.Text;
package body MAT.Targets.Gtkmat is

   --  ------------------------------
   --  Initialize the target instance.
   --  ------------------------------
   overriding
   procedure Initialize (Target : in out Target_Type) is
   begin
      Target.Options.Interactive := False;
      Target.Options.Graphical   := True;
      Target.Console := new MAT.Consoles.Text.Console_Type;
   end Initialize;

   --  ------------------------------
   --  Initialize the widgets and create the Gtk gui.
   --  ------------------------------
   procedure Initialize_Widget (Target : in out Target_Type;
                                Widget : out Gtk.Widget.Gtk_Widget) is
      Error   : aliased Glib.Error.GError;
      Result  : Glib.Guint;
   begin
      if Target.Options.Graphical then
         Gtk.Main.Init;
         Gtkada.Builder.Gtk_New (Target.Builder);
         Result := Target.Builder.Add_From_File ("mat.glade", Error'Access);
         MAT.Callbacks.Initialize (Target'Unchecked_Access, Target.Builder);
         Target.Builder.Do_Connect;
         Widget := Gtk.Widget.Gtk_Widget (Target.Builder.Get_Object ("main"));
      else
         Widget := null;
      end if;
   end Initialize_Widget;

   --  ------------------------------
   --  Enter in the interactive loop reading the commands from the standard input
   --  and executing the commands.
   --  ------------------------------
   overriding
   procedure Interactive (Target : in out Target_Type) is
      Main : Gtk.Widget.Gtk_Widget;
   begin
      if Target.Options.Graphical then
         Main := Gtk.Widget.Gtk_Widget (Target.Builder.Get_Object ("main"));
         Main.Show_All;
      end if;
      if Target.Options.Interactive and Target.Options.Graphical then
         Target.Gui_Task.Start (Target'Unchecked_Access);
      end if;
      if Target.Options.Graphical then
         Gtk.Main.Main;
      else
         MAT.Targets.Target_Type (Target).Interactive;
      end if;
   end Interactive;

   task body Gtk_Loop is
      Main : Target_Type_Access;
   begin
      select
         accept Start (Target : in Target_Type_Access) do
            Main := Target;
         end Start;
         MAT.Targets.Target_Type (Main.all).Interactive;
      or
         terminate;
      end select;
   end Gtk_Loop;

   --  ------------------------------
   --  Set the UI label with the given value.
   --  ------------------------------
   procedure Set_Label (Target : in Target_Type;
                        Name   : in String;
                        Value  : in String) is
      use type Glib.Object.GObject;

      Object : constant Glib.Object.GObject := Target.Builder.Get_Object (Name);
      Label  : Gtk.Label.Gtk_Label;
   begin
      if Object /= null then
         Label := Gtk.Label.Gtk_Label (Object);
         Label.Set_Label (Value);
      end if;
   end Set_Label;

   --  ------------------------------
   --  Create a process instance to hold and keep track of memory and other information about
   --  the given process ID.
   --  ------------------------------
   overriding
   procedure Create_Process (Target  : in out Target_Type;
                             Pid     : in MAT.Types.Target_Process_Ref;
                             Path    : in Ada.Strings.Unbounded.Unbounded_String;
                             Process : out Target_Process_Type_Access) is
   begin
      MAT.Targets.Target_Type (Target).Create_Process (Pid, Path, Process);
      Target.Set_Label ("process_info", "Pid:" & MAT.Types.Target_Process_Ref'Image (Pid));
   end Create_Process;

   --  ------------------------------
   --  Refresh the information about the current process.
   --  ------------------------------
   procedure Refresh_Process (Target  : in out Target_Type) is
      use type MAT.Events.Targets.Target_Events_Access;

      Counter : Integer;
      Stats   : MAT.Memory.Targets.Memory_Stat;
   begin
      if Target.Current = null or else Target.Current.Events = null then
         return;
      end if;
      Counter := Target.Current.Events.Get_Event_Counter;
      if Counter = Target.Previous_Event_Counter then
         return;
      end if;
      Target.Previous_Event_Counter := Counter;
      Target.Set_Label ("event_info", "Events:" & Integer'Image (Counter));
      Target.Current.Memory.Stat_Information (Stats);
      Target.Set_Label ("thread_info", "Threads:"
                        & Natural'Image (Stats.Thread_Count));
      Target.Set_Label ("mem_used_info", "Used:"
                        & MAT.Types.Target_Size'Image (Stats.Total_Alloc));
      Target.Set_Label ("mem_free_info", "Free:"
                        & MAT.Types.Target_Size'Image (Stats.Total_Free));
   end Refresh_Process;

end MAT.Targets.Gtkmat;

-----------------------------------------------------------------------
--  mat-targets-gtkmat - Gtk target management
--  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 Glib.Error;
with Glib.Object;

with Gtk.Main;
with Gtk.Label;
with Gtk.Frame;

with MAT.Callbacks;
with MAT.Consoles.Text;
with MAT.Consoles.Gtkmat;
package body MAT.Targets.Gtkmat is

   --  ------------------------------
   --  Initialize the target instance.
   --  ------------------------------
   overriding
   procedure Initialize (Target : in out Target_Type) is
   begin
      Target.Options.Interactive := False;
      Target.Options.Graphical   := True;
      Target.Console := new MAT.Consoles.Text.Console_Type;
   end Initialize;

   --  ------------------------------
   --  Initialize the widgets and create the Gtk gui.
   --  ------------------------------
   procedure Initialize_Widget (Target : in out Target_Type;
                                Widget : out Gtk.Widget.Gtk_Widget) is
      Error   : aliased Glib.Error.GError;
      Result  : Glib.Guint;
   begin
      if Target.Options.Graphical then
         Gtk.Main.Init;
         Gtkada.Builder.Gtk_New (Target.Builder);
         Result := Target.Builder.Add_From_File ("mat.glade", Error'Access);
         MAT.Callbacks.Initialize (Target'Unchecked_Access, Target.Builder);
         Target.Builder.Do_Connect;
         Widget := Gtk.Widget.Gtk_Widget (Target.Builder.Get_Object ("main"));
         Target.Gtk_Console := new MAT.Consoles.Gtkmat.Console_Type;
         Target.Gtk_Console.Initialize
           (Gtk.Frame.Gtk_Frame (Target.Builder.Get_Object ("consoleFrame")));
         Target.Console := Target.Gtk_Console.all'Access;
      else
         Widget := null;
      end if;
   end Initialize_Widget;

   --  ------------------------------
   --  Enter in the interactive loop reading the commands from the standard input
   --  and executing the commands.
   --  ------------------------------
   overriding
   procedure Interactive (Target : in out Target_Type) is
      Main : Gtk.Widget.Gtk_Widget;
   begin
      if Target.Options.Graphical then
         Main := Gtk.Widget.Gtk_Widget (Target.Builder.Get_Object ("main"));
         Main.Show_All;
      end if;
      if Target.Options.Interactive and Target.Options.Graphical then
         Target.Gui_Task.Start (Target'Unchecked_Access);
      end if;
      if Target.Options.Graphical then
         Gtk.Main.Main;
      else
         MAT.Targets.Target_Type (Target).Interactive;
      end if;
   end Interactive;

   task body Gtk_Loop is
      Main : Target_Type_Access;
   begin
      select
         accept Start (Target : in Target_Type_Access) do
            Main := Target;
         end Start;
         MAT.Targets.Target_Type (Main.all).Interactive;
      or
         terminate;
      end select;
   end Gtk_Loop;

   --  ------------------------------
   --  Set the UI label with the given value.
   --  ------------------------------
   procedure Set_Label (Target : in Target_Type;
                        Name   : in String;
                        Value  : in String) is
      use type Glib.Object.GObject;

      Object : constant Glib.Object.GObject := Target.Builder.Get_Object (Name);
      Label  : Gtk.Label.Gtk_Label;
   begin
      if Object /= null then
         Label := Gtk.Label.Gtk_Label (Object);
         Label.Set_Label (Value);
      end if;
   end Set_Label;

   --  ------------------------------
   --  Create a process instance to hold and keep track of memory and other information about
   --  the given process ID.
   --  ------------------------------
   overriding
   procedure Create_Process (Target  : in out Target_Type;
                             Pid     : in MAT.Types.Target_Process_Ref;
                             Path    : in Ada.Strings.Unbounded.Unbounded_String;
                             Process : out Target_Process_Type_Access) is
   begin
      MAT.Targets.Target_Type (Target).Create_Process (Pid, Path, Process);
      Target.Set_Label ("process_info", "Pid:" & MAT.Types.Target_Process_Ref'Image (Pid));
   end Create_Process;

   --  ------------------------------
   --  Refresh the information about the current process.
   --  ------------------------------
   procedure Refresh_Process (Target  : in out Target_Type) is
      use type MAT.Events.Targets.Target_Events_Access;

      Counter : Integer;
      Stats   : MAT.Memory.Targets.Memory_Stat;
   begin
      if Target.Current = null or else Target.Current.Events = null then
         return;
      end if;
      Counter := Target.Current.Events.Get_Event_Counter;
      if Counter = Target.Previous_Event_Counter then
         return;
      end if;
      Target.Previous_Event_Counter := Counter;
      Target.Set_Label ("event_info", "Events:" & Integer'Image (Counter));
      Target.Current.Memory.Stat_Information (Stats);
      Target.Set_Label ("thread_info", "Threads:"
                        & Natural'Image (Stats.Thread_Count));
      Target.Set_Label ("mem_used_info", "Used:"
                        & MAT.Types.Target_Size'Image (Stats.Total_Alloc));
      Target.Set_Label ("mem_free_info", "Free:"
                        & MAT.Types.Target_Size'Image (Stats.Total_Free));
   end Refresh_Process;

end MAT.Targets.Gtkmat;

Create the gtkmat console and use it in gui mode