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.     -- Returns the path to the directory where the user's configuration and 
  32.     -- user-created data can safely be written. If it's not an absolute path, 
  33.     -- it is relative to the current working directory. 
  34.     function Get_User_Directory( this : not null access Application'Class ) return String; 
  35.  
  36.     ---------------------------------------------------------------------------- 
  37.  
  38.     -- Forces creation of the global application without returning a reference. 
  39.     -- If the application already exists, nothing will happen. 
  40.     procedure Create_Application; 
  41.  
  42.     -- Runs the global application from start to finish, initializing it, 
  43.     -- running the main body, and finalizing it. The application's return status 
  44.     -- will be returned in 'returnCode'. 
  45.     procedure Run_Application( returnCode : out Integer ); 
  46.  
  47.     -- Returns a reference to the global application or null if it has not been 
  48.     -- created. 
  49.     function Get_Application return A_Application; 
  50.  
  51.     -- Deletes the global application if it exists. 
  52.     procedure Delete_Application; 
  53.  
  54.     ---------------------------------------------------------------------------- 
  55.  
  56.     -- Predefined values returned by Run 
  57.     NO_ERROR                   : constant := 0; 
  58.     ERROR_UNEXPECTED_EXCEPTION : constant := 1; 
  59.  
  60.     -- This can be raised by initialization code in other packages to indicate 
  61.     -- that application initialization has failed. This exception is not raised 
  62.     -- by the Application class. 
  63.     INIT_EXCEPTION : exception; 
  64.  
  65.     -- This can be raised by the Application class to indicate that it is being 
  66.     -- misused. For example, calling Create_Application without registering an 
  67.     -- Application object allocator will raise USE_ERROR. 
  68.     USE_ERROR : exception; 
  69.  
  70. private 
  71.  
  72.     use Ada.Strings.Unbounded; 
  73.     use Locking_Objects; 
  74.  
  75.     ---------------------------------------------------------------------------- 
  76.  
  77.     type Application is abstract new Limited_Object with 
  78.         record 
  79.             -- the following fields are unprotected because they don't change 
  80.             company,                         -- developer's name 
  81.             name    : Unbounded_String;      -- app short name 
  82.             userDir : Unbounded_String;      -- path of user's directory 
  83.             lock    : A_Locking_Object;      -- a lock for modifying fields 
  84.         end record; 
  85.  
  86.     -- Constructs the application object. 
  87.     -- 
  88.     -- 'name' is a short name for the application and should not contain any 
  89.     -- special characters. It is used to name configuration files. 
  90.     -- 
  91.     -- 'userDir' is the path of a directory where the user's configuration and 
  92.     -- user-created files can safely be written. If a relative path is given, it 
  93.     -- will be assumed relative to the current working directory. Generally, 
  94.     -- 'userDir' should be absolute and point to an application-specific or 
  95.     -- application suite-specific directory within the user's OS Home directory 
  96.     -- (e.g.: "C:\Users\Joe User\Documents\MyCompany\MyApp\") because paths 
  97.     -- outside the user's home directory may not be writable when the 
  98.     -- application is installed. Configuration files found in the current 
  99.     -- working directory will override those in 'userDir'. 
  100.     -- 
  101.     -- This procedure should be called first by a subclass constructor. 
  102.     procedure Construct( this    : access Application; 
  103.                          company : String; 
  104.                          name    : String; 
  105.                          userDir : String ); 
  106.     pragma Precondition( company'Length > 0 ); 
  107.     pragma Precondition( name'Length > 0 ); 
  108.     pragma Precondition( userDir'Length = 0 or else 
  109.                          userDir(userDir'Last) = '/' or else 
  110.                          userDir(userDir'Last) = '\' ); 
  111.  
  112.     -- Deletes the internals of the application before freeing memory. This 
  113.     -- should be called last by an overriding implementation. 
  114.     procedure Delete( this : in out Application ); 
  115.  
  116.     -- Finalizes the application and releases all resources. Do not call this if 
  117.     -- the application didn't successfully initialize. This should be called 
  118.     -- last by an overriding implementation. 
  119.     procedure Finalize( this : access Application ); 
  120.  
  121.     -- Initializes the application. Returns True on success. If initialization 
  122.     -- fails, Finalize should not be called. No exception will be raised. This 
  123.     -- should be called first by an overriding implementation. 
  124.     function Initialize( this : access Application ) return Boolean; 
  125.  
  126.     -- This is the application's main procedure that will be executed after a 
  127.     -- successful initialization. Return 0 for success or any other integer to 
  128.     -- indicate an error to the operating system. If this function is not 
  129.     -- overridden, it will raise a USE_ERROR. 
  130.     -- OVERRIDE THIS FUNCTION -- 
  131.     function Run( this : access Application ) return Integer; 
  132.  
  133.     -- Displays a low-level error message to the user. The default 
  134.     -- implementation writes the text prefixed with "Error: " to the standard 
  135.     -- error stream. 
  136.     procedure Show_Error( this : access Application; text : String ); 
  137.  
  138.     -- Deletes an Application object. If the Application has been initialized, 
  139.     -- then Finalize must be called before deletion. 
  140.     procedure Delete( this : in out A_Application ); 
  141.     pragma Postcondition( this = null ); 
  142.  
  143.     ---------------------------------------------------------------------------- 
  144.  
  145.     -- An Allocator creates a new concrete Application instance. 
  146.     type Allocator is access function return A_Application; 
  147.  
  148.     -- Registers an allocator for creating the global Application instance. 
  149.     procedure Register_Allocator( allocate : not null Allocator ); 
  150.  
  151. end Applications;