1. with Objects;                           use Objects; 
  2.  
  3. private with Ada.Strings.Unbounded; 
  4. private with Locking_Objects; 
  5.  
  6. package Applications is 
  7.  
  8.     -- An Application is a global singleton object that implements an 
  9.     -- application's initialization, runtime, and shutdown behavior and provides 
  10.     -- some meta information about it. 
  11.     type Application is abstract new Limited_Object with private; 
  12.     type A_Application is access all Application'Class; 
  13.  
  14.     -- Returns the name of the company or individual that produced this 
  15.     -- application. 
  16.     function Get_Company( this : not null access Application'Class ) return String; 
  17.  
  18.     -- Returns the short name of the application. This can be used to determine 
  19.     -- the names of application-specific files, etc. Special characters should 
  20.     -- be avoided. 
  21.     function Get_Name( this : not null access Application'Class ) return String; 
  22.  
  23.     -- Initializes, runs and finalizes the application runtime. 'returnCode' 
  24.     -- contains the numeric code that should be returned to the OS on exit. 
  25.     procedure Run( this : not null access Application'Class; returnCode : in out Integer ); 
  26.  
  27.     ---------------------------------------------------------------------------- 
  28.  
  29.     -- Forces creation of the global application without returning a reference. 
  30.     -- If the application already exists, nothing will happen. 
  31.     procedure Create_Application; 
  32.  
  33.     -- Returns a reference to the global application or null if it has not been 
  34.     -- created. 
  35.     function Get_Application return A_Application; 
  36.  
  37.     -- Deletes the global application if it exists. 
  38.     procedure Delete_Application; 
  39.  
  40.     ---------------------------------------------------------------------------- 
  41.  
  42.     -- Predefined values returned by Run 
  43.     NO_ERROR                   : constant := 0; 
  44.     ERROR_UNEXPECTED_EXCEPTION : constant := 1; 
  45.  
  46.     -- This can be raised by initialization code in other packages to indicate 
  47.     -- that application initialization has failed. This exception is not raised 
  48.     -- by the Application class. 
  49.     INIT_EXCEPTION : exception; 
  50.  
  51.     -- This can be raised by the Application class to indicate that it is being 
  52.     -- misused. For example, calling Create_Application without registering an 
  53.     -- Application object allocator will raise USE_ERROR. 
  54.     USE_ERROR : exception; 
  55.  
  56. private 
  57.  
  58.     use Ada.Strings.Unbounded; 
  59.     use Locking_Objects; 
  60.  
  61.     ---------------------------------------------------------------------------- 
  62.  
  63.     type Application is abstract new Limited_Object with 
  64.         record 
  65.             -- the following fields are unprotected because they don't change 
  66.             company,                             -- developer's name 
  67.             name      : Unbounded_String;        -- app short name 
  68.             lock      : A_Locking_Object;        -- a lock for modifying fields 
  69.         end record; 
  70.  
  71.     -- Closes the application and releases all resources. Do not call this if 
  72.     -- the application didn't successfully initialize. This should be called 
  73.     -- last by an overriding implementation. 
  74.     procedure Close( this : access Application ); 
  75.  
  76.     -- Constructs the application object. 'name' is a short name for the 
  77.     -- application and should not contain any special characters. This should be 
  78.     -- called first by a subclass constructor. 
  79.     procedure Construct( this    : access Application; 
  80.                          company : String; 
  81.                          name    : String ); 
  82.  
  83.     -- Deletes the internals of the application before freeing memory. This 
  84.     -- should be called last by an overriding implementation. 
  85.     procedure Delete( this : in out Application ); 
  86.  
  87.     -- Initializes the application. Returns True on success. If initialization 
  88.     -- fails, Close will be called automatically to clean up before False is 
  89.     -- returned. No exception will be raised. This should be called first by 
  90.     -- an overriding implementation. 
  91.     function Init( this : access Application ) return Boolean; 
  92.  
  93.     -- This is the application's main procedure that will be executed after a 
  94.     -- successful initialization. Return 0 for success or any other integer to 
  95.     -- indicate an error to the operating system. If this function is not 
  96.     -- overridden, it will raise a USE_ERROR. 
  97.     -- OVERRIDE THIS FUNCTION -- 
  98.     function Run( this : access Application ) return Integer; 
  99.  
  100.     -- Deletes an Application object. If the Application has been initialized, 
  101.     -- then Close must be called before deletion. 
  102.     procedure Delete( this : in out A_Application ); 
  103.     pragma Postcondition( this = null ); 
  104.  
  105.     ---------------------------------------------------------------------------- 
  106.  
  107.     -- An Allocator creates a new concrete Application instance. 
  108.     type Allocator is access function return A_Application; 
  109.  
  110.     -- Registers an allocator for creating the global Application instance. 
  111.     procedure Register_Allocator( allocate : not null Allocator ); 
  112.  
  113. end Applications;