libtexttools3-dev 2.0.7-2 / usr / share / ada / adainclude / texttools / os.ads

------------------------------------------------------------------------------
-- OS                                                                       --
--                                                                          --
-- Part of TextTools                                                        --
-- Designed and Programmed by Ken O. Burtch                                 --
--                                                                          --
------------------------------------------------------------------------------
--                                                                          --
--                 Copyright (C) 1999-2007 Ken O. Burtch                    --
--                                                                          --
-- This is free software;  you can  redistribute it  and/or modify it under --
-- terms of the  GNU General Public License as published  by the Free Soft- --
-- ware  Foundation;  either version 2,  or (at your option) any later ver- --
-- sion.  This is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
-- for  more details.  You should have  received  a copy of the GNU General --
-- Public License  distributed with this;  see file COPYING.  If not, write --
-- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
-- MA 02111-1307, USA.                                                      --
--                                                                          --
-- As a special exception,  if other files  instantiate  generics from this --
-- unit, or you link  this unit with other files  to produce an executable, --
-- this  unit  does not  by itself cause  the resulting  executable  to  be --
-- covered  by the  GNU  General  Public  License.  This exception does not --
-- however invalidate  any other reasons why  the executable file  might be --
-- covered by the  GNU Public License.                                      --
--                                                                          --
-- This is maintained at http://www.pegasoft.ca/tt.html                     --
--                                                                          --
------------------------------------------------------------------------------
with common; use common;
pragma Elaborate( common ); -- remind Ada that common elaborates first

package os is

---> Housekeeping

procedure StartupOS;
pragma export( CPP, StartupOS, "startup_os" );

-- StartupOS initializes the OS package.  This must be the first subprogram
-- executed in the OS package.
-- Errors: none

procedure IdleOS( IdlePeriod : ATimeStamp );
pragma export( CPP, IdleOS, "idle_os" );

-- IdleOS executes idle time tasks when the user's computer is idle.
-- Errors: none

procedure ShutDownOS;
pragma export( CPP, ShutdownOS, "shutdown_os" );

-- ShutDownOS shuts down the OS package.  This must be the final subprogram
-- executed in the OS package.
-- Errors: none

---> File Systems
--
-- This is a list of the file systems recognized (or someday recognized)
-- by the OS package.
--
-- UNIX    - 255 character UNIX
-- UNIX 14 - 14 character UNIX
-- DOSFS   - 8.3 character DOS
-- OS/2    - 255 character OS2
-- NONE    - no file system

type AFileSystem is (UNIXFS, UNIX14FS, DOSFS, OS2FS, NONE);
pragma convention( C, AFileSystem );

---> Pathnames
--
-- A pathname is just a string.
--
-- Path aliases are shortforms.  Predefined are
-- $tmp  = Temporary Directory (eg. /tmp/ )
-- $sys  = User's System Directory ( eg /home/bob/appname )
-- $home = User's Home Directory ( eg /home/bob )

subtype APathName is str255;

---> O/S Shell Interface
--
-- These invoke system() with the specified command.  Except for the
-- boolean function, all others return CoreSystemError if the command
-- failed (ie. returned a bad status).  All return CoreParamError if
-- the string is can't be converted to a C String for the call.

function  UNIX( s : Str255 ) return boolean;  -- shell string, return status
procedure UNIX( s : Str255 );                 -- shell string
function  UNIX( s : Str255 ) return Str255;   -- shell string, return output

function  UNIX( s : string ) return boolean;
procedure UNIX( s : string );
function  UNIX( s : string ) return Str255;
--function  UNIX( s : string ) return Str255List.List;

-- UNIX executes a UNIX shell command.  The boolean function version returns
-- true if there were no errors.  The Str255 version returns the (first)
-- string that results from executing the command.
-- Errors: TT_SystemError - the shell command errored
--         TT_ParamError  - the command string was too long to handle

procedure RunIt( cmd : string;
                 parm1, parm2, parm3 : string := "";
                 Results : in out Str255List.List );
-- Execute command, return results in "results" and exit status in
-- status.


---> File System Calls

procedure ValidateFilename( fs : AFileSystem; oldfn : APathname;
  newfn : in out APathname; errmsg : in out str255 );
pragma export( CPP, ValidateFilename, "validate_filename" );

