diff --git a/.gitattributes b/.gitattributes
index f27743249d..4f57d57946 100644
--- a/.gitattributes
+++ b/.gitattributes
@@ -19361,6 +19361,10 @@ utils/pas2js/docs/translation.html svneol=native#text/html
utils/pas2js/fpmake.lpi svneol=native#text/plain
utils/pas2js/fpmake.pp svneol=native#text/plain
utils/pas2js/httpcompiler.pp svneol=native#text/plain
+utils/pas2js/libstub.lpi svneol=native#text/plain
+utils/pas2js/libstub.pp svneol=native#text/plain
+utils/pas2js/makestub.lpi svneol=native#text/plain
+utils/pas2js/makestub.pp svneol=native#text/plain
utils/pas2js/nodepas2js.lpi svneol=native#text/plain
utils/pas2js/nodepas2js.pp svneol=native#text/plain
utils/pas2js/pas2js.cfg svneol=native#text/plain
@@ -19376,6 +19380,7 @@ utils/pas2js/samples/hello.pas svneol=native#text/plain
utils/pas2js/samples/ifdemo.pp svneol=native#text/plain
utils/pas2js/samples/repeatdemo.pp svneol=native#text/plain
utils/pas2js/samples/whiledemo.pp svneol=native#text/plain
+utils/pas2js/stubcreator.pp svneol=native#text/plain
utils/pas2js/webfilecache.pp svneol=native#text/plain
utils/pas2js/webidl2pas.lpi svneol=native#text/plain
utils/pas2js/webidl2pas.pp svneol=native#text/plain
diff --git a/utils/pas2js/libstub.lpi b/utils/pas2js/libstub.lpi
new file mode 100644
index 0000000000..32135500ec
--- /dev/null
+++ b/utils/pas2js/libstub.lpi
@@ -0,0 +1,67 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ -
+
+
+ -
+
+
+ -
+
+
+
+
+
diff --git a/utils/pas2js/libstub.pp b/utils/pas2js/libstub.pp
new file mode 100644
index 0000000000..ae87c46c02
--- /dev/null
+++ b/utils/pas2js/libstub.pp
@@ -0,0 +1,174 @@
+{
+ libstub - pas2js stub generator, library version
+ Copyright (C) 2017 - 2020 by Michael Van Canneyt michael@freepascal.org
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+}
+library stub;
+
+{$mode objfpc}{$H+}
+
+uses
+ SysUtils, Classes, stubcreator;
+
+Type
+ PStubCreator = Pointer;
+
+Function GetStubCreator : PStubCreator; stdcall;
+
+begin
+ Result:=TStubCreator.Create(Nil);
+end;
+
+Procedure FreeStubCreator(P : PStubCreator); stdcall;
+
+begin
+ TStubCreator(P).Free;
+end;
+
+Function MaybeStr(P : PAnsiChar) : String;
+
+begin
+ If Assigned(P) then
+ Result:=P
+ else
+ Result:='';
+end;
+
+Procedure SetStubCreatorInputFileName(P : PStubCreator; AFileName : PAnsiChar); stdcall;
+
+begin
+ if Assigned(P) then
+ With TStubCreator(P) do
+ InputFileName:=AFileName;
+end;
+
+
+Procedure SetStubCreatorConfigFileName(P : PStubCreator; AFileName : PAnsiChar); stdcall;
+
+begin
+ if Assigned(P) then
+ With TStubCreator(P) do
+ ConfigFileName:=MaybeStr(AFileName);
+end;
+
+
+Procedure SetStubCreatorOutputFileName(P : PStubCreator; AFileName : PAnsiChar); stdcall;
+
+begin
+ if Assigned(P) then
+ With TStubCreator(P) do
+ OutputFileName:=MaybeStr(AFileName);
+end;
+
+Procedure SetStubCreatorHeaderFileName(P : PStubCreator; AFileName : PAnsiChar); stdcall;
+
+begin
+ if Assigned(P) then
+ With TStubCreator(P) do
+ HeaderFileName:=MaybeStr(AFileName);
+end;
+
+Procedure AddStubCreatorDefine(P : PStubCreator; ADefine : PAnsiChar); stdcall;
+
+begin
+ if Assigned(P) then
+ With TStubCreator(P) do
+ TStubCreator(P).Defines.Add(MaybeStr(ADefine));
+end;
+
+Procedure AddStubCreatorForwardClass(P : PStubCreator; AForwardClass : PAnsiChar); stdcall;
+
+Var
+ S : String;
+
+begin
+ if Assigned(P) then
+ With TStubCreator(P) do
+ begin
+ S:=MaybeStr(AForwardClass);
+ if (S<>'') then
+ begin
+ if TStubCreator(P).ForwardClasses<>'' then
+ S:=','+S;
+ TStubCreator(P).ForwardClasses:=TStubCreator(P).ForwardClasses+S;
+ end;
+ end;
+end;
+
+Procedure SetStubCreatorHeaderContent(P : PStubCreator; AContent : PAnsiChar); stdcall;
+
+begin
+ if Assigned(P) then
+ With TStubCreator(P) do
+ HeaderStream:=TStringStream.Create(MaybeStr(AContent));
+end;
+
+Procedure SetStubCreatorOuputCallBack(P : PStubCreator; AData : Pointer; ACallBack : TWriteCallBack); stdcall;
+
+begin
+ if Assigned(P) then
+ With TStubCreator(P) do
+ begin
+ CallbackData:=AData;
+ OnWriteCallBack:=ACallBack;
+ end;
+end;
+
+Function ExecuteStubCreator(P : PStubCreator) : Boolean; stdcall;
+
+begin
+ Result:=False;
+ try
+ TStubCreator(P).Execute;
+ Result:=True;
+ except
+ On E: Exception do
+ Writeln('Exception ',E.ClassName,' ',E.Message);
+ // Ignore
+ end;
+end;
+
+Procedure GetStubCreatorLastError(P : PStubCreator; AError : PAnsiChar;
+ Var AErrorLength : Longint; AErrorClass : PAnsiChar; Var AErrorClassLength : Longint); stdcall;
+
+Var
+ L : Integer;
+ E,C : String;
+
+begin
+ TStubCreator(P).GetLastError(E,C);
+ L:=Length(E);
+ if (L>AErrorLength) then
+ L:=AErrorLength;
+ if (L>0) then
+ Move(E[1],AError^,L);
+ L:=Length(C);
+ if L>AErrorClassLength then
+ L:=AErrorClassLength;
+ if (L>0) then
+ Move(C[1],AErrorClass^,L);
+end;
+
+exports
+ // Stub creator
+ GetStubCreator,
+ FreeStubCreator,
+ SetStubCreatorInputFileName,
+ SetStubCreatorOutputFileName,
+ SetStubCreatorHeaderFileName,
+ SetStubCreatorConfigFileName,
+ SetStubCreatorHeaderContent,
+ SetStubCreatorOuputCallBack,
+ GetStubCreatorLastError,
+ AddStubCreatorDefine,
+ AddStubCreatorForwardClass,
+ ExecuteStubCreator;
+
+end.
+
diff --git a/utils/pas2js/makestub.lpi b/utils/pas2js/makestub.lpi
new file mode 100644
index 0000000000..6d5db4e64b
--- /dev/null
+++ b/utils/pas2js/makestub.lpi
@@ -0,0 +1,70 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/utils/pas2js/makestub.pp b/utils/pas2js/makestub.pp
new file mode 100644
index 0000000000..d917c9ee24
--- /dev/null
+++ b/utils/pas2js/makestub.pp
@@ -0,0 +1,121 @@
+{
+ makestub - pas2js stub generator
+ Copyright (C) 2017 - 2020 by Michael Van Canneyt michael@freepascal.org
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+}
+program makestub;
+
+{$mode objfpc}
+{$H+}
+
+uses SysUtils, Classes, custapp, stubcreator;
+
+Type
+ { TStubCreatorApplication }
+
+ TStubCreatorApplication = Class(TCustomApplication)
+ Private
+ FCreator : TStubCreator;
+ procedure PrintUsage(S: String);
+ Protected
+ function ParseOptions : Boolean;
+ Procedure DoRun; override;
+ Public
+ Constructor Create(AOwner : TComponent); override;
+ Destructor Destroy; override;
+ end;
+
+{ TStubCreatorApplication }
+
+procedure TStubCreatorApplication.PrintUsage(S : String);
+
+begin
+ if S<>'' then
+ Writeln('Error : ',S);
+ writeln('usage: stubcreator options');
+ writeln;
+ writeln('Where options is one or more of');
+ Writeln('-h --help This text');
+ writeln('-i --input=file Is the file to be read by the parser');
+ writeln('-I --include=dir Add dir to include path');
+ writeln('-o --output=file Output file name. If not specified, standard output is assumed ');
+ Writeln('-c --config=filename Read ini file with configuration');
+ Writeln('-H --header=filename Add file header using contents of file "filename"');
+ Writeln('-f --forwardclasses[=list]');
+ Writeln(' Generate forward definitions for list of classes. If empty, for all classes.');
+ ExitCode:=Ord(S<>'');
+end;
+
+function TStubCreatorApplication.ParseOptions : Boolean;
+
+Var
+ S : String;
+
+begin
+ Result:=False;
+ S:=CheckOptions('d:i:o:c:h:f:H:I:',['help','input:','output:','forwardclasses::',
+ 'config:','linenumberwidth:','define:','header:',
+ 'include:']);
+ if (S<>'') or HasOption('h','help') then
+ begin
+ PrintUsage(S);
+ Exit;
+ end;
+ FCreator.InputFileName:=GetOptionValue('i','input');
+ FCreator.OutputFileName:=GetOptionValue('o','output');
+ FCreator.HeaderFileName:=GetOptionValue('H','header');
+ If HasOption('d','define') then
+ for S in GetOptionValues('d','define') do
+ FCreator.Defines.Add(S);
+ If HasOption('I','include') then
+ for S in GetOptionValues('i','include') do
+ FCreator.IncludePaths.Add(S);
+ if Hasoption('f','forwardclasses') then
+ FCreator.ForwardClasses:=GetOptionValue('f','forwardclasses');
+ if (FCreator.HeaderFileName<>'') and Not FileExists(FCreator.HeaderFileName) then
+ begin
+ PrintUsage(Format('Header file "%s"does not exist',[FCreator.HeaderFileName]));
+ Exit;
+ end;
+ Result:=True;
+end;
+
+{ TStubCreatorApplication }
+
+procedure TStubCreatorApplication.DoRun;
+
+begin
+ Terminate;
+ If not ParseOptions then
+ exit;
+ FCreator.Execute;
+end;
+
+constructor TStubCreatorApplication.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+ FCreator:=TStubCreator.Create(Self);
+ StopOnException:=True;
+end;
+
+destructor TStubCreatorApplication.Destroy;
+begin
+ FreeAndNil(FCreator);
+ inherited Destroy;
+end;
+
+Var
+ Application : TStubCreatorApplication;
+
+begin
+ Application:=TStubCreatorApplication.Create(Nil);
+ Application.Initialize;
+ Application.Run;
+ Application.Free;
+end.
diff --git a/utils/pas2js/stubcreator.pp b/utils/pas2js/stubcreator.pp
new file mode 100644
index 0000000000..68cfd22c83
--- /dev/null
+++ b/utils/pas2js/stubcreator.pp
@@ -0,0 +1,408 @@
+{
+ Copyright (C) 2017 - 2020 by Michael Van Canneyt michael@freepascal.org
+
+ pas2js Delphi stub generator - component
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+}
+unit stubcreator;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ Classes, SysUtils, strutils, inifiles, pscanner, pparser, pastree, iostream, paswrite;
+
+Const
+ DTypesUnit = 'jsdelphisystem';
+
+type
+ { We have to override abstract TPasTreeContainer methods }
+
+ TSimpleEngine = class(TPasTreeContainer)
+ public
+ function CreateElement(AClass: TPTreeElement; const AName: String;
+ AParent: TPasElement; AVisibility: TPasMemberVisibility;
+ const ASourceFilename: String; ASourceLinenumber: Integer): TPasElement;
+ override;
+ function FindElement(const AName: String): TPasElement; override;
+ end;
+
+ TWriteCallBack = Procedure (Data : Pointer; AFileData : PAnsiChar; AFileDataLen: Int32); stdcall;
+ TWriteEvent = Procedure(AFileData : String) of object;
+
+ { TStubCreator }
+
+ TStubCreator = Class(TComponent)
+ private
+ FConfigFile: String;
+ FHeaderStream: TStream;
+ FIncludePaths: TStrings;
+ FInputFile: String;
+ FOnWrite: TWriteEvent;
+ FOnWriteCallBack: TWriteCallBack;
+ FOutputFile: String;
+ FDefines : TStrings;
+ FOptions: TPasWriterOptions;
+ FLineNumberWidth,
+ FIndentSize : Integer;
+ FExtraUnits : String;
+ FForwardClasses : String;
+ FHeaderFile : String;
+ FOutputStream: TStream;
+ FWriteStream : TStringStream;
+ FCallBackData : Pointer;
+ FLastErrorClass : String;
+ FLastError : String;
+ procedure SetDefines(AValue: TStrings);
+ procedure SetIncludePaths(AValue: TStrings);
+ procedure SetOnWrite(AValue: TWriteEvent);
+ procedure SetWriteCallback(AValue: TWriteCallBack);
+ Protected
+ procedure DoExecute;virtual;
+ Procedure DoWriteEvent; virtual;
+ procedure ReadConfig(const aFileName: String); virtual;
+ procedure ReadConfig(const aIni: TIniFile); virtual;
+ procedure WriteModule(M: TPasModule); virtual;
+ function GetModule: TPasModule; virtual;
+ Function MaybeGetFileStream(AStream : TStream; Const AFileName : String; aFileMode : Word) : TStream; virtual;
+ Public
+ Constructor Create(AOwner : TComponent); override;
+ Destructor Destroy; override;
+ Procedure Execute;
+ Procedure GetLastError(Out AError,AErrorClass : String);
+ // Streams take precedence over filenames. They will be freed on destroy!
+ // OutputStream can be used combined with write callbacks.
+ Property OutputStream : TStream Read FOutputStream Write FOutputStream;
+ Property HeaderStream : TStream Read FHeaderStream Write FHeaderStream;
+ Property OnWriteCallBack : TWriteCallBack Read FOnWriteCallBack Write SetWriteCallback;
+ Property CallbackData : Pointer Read FCallBackData Write FCallBackData;
+
+ Published
+ Property Defines : TStrings Read FDefines Write SetDefines;
+ Property ConfigFileName : String Read FConfigFile Write FConfigFile;
+ Property InputFileName : String Read FInputFile write FInputFile;
+ Property OutputFileName : String Read FOutputFile write FOutputFile;
+ Property HeaderFileName : String Read FHeaderFile write FHeaderFile;
+ Property ForwardClasses : String Read FForwardClasses write FForwardClasses;
+ Property IncludePaths : TStrings Read FIncludePaths Write SetIncludePaths;
+ Property OnWrite : TWriteEvent Read FOnWrite Write SetOnWrite;
+ end;
+
+Implementation
+
+ResourceString
+ SErrNoDestGiven = 'No destination file specified.';
+ SErrNoSourceParsed = 'Parsing produced no file.';
+
+procedure TStubCreator.SetDefines(AValue: TStrings);
+begin
+ if FDefines=AValue then Exit;
+ FDefines.Assign(AValue);
+end;
+
+procedure TStubCreator.SetIncludePaths(AValue: TStrings);
+begin
+ if FIncludePaths=AValue then Exit;
+ FIncludePaths.Assign(AValue);
+end;
+
+procedure TStubCreator.SetOnWrite(AValue: TWriteEvent);
+begin
+ if FOnWrite=AValue then Exit;
+ FOnWrite:=AValue;
+ FreeAndNil(FWriteStream);
+ if Assigned(AValue) then
+ FWriteStream:=TStringStream.Create('');
+end;
+
+procedure TStubCreator.SetWriteCallback(AValue: TWriteCallBack);
+begin
+ if FOnWriteCallBack=AValue then Exit;
+ FOnWriteCallBack:=AValue;
+ FreeAndNil(FWriteStream);
+ if Assigned(AValue) then
+ FWriteStream:=TStringStream.Create('');
+end;
+
+procedure TStubCreator.DoWriteEvent;
+
+Var
+ S : String;
+
+begin
+ If Assigned(FOnWrite) then
+ FOnWrite(FWriteStream.DataString);
+ if Assigned(FOnWriteCallBack) then
+ begin
+ S:=FWriteStream.DataString;
+ FOnWriteCallBack(FCallBackData,PChar(S),Length(S));
+ end;
+end;
+
+{ TStubCreator }
+
+procedure TStubCreator.ReadConfig(const aFileName: String);
+
+Var
+ ini : TMemIniFile;
+
+begin
+ ini:=TMemIniFile.Create(AFileName);
+ try
+ ReadConfig(Ini);
+ finally
+ Ini.Free;
+ end;
+end;
+
+procedure TStubCreator.ReadConfig(const aIni: TIniFile);
+
+Const
+ DelChars = [',',' '];
+
+Var
+ O : TPaswriterOptions;
+ S : String;
+ I : Integer;
+
+
+begin
+ O:=[];
+ With aIni do
+ begin
+ if ReadBool('Config','addlinenumber',False) then
+ Include(O,woAddLineNumber);
+ if ReadBool('Config','addsourcelinenumber',False) then
+ Include(O,woAddLineNumber);
+ FOptions:=FOptions+O;
+ InputFilename:=ReadString('config','input',InputFilename);
+ OutputFilename:=ReadString('config','output',OutputFilename);
+ HeaderFilename:=ReadString('config','header',HeaderFilename);
+ FIndentSize:=ReadInteger('config','indentsize',FIndentSize);
+ FLineNumberWidth:=ReadInteger('config','linenumberwidth',FLineNumberWidth);
+ FExtraUnits:=ReadString('config','extra',FExtraUnits);
+ FForwardClasses:=ReadString('config','forwardclasses',FForwardClasses);
+ S:=ReadString('config','defines','');
+ if (S<>'') then
+ For I:=1 to WordCount(S,DelChars) do
+ FDefines.Add(UpperCase(ExtractWord(I,S,DelChars)));
+ S:=ReadString('config','includepaths','');
+ if (S<>'') then
+ For I:=1 to WordCount(S,[',',';']) do
+ FIncludePaths.Add(ExtractWord(I,S,[',',';']));
+ end;
+ if (FForwardClasses<>'') or (FForwardClasses='all') then
+ Include(O,woForwardClasses);
+end;
+
+procedure TStubCreator.Execute;
+
+begin
+ FLastErrorClass:='';
+ FLastError:='';
+ Try
+ DoExecute;
+ except
+ On E : Exception do
+ begin
+ FLastErrorClass:=E.Classname;
+ FLastError:=E.Message;
+ Raise;
+ end;
+ end;
+end;
+
+procedure TStubCreator.GetLastError(out AError, AErrorClass: String);
+begin
+ AError:=FLastError;
+ AErrorClass:=FLastErrorClass;
+end;
+
+procedure TStubCreator.DoExecute;
+
+Var
+ M : TPasModule;
+
+begin
+ If (ConfigFileName<>'') then
+ ReadConfig(ConfigFileName);
+ if InputFilename = '' then
+ raise Exception.Create(SErrNoSourceGiven);
+ if (OutputFilename = '') and (FoutputStream=Nil) and (FWriteStream=Nil) then
+ raise Exception.Create(SErrNoDestGiven);
+ if CompareText(ForwardClasses,'all')=0 then
+ begin
+ Include(Foptions,woForwardClasses);
+ ForwardClasses:='';
+ end
+ else if (ForwardClasses<>'') then
+ Include(Foptions,woForwardClasses);
+ Include(Foptions,woForceOverload);
+ M:=GetModule;
+ if M=Nil then
+ raise Exception.Create(SErrNoSourceParsed);
+ try
+ WriteModule(M);
+ finally
+ M.Free;
+ end;
+end;
+
+{ TSimpleEngine }
+
+function TSimpleEngine.CreateElement(AClass: TPTreeElement; const AName: String;
+ AParent: TPasElement; AVisibility: TPasMemberVisibility;
+ const ASourceFilename: String; ASourceLinenumber: Integer): TPasElement;
+begin
+ Result := AClass.Create(AName, AParent);
+ Result.Visibility := AVisibility;
+ Result.SourceFilename := ASourceFilename;
+ Result.SourceLinenumber := ASourceLinenumber;
+end;
+
+function TSimpleEngine.FindElement(const AName: String): TPasElement;
+begin
+ { dummy implementation, see TFPDocEngine.FindElement for a real example }
+ Result := nil;
+ if AName<>'' then ; // Keep compiler happy
+end;
+
+
+
+Function TStubCreator.GetModule : TPasModule;
+
+Var
+ SE : TSimpleEngine;
+ FileResolver: TFileResolver;
+ Parser: TPasParser;
+ Scanner: TPascalScanner;
+
+var
+ s: String;
+
+begin
+ Result := nil;
+ FileResolver := nil;
+ Scanner := nil;
+ Parser := nil;
+ SE:=TSimpleEngine.Create;
+ try
+ // File resolver
+ FileResolver := TFileResolver.Create;
+ FileResolver.UseStreams:=True;
+ FileResolver.AddIncludePath(ExtractFilePath(InputFileName));
+ For S in FIncludePaths do
+ FileResolver.AddIncludePath(S);
+ // Scanner
+ Scanner := TPascalScanner.Create(FileResolver);
+ Scanner.Options:=[po_AsmWhole,po_KeepClassForward];
+ SCanner.LogEvents:=SE.ScannerLogEvents;
+ SCanner.OnLog:=SE.Onlog;
+ For S in FDefines do
+ Scanner.AddDefine(S);
+ Scanner.OpenFile(InputFilename);
+ // Parser
+ Parser:=TPasParser.Create(Scanner, FileResolver, SE);
+ Parser.LogEvents:=SE.ParserLogEvents;
+ Parser.OnLog:=SE.Onlog;
+ Parser.Options:=Parser.Options+[po_AsmWhole,po_delphi,po_KeepClassForward];
+ Parser.ParseMain(Result);
+ finally
+ Parser.Free;
+ Scanner.Free;
+ FileResolver.Free;
+ SE.Free;
+ end;
+end;
+
+function TStubCreator.MaybeGetFileStream(AStream: TStream; const AFileName: String; AfileMode : Word) : TStream;
+begin
+ If Assigned(AStream) then
+ Result:=AStream
+ else if (AFileName<>'') then
+ Result:=TFileStream.Create(AFileName,aFileMode)
+ else
+ Result:=Nil;
+end;
+
+constructor TStubCreator.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+ FDefines:=TStringList.Create;
+ FIncludePaths:=TStringList.Create;
+ FLineNumberWidth:=4;
+ FIndentSize:=2;
+ FExtraUnits:='';
+ FOptions:=[woNoImplementation,woNoExternalClass,woNoExternalVar,woNoExternalFunc];
+end;
+
+destructor TStubCreator.Destroy;
+begin
+ FreeAndNil(FWriteStream);
+ FreeAndNil(FOutputStream);
+ FreeAndNil(FHeaderStream);
+ FreeAndNil(FIncludePaths);
+ FreeAndNil(FDefines);
+ inherited Destroy;
+end;
+
+
+procedure TStubCreator.WriteModule(M : TPAsModule);
+
+Var
+ F,H : TStream;
+ W : TPasWriter;
+ U : String;
+
+begin
+ W:=Nil;
+ F:=MaybeGetFileStream(OutputStream,FOutputFile,fmCreate);
+ if (F=Nil) then
+ if FWriteStream<>nil then
+ F:=FWriteStream
+ else
+ F:=TIOStream.Create(iosOutPut);
+ try
+ H:=MaybeGetFileStream(HeaderStream,FHeaderFile,fmOpenRead or fmShareDenyWrite);
+ if Assigned(h) then
+ try
+ F.CopyFrom(H,H.Size);
+ finally
+ if H<>HeaderStream then
+ H.Free;
+ end;
+ W:=TPasWriter.Create(F);
+ W.Options:=FOptions;
+ U:=FExtraUnits;
+ if Pos(LowerCase(DTypesUnit),LowerCase(U)) = 0 then
+ begin
+ if (U<>'') then
+ U:=','+U;
+ U:=DTypesUnit+U;
+ end;
+ W.ExtraUnits:=U;
+ if FIndentSize<>-1 then
+ W.IndentSize:=FIndentSize;
+ if FLineNumberWidth>0 then
+ W.LineNumberWidth:=FLineNumberWidth;
+
+ W.ForwardClasses.CommaText:=FForwardClasses;
+ W.WriteModule(M);
+ if Assigned(FWriteStream) then
+ DoWriteEvent;
+ finally
+ W.Free;
+ if (F<>OutputStream) and (F<>FWriteStream) then
+ F.Free;
+ end;
+end;
+
+end.
+