--
-- Copyright (c) 2012 Kevin Wellwood
-- All rights reserved.
--
-- This source code is distributed under the Modified BSD License. For terms and
-- conditions, see license.txt.
--
with Objects; use Objects;
private with Ada.Strings.Unbounded;
private with Locking_Objects;
package Applications is
-- An Application is a global singleton object that implements an
-- application's initialization, runtime, and shutdown behavior and provides
-- some meta information about it.
type Application is abstract new Limited_Object with private;
type A_Application is access all Application'Class;
-- Returns the name of the company or individual that produced this
-- application.
function Get_Company( this : not null access Application'Class ) return String;
-- Returns the short name of the application. This can be used to determine
-- the names of application-specific files, etc. Special characters should
-- be avoided.
function Get_Name( this : not null access Application'Class ) return String;
-- Returns the path to the directory where the user's configuration and
-- user-created data can safely be written. If it's not an absolute path,
-- it is relative to the current working directory.
function Get_User_Directory( this : not null access Application'Class ) return String;
----------------------------------------------------------------------------
-- Forces creation of the global application without returning a reference.
-- If the application already exists, nothing will happen.
procedure Create_Application;
-- Runs the global application from start to finish, initializing it,
-- running the main body, and finalizing it. The application's return status
-- will be returned in 'returnCode'.
procedure Run_Application( returnCode : out Integer );
-- Returns a reference to the global application or null if it has not been
-- created.
function Get_Application return A_Application;
-- Deletes the global application if it exists.
procedure Delete_Application;
----------------------------------------------------------------------------
-- Predefined values returned by Run
NO_ERROR : constant := 0;
ERROR_UNEXPECTED_EXCEPTION : constant := 1;
-- This can be raised by initialization code in other packages to indicate
-- that application initialization has failed. This exception is not raised
-- by the Application class.
INIT_EXCEPTION : exception;
-- This can be raised by the Application class to indicate that it is being
-- misused. For example, calling Create_Application without registering an
-- Application object allocator will raise USE_ERROR.
USE_ERROR : exception;
private
use Ada.Strings.Unbounded;
use Locking_Objects;
----------------------------------------------------------------------------
type Application is abstract new Limited_Object with
record
-- the following fields are unprotected because they don't change
company, -- developer's name
name : Unbounded_String; -- app short name
userDir : Unbounded_String; -- path of user's directory
lock : A_Locking_Object; -- a lock for modifying fields
end record;
-- Constructs the application object.
--
-- 'name' is a short name for the application and should not contain any
-- special characters. It is used to name configuration files.
--
-- 'userDir' is the path of a directory where the user's configuration and
-- user-created files can safely be written. If a relative path is given, it
-- will be assumed relative to the current working directory. Generally,
-- 'userDir' should be absolute and point to an application-specific or
-- application suite-specific directory within the user's OS Home directory
-- (e.g.: "C:\Users\Joe User\Documents\MyCompany\MyApp\") because paths
-- outside the user's home directory may not be writable when the
-- application is installed. Configuration files found in the current
-- working directory will override those in 'userDir'.
--
-- This procedure should be called first by a subclass constructor.
procedure Construct( this : access Application;
company : String;
name : String;
userDir : String );
pragma Precondition( company'Length > 0 );
pragma Precondition( name'Length > 0 );
pragma Precondition( userDir'Length = 0 or else
userDir(userDir'Last) = '/' or else
userDir(userDir'Last) = '\' );
-- Deletes the internals of the application before freeing memory. This
-- should be called last by an overriding implementation.
procedure Delete( this : in out Application );
-- Finalizes the application and releases all resources. Do not call this if
-- the application didn't successfully initialize. This should be called
-- last by an overriding implementation.
procedure Finalize( this : access Application );
-- Initializes the application. Returns True on success. If initialization
-- fails, Finalize should not be called. No exception will be raised. This
-- should be called first by an overriding implementation.
function Initialize( this : access Application ) return Boolean;
-- This is the application's main procedure that will be executed after a
-- successful initialization. Return 0 for success or any other integer to
-- indicate an error to the operating system. If this function is not
-- overridden, it will raise a USE_ERROR.
-- OVERRIDE THIS FUNCTION --
function Run( this : access Application ) return Integer;
-- Displays a low-level error message to the user. The default
-- implementation writes the text prefixed with "Error: " to the standard
-- error stream.
procedure Show_Error( this : access Application; text : String );
-- Deletes an Application object. If the Application has been initialized,
-- then Finalize must be called before deletion.
procedure Delete( this : in out A_Application );
pragma Postcondition( this = null );
----------------------------------------------------------------------------
-- An Allocator creates a new concrete Application instance.
type Allocator is access function return A_Application;
-- Registers an allocator for creating the global Application instance.
procedure Register_Allocator( allocate : not null Allocator );
end Applications;