-- ValidateFilename verifies that a pathname is syntactically correct
-- for the specified file system. If the filename is unacceptable,
-- the reason is outlined in errmsg and a legal filename with the
-- problem characters removed is returned.  (The new filename typically
-- has underscores in place of illegal characters.)  If the filename is
-- acceptable, errmsg is empty.
-- Errors: none

procedure ValidatePathname( fs : AFileSystem; oldfn : APathname;
  newfn : in out APathname; errmsg : in out str255 );
pragma export( CPP, ValidatePathname, "validate_pathname" );

-- Like ValidateFilename, but validates a path

-- GetEnvironment( TheList : Str255List.List );
-- GetEnvironmentVariable( Variable : str255 ) return str255;

---> File Utility Calls

type AFileUsage is (None, ReadOnly, Normal, Run);
pragma Convention( C, AFileUsage );

function  NotEmpty( s : APathName ) return boolean;
pragma export( CPP, NotEmpty, "not_empty" );

-- NotEmpty is true if the specified file has a length greater than zero.
-- Errors: CoreParamError - the path is too long to be handled
--         KB: should return other disk errors

function  IsDirectory( s : APathName ) return boolean;
pragma export( CPP, IsDirectory, "is_dir" );

-- IsDirectory is true if the pathname specifies a directory.
-- Errors: none

function IsFile( s : APathName ) return boolean;
pragma export( CPP, IsFile, "is_file" );

-- IsFile is true if the pathname specifies a readable, existing file.
-- Errors: none

procedure MakeTempFileName (S : out APathName);

-- MakeTempFileName returns the path to a temporary file.
-- Errors: none

function  Lock( file : APathName ) return boolean;

-- NOT YET WRITTEN
-- Locks a file for your private use.
-- Errors: none

procedure Unlock( file : APathName );               --unlocks a file

procedure Erase( file : APathName );                --deletes a file
pragma export( CPP, Erase, "erase" );

procedure Trash( file : APathname );                --file to trash can
pragma export( CPP, Trash, "trash" );

procedure EmptyTrash;                               --empties the trash can
pragma export( CPP, EmptyTrash, "empty_trash" );

procedure Move( file1, file2 : APathName );         --moves a file
pragma export( CPP, Move, "move" );

function  Shrink( file : APathName ) return APathName; --compress a file
pragma export( CPP, Shrink, "shrink" );

function  Expand( file : APathName ) return APathName; --uncompress a file
pragma export( CPP, Expand, "expand" );

procedure Archive( arch, file : APathName );     --add a file to an archive
pragma export( CPP, Archive, "archive" );

procedure Extract( arch, file : APathName );     --remove a file from archive
pragma export( CPP, Extract, "extract" );

procedure Armour( file : APathName; keyfile : APathName := NullStr255 );
procedure Disarmour( file : APathName; keyfile : APathName := NullStr255 );
procedure Usage( file : APathName; me : AFileUsage := Normal;
                                   us : AFileUsage := ReadOnly;
                             everyone : AFileUsage := ReadOnly );

---> Caching Control

procedure BeginSession;
procedure EndSession;


---> Basic Directory Utilities

function SpaceUsed( dir : APathName ) return long_integer;
pragma export( CPP, SpaceUsed, "space_used" );
-- bytes in and under dir, as with `du -sf` * blocksize


---> Device Utilities

-- None of these functions is implemented.
--  function SpaceFree( dev : APathName ) return long_integer;
--  -- bytes free in device
--  function TotalSpace( dev : APathName ) return long_integer;
--  -- total bytes on device
--  function EntriesFree( dev : APathName ) return long_integer;
--  -- inodes free on device
--  function TotalEntries( dev : APathName ) return long_integer;
--  -- total inodes on device
--  function OnDevice( path : APathName ) return APathName;


---> Hardware Utilities

function TotalMem return long_integer;
pragma Import( C, TotalMem, "Ctotalmem" );

function FreeMem return long_integer;
pragma Import( C, FreeMem, "Cfreemem" );

function RealTotalMem return long_integer;
pragma Import( C, RealTotalMem, "Crealtotalmem" );

function RealFreeMem return long_integer;
pragma Import( C, RealFreeMem, "Crealfreemem" );


---> Host Utilities

