--|
--| Filename        : $Source: /home/erdmann/ASCL/Template/RCS/template.adb,v $
--| Description     : Component Template
--| Author          : Michael Erdmann
--| Created On      : 25.3.1999
--| Last Modified By: $Author: erdmann $
--| Last Modified On: $Date: 1999/08/01 10:56:43 $
--| Status          : $State: Exp $
--|
--| Functional Description
--| ======================
--|
--|
--| Restrictions
--| ============
--|
--| References
--| ==========
--|
--|
--| History
--| =======
--| $Log: template.adb,v $
--| Revision 1.2  1999/08/01 10:56:43  erdmann
--| Debugging support added
--|
--| Revision 1.1  1999/07/18 15:35:30  erdmann
--| No comments
--|

--* Ada
with Ada.Exceptions;               use Ada.Exceptions;
with Unchecked_Deallocation;

with ASCL.Debugging_Support;  
use ASCL;


package body Template is

   Version : constant String := "$Id: template.adb,v 1.2 1999/08/01 10:56:43 erdmann Exp erdmann $";

   ---====================================================================---
   ---===                O B J  E C T     D A T A                      ===---
   ---====================================================================---

   --|
   --| This is the instance of the component internal data.
   --|
   type Object_Data is record
         debug   : Debugging_Support.Handle := null;
      end record;

   ---=====================================================================---
   ---===         L O C A L   S U P P O R T   P R O C E D U R E S       ===---
   ---=====================================================================---

   --|
   --| This procedure is called upon every exception raised in this
   --| component. It may be used to trace back the cause of an
   --| exception, or to print out relevant information about the
   --| instance where the problem did occure.
   --|
   procedure Error( this     : in Object'Class;
                    theError : in Exception_Id ;
                    info     : in String ) 
   is
      data : Object_Data_Access := this.data;
   begin

      Raise_Exception( theError,  "template.adb" & info );
   end Error;

   ---======================================================================---
   ---===             C O M P O  N E N T    I N T E R F A C E            ===---
   ---======================================================================---

   --|
   --| Intialize the Object data and call the Initalization
   --| procedure of the extention.
   --|
   procedure Initialize( this  : in out Object'Class;
                         debug : in Debugging_Support.Handle := null ) 
   is
      data             : Object_Data_Access renames this.data;
   begin
      if data /= null then
         raise Usage_Error;
      end if;

      data := new Object_Data;
      if data = null then
         raise Out_Of_Memory;
      end if;

      data.debug := debug; 

   exception
      when The_Error : Others =>
         Error( this, Exception_Identity( The_Error ), ".Initialize");
   end Initialize;

   --|
   --| Finalize the instance by releasing the object data
   --| finalizing the extention.
   --|
   procedure Finalize( this : in out Object'Class ) is
      data   : Object_Data_Access renames this.data;

      procedure Free is
            new Unchecked_Deallocation( Object_Data, Object_Data_Access);
   begin
      if data = null then
         return;
      end if;

      Free( data );

      this.data := null;

   exception
      when The_Error : Others =>
         Error( this, Exception_Identity( The_Error ), ".Finalize");
   end Finalize;

   ---=====================================================================---
   ---===           A T T R I B U T E    F U N C T I O N S              ===---
   ---=====================================================================---

   --|
   --| This function reads an attribute
   --|
   function Get( this : in Object'Class ) return Integer is
      data : Object_Data_Access := this.data;
   begin
      if data = null then
         raise Not_Initialized;
      end if;

      return 1;

   exception
      when The_Error : Others =>
         Error( this, Exception_Identity( The_Error ), ".Attribute");
         raise;

   end Get;

   --|
   --| Set some attribute
   --|
   procedure Set( this : in out Object'Class; value : in Integer ) is
      data : Object_Data_Access := this.data;
   begin
      if data = null then
         raise Not_Initialized;
      end if;


   exception
      when The_Error : Others =>
         Error( this, Exception_Identity( The_Error ), ".Action" );
         raise;
   end Set;

   ---=====================================================================---
   ---===                        M E T H O D S                          ===---
   ---=====================================================================---

   --|
   --| Purpose:
   --|
   --| Pre-Conditions:
   --|
   --| Post-Conditions:
   --|
   --|
   procedure Perform( this : in out Object'Class ) is
      data : Object_Data_Access := this.data;
   begin
      if data = null then
         raise Not_Initialized;
      end if;

   exception
      when The_Error : Others =>
         Error( this, Exception_Identity( The_Error ), ".Action" );
         raise;
   end Perform;

end Template;