File: os.ads

package info (click to toggle)
libtexttools 2.0.3-4
  • links: PTS
  • area: main
  • in suites: etch, etch-m68k
  • size: 1,188 kB
  • ctags: 635
  • sloc: ada: 13,120; cpp: 1,679; ansic: 777; makefile: 156; sh: 2
file content (372 lines) | stat: -rw-r--r-- 13,765 bytes parent folder | download | duplicates (2)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
------------------------------------------------------------------------------
-- OS                                                                       --
--                                                                          --
-- Part of TextTools                                                        --
-- Designed and Programmed by Ken O. Burtch                                 --
--                                                                          --
------------------------------------------------------------------------------
--                                                                          --
--                 Copyright (C) 1999-2003 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.vaxxine.com/pegasoft                    --
--                                                                          --
------------------------------------------------------------------------------
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 : in 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

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;