function GetFreeClusterHost return str255;
pragma export( CPP, GetFreeClusterHost, "get_free_cluster_host" );

-- GetFreeClusterHost returns the name of a free (ie. low activity)
-- machine from the current computer cluster network.  If there is no
-- cluster, the name of the current computer is returned.
-- Security considerations: what does this mean for remote windows?
-- Errors: none


---> Str255List files

procedure LoadList( Path : APathName; StrList : in out Str255List.List );
procedure SaveList( Path : APathName; StrList : in out Str255List.List );


---> Processes

function MyID return long_integer; -- ID for my process/program
  pragma Import( C, MyID, "CGetPID" );
procedure Nice( change : integer ); -- change process' priority onthefly
  pragma Import( C, Nice, "CNice" );
-- get/set password
-- get login directory
-- get user id / username
-- get group id
function IsLocal return boolean;
pragma export( CPP, IsLocal, "is_local" );
-- true if user is local to server

---> Paths
--
-- A path can't be an object because it's used multiple times in
-- parameter lists; gnat to balk on dispatching even when there is
-- no dispatching.

type APathType is (unknown, file, http, ftp, window, runnable);
pragma Convention( C, APathType );
-- How about a variant record?

procedure SetPath( s : APathName ); -- change current path
pragma export( CPP, SetPath, "set_path" );

function  GetPath return APathName; -- return current path
pragma export( CPP, GetPath, "get_path" );

procedure PathAlias( alias : str255; path : APathName );
pragma export( CPP, PathAlias, "path_alias" );

-- PathAlias defines an alias for TextTools pathnames.  There are no checks
-- to see if the alias is a legitimate path.
-- Errors: storage exception if out of memory

procedure DecomposePath( path : APathname; PathType : out APathType;
  Host : out Str255; filepath : out APathname );

-- DecomposePath takes a path or URL and separates it into it's three
-- components: the type of access, the computer address, and the path.
-- Unknown URL's are returned as type "unknown".  There are no checks
-- to see if the Lintel URL is accessible.  The path is expanded before
-- it's decomposed.
--  Note: ftp login not supported yet--can we?
-- Errors: none

function  ExpandPath( path : in APathName ) return APathName;
pragma export( CPP, ExpandPath, "expand_path" );

-- ExpandPath returns the path with any path aliases replaced with
-- the prefix they represent.  There are no checks to see if the
-- resulting path is legitimate.
--   For example, if the alias "$TMP" is defined as "/usr/tmp", then
-- ExpandPath would return "/usr/tmp/file" if the path is "$TMP/file".
-- Errors: none

procedure SplitPath( path : Str255;
   dir : out Str255; file : out Str255 );
pragma export( CPP, SplitPath, "split_path" );

-- SplitPath splits off the trailing file in a path, the one after
-- the last slash.  This routine has not been updated for aliases
-- or URL's (yet).
-- Errors: none

---> Calander Functions
--
-- ATimeStamp is defined in common.

type ATime is record
     seconds : long_integer;
     microseconds : long_integer;
end record;

type ATimeZone is record
     minutes : integer; -- minutes west of Greenwich
     savings : integer; -- additional daylight savings minutes
end record;

function GetDate return str255;         -- return date in dd/mm/yy format
pragma export( CPP, GetDate, "get_date" );

function GetTime return str255;         -- return time in hr:mm:ss format
pragma export( CPP, GetTime, "get_time" );

procedure GetClock( time : in out ATime;
                   timezone : in out ATimeZone );
  pragma Import( C, GetClock, "gettimeofday" ); -- Linux unistd.h
function GetLongDate return str255;     -- return full English date
function GetTimeStamp return ATimeStamp;-- get a sortable time-stamp
                                        -- (in microseconds)
procedure Wait( seconds : float );
pragma export( CPP, Wait, "wait" );

---> Text File

procedure AddFile( file, text : str255 );
pragma export( CPP, AddFile, "add_file" );

---> Logging

procedure SessionLog( message : str255 );
pragma export( CPP, SessionLog, "session_log" );

procedure SessionLog( ada_message : string );
procedure SessionLog( message : str255; ErrorCode : AnErrorCode );
procedure SessionLog( ada_message : string; ErrorCode : AnErrorCode );

end os;