paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-27 12:10:36 +02:00
Code Issues Packages Projects Releases Wiki Activity

Merged revision(s) 28693 from branches/svenbarth/packages:

Browse Source 
Provide possibility to register callbacks that are called from InitGlobals and DoneGlobals.

globals.pas:
  + new function register_initdone_proc which allows to register a callback for InitGlobals and DoneGlobals respectively
  + add functions callinitprocs, calldoneprocs, allocinitdoneprocs, freeinitdoneprocs to manage and access the init/done-callbacks
  * InitGlobals: call callinitprocs
  * DoneGlobals: call calldoneprocs 
........

git-svn-id: trunk@32977 -
This commit is contained in:
svenbarth 2016-01-22 15:28:30 +00:00
parent 02e56f410d
commit 01af8f9cc4
1 changed files with 69 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

69
compiler/globals.pas
View File

@ -523,6 +523,7 @@ interface
procedure InitGlobals;
procedure DoneGlobals;
procedure register_initdone_proc(init,done:tprocedure);
function string2guid(const s: string; var GUID: TGUID): boolean;
function guid2string(const GUID: TGUID): string;
@ -1349,8 +1350,70 @@ implementation
type
tinitdoneentry=record
init:tprocedure;
done:tprocedure;
end;
pinitdoneentry=^tinitdoneentry;
var
initdoneprocs : TFPList;
procedure register_initdone_proc(init,done:tprocedure);
var
entry : pinitdoneentry;
begin
new(entry);
entry^.init:=init;
entry^.done:=done;
initdoneprocs.add(entry);
end;
procedure callinitprocs;
var
i : longint;
begin
for i:=0 to initdoneprocs.count-1 do
with pinitdoneentry(initdoneprocs[i])^ do
if assigned(init) then
init();
end;
procedure calldoneprocs;
var
i : longint;
begin
for i:=0 to initdoneprocs.count-1 do
with pinitdoneentry(initdoneprocs[i])^ do
if assigned(done) then
done();
end;
procedure allocinitdoneprocs;
begin
initdoneprocs:=tfplist.create;
end;
procedure freeinitdoneprocs;
var
i : longint;
begin
for i:=0 to initdoneprocs.count-1 do
dispose(pinitdoneentry(initdoneprocs[i]));
initdoneprocs.free;
end;
procedure DoneGlobals;
begin
calldoneprocs;
librarysearchpath.Free;
unitsearchpath.Free;
objectsearchpath.Free;
@ -1434,6 +1497,12 @@ implementation
{ enable all features by default }
features:=[low(Tfeature)..high(Tfeature)];
callinitprocs;
end;
initialization
allocinitdoneprocs;
finalization
freeinitdoneprocs;
end.