-
Notifications
You must be signed in to change notification settings - Fork 1
/
Copy pathtiacommon.ads
318 lines (246 loc) · 12.8 KB
/
tiacommon.ads
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
------------------------------------------------------------------------------
-- TIACOMMON - common definitions for TIA --
-- --
-- Developed by Ken O. Burtch --
------------------------------------------------------------------------------
-- --
-- Copyright (C) 1999-2007 PegaSoft Canada --
-- --
-- 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/tia.html --
-- --
------------------------------------------------------------------------------
with ada.text_io, -- for printing results in non-interactive modes
ada.command_line, -- for return result code
common,
os, -- clock and O/S stuff for Ken's windows
strings, -- Ken's string functions
userio, -- Ken's ASCII drawing stuff
controls, -- controls for Ken's windows
windows, -- Ken's windows
english;
use common, os, strings, userio, controls, windows, english;
Pragma Optimize( Space ); -- make program as small as possible
package tiacommon is -------------------------------------------
-- Current Source Files ----------------------------------------
-- This is now in texttools
--type aSourceLanguage is ( unknownLanguage, Ada_Language, C, CPP, Java, Bush,
-- Perl, PHP, HTML, Shell );
type aSourceType is ( unknownType, AdaBody, AdaSpec, CHeader, CSource,
CPPHeader, CPPSource, JavaSource, BushSource, PerlSource, PerlModule,
WebPage, ShellScript, PHPSource );
-- only used if source path is null (ie unsaved, new source)
type anAutoHelpStyle is ( None, Info, Proto, Both );
languageData : aliased languageDataArray; -- TIA language definitions
format_error : exception;
languageFileName : constant string := "tiadefs.txt";
KeywordHilight : aPenColourName;
FunctionHilight : aPenColourName;
AutoHelpStyle : anAutoHelpStyle;
ProjectPath : Str255 := NullStr255; -- path of current project
SourcePath : Str255 := NullStr255; -- path of current source file
SourceText : Str255List.List; -- empty unless loading and
-- saving text being edited
-- (this should be changed!)
sourceLanguage: aSourceLanguage := unknownLanguage;
sourceType : aSourceType := unknownType;
NeedsFullRecompile : boolean := false; -- set when project params are
-- changed to force a compile rebuild of the project
PlatformSig : Str255 := NullStr255; -- current platform signature
ProjectLocked : boolean := true; -- true if read-only project
HasCVS : boolean := false; -- true if CVS found at startup
IsCVSProject : boolean := false; -- true if "CVS" directory in proj
IsSVNProject : boolean := false; -- true if "svn" directory in proj
HasSVN : boolean := false; -- true if Subversion found at startup
-- Program Options ---------------------------------------------
--
-- These are saved by default to $HOME/.tiarc
OptionsPath : str255 := To255( "$HOME/.tiarc" );
Opt_Quiet : boolean := true; -- background updates
Opt_Blue : boolean := true; -- blue background
Opt_Backup : Str255 := NullStr255; -- command to backup project
Opt_TipNumber : integer := 1; -- tip number stored in .tiarc
Opt_KeyCount : long_integer := 0; -- key stats for .rc lifetime
Opt_CVS : boolean := false; -- use CVS for project management
Opt_SVN : boolean := false; -- use SVN for project management
-- Current Project Settings ------------------------------------
--
-- This are saved to the project's .adp file
Proj_GCCOptions : str255 := NullStr255; -- additional gcc switches
Proj_LinkOptions : str255 := NullStr255; -- additional link switches
Proj_Main : str255 := NullStr255; -- name of main program
Proj_GUI : str255 := To255( "rapid" ); -- name of GUI builder
Proj_Opt : short_short_integer := 2; -- optimization level
Proj_CPU : short_short_integer := 3; -- CPU type
Proj_Debug : short_short_integer := 2; -- debugging level
Proj_Kind : short_short_integer := 1; -- project type
Proj_Builder : short_short_integer := 1; -- project builder
Proj_Static : boolean := true; -- static build
Proj_Egcs : boolean := false; -- egcs compiler
Proj_Alt : boolean := false; -- ALT version of GNAT
Proj_GCJ : boolean := false; -- GCC version of Java
Proj_PlatSig : str255 := To255( "unknown" );
Proj_Repository : str255 := To255( "" ); -- Subversion URL
-- data to deterime if new compiler/system is being used
Proj_KeyCount : long_integer := 0; -- key stats for project
Proj_BuildCount : long_integer := 0; -- build stats for project
Proj_BuildTime : ATimeStamp; -- last succesful build
Proj_LineCount : long_integer := 0; -- CR stats for project
Proj_BuildTimeStr: Str255 := To255( "none" ); -- BuildTime as string
Proj_UpdateTime : ATimeStamp := 0; -- CVS Update Time as str
-- also SourcePath is saved in the .adp file
Proj_BackupTime : ATimeStamp := 0;
-- Background Processing ---------------------------------------
--
-- TIA compiles recently edited files in the background each
-- time the user loads another file. Although parallel compiling
-- isn't supported yet, I've defined the data structures for
-- up to 4 machines, which are cycled through.
MaxBackgroundProcesses : positive := 4;
subtype ABackgroundProcessNumber is positive range 1..MaxBackgroundProcesses;
type BackgroundLockArray is array( ABackgroundProcessNumber ) of
Str255;
BackgroundLockPrefix : string := "/tmp/tiablock";
RemoteHosts : BackgroundLockArray; -- avail. background hosts
BackgroundLock : BackgroundLockArray; -- list of lock files
NextBackgroundLock : ABackgroundProcessNumber; -- next process to use
procedure InitBackground;
-- setup background update variables
procedure BackgroundUpdate( source : str255 );
-- start a background update: compile given source file
function IsBackgroundUpdate return boolean;
-- are there any background updates running?
-- Global Controls ---------------------------------------------
--
-- This is the statistics shown on the right-hand side of the
-- main window if the window is wide enough. Also the main source
-- control since we need access to this to show the x,y position.
SourceBox : aliased ASourceEditList; -- the source code edit area
SourceBar : aliased AScrollBar; -- and it's scroll bar
ShowingMarginStats : boolean := false;
CursorPosX : aliased aStaticLine;
CursorPosY : aliased aStaticLine;
DocLength : aliased aStaticLine;
--LastStatsDoc : str255 := NullStr255;
LastCursorPosX : integer := -1;
LastCursorPosY : long_integer := -1;
LastDocLength : long_integer := -1;
-- Source History ----------------------------------------------
type ASourceReference is record
path : Str255 := NullStr255;
line : Str255List.AListIndex := 0;
posn : integer := 0;
end record;
QuickOpen1 : ASourceReference;
QuickOpen2 : ASourceReference;
QuickOpen3 : ASourceReference;
QuickOpen4 : ASourceReference;
QuickOpen5 : ASourceReference;
procedure UpdateQuickOpen( quickpath : str255; line : Str255List.AListIndex;
posn : integer );
-- add a source file to the quick open list, long with the position
-- where the cursor was
procedure NewSource;
-- create an empty package spec
function getPathSuffix( SourcePath : Str255 ) return Str255;
-- Return the suffix of a pathname (e.g. ".c",
-- ".adb", ".java", etc.
procedure SetSourceLanguage( path : str255 := NullStr255 );
-- Set the SourceLanguage variable based on
-- the source file suffix.
procedure LoadSourceFile( path : str255; text : out Str255List.List );
-- Load a source file into the string list, converting tabs to spaces
-- Doesn't check the file type or change the keyword hilighting
procedure SaveSourceFile( path : str255; text : out Str255List.List );
-- Save a source file into the string list, removing trailing spaces
-- Doesn't check the file type or change the keyword hilighting
function basename( s : str255 ) return string;
-- return a filename from a pathname
-- Last Errors Reported by Gnat --------------------------------
LastSuccessfulBuildTime : long_integer := 0;
LastSuccessfulBuildCount : long_integer := 0;
GnatErrors : Str255List.List;
NextGnatError : long_integer := 1;
LoadExceptions : Str255List.List;
procedure ClearGnatErrors;
-- clear the list of errors
procedure NormalizeGnatErrors;
-- fix errors for non-GCC languages (ie. Perl)
procedure ClearLoadExceptions;
-- erase the load exceptions list
procedure AddLoadException( current, newfile : str255 );
-- add a filename to the list of files that won't be loaded
-- when mentioned in an erro rmessage
function IsLoadException( current, newfile : str255 ) return boolean;
-- true if in load exception list
-- Misc. Globals -----------------------------------------------
NullList : Str255List.List; -- empty gen list header
-- this is assigned one node because Copy, used by SetList,
-- doesn't work properly on empty lists...I'll have to fix that
-- sometime.
DisplayInfo : ADisplayInfoRec;
-- info about the display as returned by Window Manager's
-- GetDisplayInfo.
ItemHelpList : Str255List.List;
-- List of words for item help
procedure loadLanguageData;
-- Load the language data file for TIA. Can raise I/O errors or format_error
-- if there's a problem with the format of the data file.
function GetWindowTitleFromPath( path : Str255 ) return Str255;
-- create a window title from the given path. eg. "untitled.adb"
-- if no path, or strip off directories to leave filename
procedure UpdateMarginStats;
-- show statistics in right-hand margin
procedure OutputFilter( DT : in out ADialogTaskRecord );
-- for processing statistics in right-hand margin
procedure InputFilter( DT : in out ADialogTaskRecord );
-- for processing alt keys in main menu
OutputCB : ADialogTaskCallback := OutputFilter'access;
-- ptr to output filter as required for DoDialog
InputCB : ADialogTaskCallback := InputFilter'access;
-- ptr to input filter as required for DoDialog
procedure MenuInputFilter( DT : in out ADialogTaskRecord );
-- for processing clicks outside of a menu
MenuInputCB : ADialogTaskCallback := MenuInputFilter'access;
-- ptr to input filter as required for DoDialog
---> Output Pipes (for running builder)
procedure Pipe( s : str255 );
-- open a pipe for reading using command s. Captures both
-- stderr and stdout, using shell "2>&1" notation.
function PipeFinished return boolean;
-- check to see if a pipe is finished. Closes pipe if it is.
procedure NextPipeLine( s : out str255 );
-- read next line from the pipe
---> Platform Signature
procedure GetPlatformSig;
-- return a string describing current hardware/os/gnat-version
-- to determine if project has been moved to new system and
-- needs to be fully rebuilt
---> Multiple People
procedure LockProject;
-- open the project and put a file system lock on it. Success
-- if global variable ProjectLocked is true
procedure UnlockProject;
-- unlock a locked project
---> Strings
function stringField( s : str255; delimiter : character; f : natural )
return str255;
-- extra a field from a string based on a delimiter
end tiacommon;