1. -- 
  2. -- Copyright (c) 2012 Kevin Wellwood 
  3. -- All rights reserved. 
  4. -- 
  5. -- This source code is distributed under the Modified BSD License. For terms and 
  6. -- conditions, see license.txt. 
  7. -- 
  8.  
  9. with Objects;                           use Objects; 
  10.  
  11. private with Ada.Strings.Unbounded; 
  12. private with Locking_Objects; 
  13.  
  14. package Applications is 
  15.  
  16.     -- An Application is a global singleton object that implements an 
  17.     -- application's initialization, runtime, and shutdown behavior and provides 
  18.     -- some meta information about it. 
  19.     type Application is abstract new Limited_Object with private; 
  20.     type A_Application is access all Application'Class; 
  21.  
  22.     -- Returns the name of the company or individual that produced this 
  23.     -- application. 
  24.     function Get_Company( this : not null access Application'Class ) return String; 
  25.  
  26.     -- Returns the short name of the application. This can be used to determine 
  27.     -- the names of application-specific files, etc. Special characters should 
  28.     -- be avoided. 
  29.     function Get_Name( this : not null access Application'Class ) return String; 
  30.  
  31.     -- Initializes, runs and finalizes the application runtime. 'returnCode' 
  32.     -- contains the numeric code that should be returned to the OS on exit. 
  33.     procedure Run( this : not null access Application'Class; returnCode : in out Integer ); 
  34.  
  35.     ---------------------------------------------------------------------------- 
  36.  
  37.     -- Forces creation of the global application without returning a reference. 
  38.     -- If the application already exists, nothing will happen. 
  39.     procedure Create_Application; 
  40.  
  41.     -- Returns a reference to the global application or null if it has not been 
  42.     -- created. 
  43.     function Get_Application return A_Application; 
  44.  
  45.     -- Deletes the global application if it exists. 
  46.     procedure Delete_Application; 
  47.  
  48.     ---------------------------------------------------------------------------- 
  49.  
  50.     -- Predefined values returned by Run 
  51.     NO_ERROR                   : constant := 0; 
  52.     ERROR_UNEXPECTED_EXCEPTION : constant := 1; 
  53.  
  54.     -- This can be raised by initialization code in other packages to indicate 
  55.     -- that application initialization has failed. This exception is not raised 
  56.     -- by the Application class. 
  57.     INIT_EXCEPTION : exception; 
  58.  
  59.     -- This can be raised by the Application class to indicate that it is being 
  60.     -- misused. For example, calling Create_Application without registering an 
  61.     -- Application object allocator will raise USE_ERROR. 
  62.     USE_ERROR : exception; 
  63.  
  64. private 
  65.  
  66.     use Ada.Strings.Unbounded; 
  67.     use Locking_Objects; 
  68.  
  69.     ---------------------------------------------------------------------------- 
  70.  
  71.     type Application is abstract new Limited_Object with 
  72.         record 
  73.             -- the following fields are unprotected because they don't change 
  74.             company,                             -- developer's name 
  75.             name      : Unbounded_String;      -- app short name 
  76.             configDir : Unbounded_String;      -- path of config directory 
  77.             lock      : A_Locking_Object;      -- a lock for modifying fields 
  78.         end record; 
  79.  
  80.     -- Constructs the application object. 'name' is a short name for the 
  81.     -- application and should not contain any special characters. 'configDir' is 
  82.     -- the path of the application's configuration directory. If a relative path 
  83.     -- is given, it will be assumed relative to the current working directory. 
  84.     -- Generally, 'configDir' should be absolute and point to an 
  85.     -- application-specific or application suite-specific directory within an 
  86.     -- OS-defined common application data directory. Consider using a 
  87.     -- subdirectory of the path returned by Support.Paths.App_Data_Directory. 
  88.     -- (Example: "C:\Users\Joe User\AppData\Local\MyCompany\MyApp\") 
  89.     -- Configuration files found in the current working directory will override 
  90.     -- those in 'configDir'. 
  91.     -- 
  92.     -- This procedure should be called first by a subclass constructor. 
  93.     procedure Construct( this      : access Application; 
  94.                          company   : String; 
  95.                          name      : String; 
  96.                          configDir : String ); 
  97.     pragma Precondition( company'Length > 0 ); 
  98.     pragma Precondition( name'Length > 0 ); 
  99.     pragma Precondition( configDir'Length = 0 or else 
  100.                          configDir(configDir'Last) = '/' or else 
  101.                          configDir(configDir'Last) = '\' ); 
  102.  
  103.     -- Deletes the internals of the application before freeing memory. This 
  104.     -- should be called last by an overriding implementation. 
  105.     procedure Delete( this : in out Application ); 
  106.  
  107.     -- Closes the application and releases all resources. Do not call this if 
  108.     -- the application didn't successfully initialize. This should be called 
  109.     -- last by an overriding implementation. 
  110.     procedure Close( this : access Application ); 
  111.  
  112.     -- Initializes the application. Returns True on success. If initialization 
  113.     -- fails, Close will be called automatically to clean up before False is 
  114.     -- returned. No exception will be raised. This should be called first by 
  115.     -- an overriding implementation. 
  116.     function Init( this : access Application ) return Boolean; 
  117.  
  118.     -- This is the application's main procedure that will be executed after a 
  119.     -- successful initialization. Return 0 for success or any other integer to 
  120.     -- indicate an error to the operating system. If this function is not 
  121.     -- overridden, it will raise a USE_ERROR. 
  122.     -- OVERRIDE THIS FUNCTION -- 
  123.     function Run( this : access Application ) return Integer; 
  124.  
  125.     -- Deletes an Application object. If the Application has been initialized, 
  126.     -- then Close must be called before deletion. 
  127.     procedure Delete( this : in out A_Application ); 
  128.     pragma Postcondition( this = null ); 
  129.  
  130.     ---------------------------------------------------------------------------- 
  131.  
  132.     -- An Allocator creates a new concrete Application instance. 
  133.     type Allocator is access function return A_Application; 
  134.  
  135.     -- Registers an allocator for creating the global Application instance. 
  136.     procedure Register_Allocator( allocate : not null Allocator ); 
  137.  
  138. end Applications;