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

* commited patch(-5) by Andrey Sobol from mantis #38153 .

Browse Source 
git-svn-id: trunk@47915 -
This commit is contained in:
marco 2020-12-30 20:37:24 +00:00
parent 7032cba91e
commit 4353d36516
4 changed files with 129 additions and 65 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
utils/fpdoc/dglobals.pp
View File

@ -23,7 +23,7 @@ unit dGlobals;
interface interface
uses Classes, DOM, PasTree, PParser, uriparser; uses Classes, DOM, PasTree, PParser, uriparser, SysUtils;
Const Const
CacheSize = 20; CacheSize = 20;
@ -343,9 +343,9 @@ type
constructor Create; constructor Create;
destructor Destroy; override; destructor Destroy; override;
procedure SetPackageName(const APackageName: String); procedure SetPackageName(const APackageName: String);
// process the import objects from external .xct file // The process importing of objects from external .xct file
procedure ReadContentFile(const AFilename, ALinkPrefix: String); procedure ReadContentFile(const AFilename, ALinkPrefix: String);
// creation of an own .xct output file // Creation of an own .xct output file
procedure WriteContentFile(const AFilename: String); procedure WriteContentFile(const AFilename: String);
function CreateElement(AClass: TPTreeElement; const AName: String; function CreateElement(AClass: TPTreeElement; const AName: String;
@ -385,6 +385,7 @@ type
procedure TranslateDocStrings(const Lang: String); procedure TranslateDocStrings(const Lang: String);
function DumpExceptionCallStack(E: Exception):String;
Function IsLinkNode(Node : TDomNode) : Boolean; Function IsLinkNode(Node : TDomNode) : Boolean;
Function IsExampleNode(Example : TDomNode) : Boolean; Function IsExampleNode(Example : TDomNode) : Boolean;
@ -395,7 +396,7 @@ Function IsLinkAbsolute(ALink: String): boolean;
implementation implementation
uses SysUtils, Gettext, XMLRead; uses Gettext, XMLRead;
const const
AbsoluteLinkPrefixes : array[0..2] of string = ('/', 'http://', 'ms-its:'); AbsoluteLinkPrefixes : array[0..2] of string = ('/', 'http://', 'ms-its:');
@ -1133,7 +1134,7 @@ begin
begin begin
for k:=0 to ClassLikeDecl.Interfaces.count-1 do for k:=0 to ClassLikeDecl.Interfaces.count-1 do
begin begin
write(contentfile,',',CheckImplicitLink(TPasClassType(ClassLikeDecl.Interfaces[k]).PathName)); write(contentfile,',',CheckImplicitLink(TPasType(ClassLikeDecl.Interfaces[k]).PathName));
if TPasElement(ClassLikeDecl.Interfaces[k]) is TPasAliasType then if TPasElement(ClassLikeDecl.Interfaces[k]) is TPasAliasType then
begin begin
alias:= TPasAliasType(ClassLikeDecl.Interfaces[k]); alias:= TPasAliasType(ClassLikeDecl.Interfaces[k]);
@ -1757,6 +1758,23 @@ begin
end; end;
end; end;
function DumpExceptionCallStack(E: Exception):String;
var
I: Integer;
Frames: PPointer;
begin
Result := 'Program exception! ' + LineEnding +
'Stacktrace:' + LineEnding + LineEnding;
if E <> nil then begin
Result := Result + 'Exception class: ' + E.ClassName + LineEnding +
'Message: ' + E.Message + LineEnding;
end;
Result := Result + BackTraceStrFunc(ExceptAddr);
Frames := ExceptFrames;
for I := 0 to ExceptFrameCount - 1 do
Result := Result + LineEnding + BackTraceStrFunc(Frames[I]);
end;
initialization initialization
LEOL:=Length(LineEnding); LEOL:=Length(LineEnding);
end. end.

93
utils/fpdoc/dw_chm.pp
View File

@ -3,7 +3,7 @@ unit dw_chm;
interface interface
uses Classes, DOM, DOM_HTML, uses Classes, DOM, DOM_HTML,
dGlobals, PasTree, dwriter, dw_html, ChmWriter, chmtypes; dGlobals, PasTree, dwriter, dw_html, chmwriter, chmtypes, chmsitemap;
type type
@ -34,8 +34,13 @@ type
FOtherFiles: String; FOtherFiles: String;
procedure ProcessOptions; procedure ProcessOptions;
function ResolveLinkIDAbs(const Name: String; Level : Integer = 0): DOMString; function ResolveLinkIDAbs(const Name: String; Level : Integer = 0): DOMString;
function RetrieveOtherFiles(const DataName: String; out PathInChm: String; out FileName: String; var Stream: TStream): Boolean; function RetrieveOtherFiles(const DataName: String; out PathInChm: String;
out FileName: String; var Stream: TStream): Boolean;
procedure LastFileAdded(Sender: TObject); procedure LastFileAdded(Sender: TObject);
function FindAlphaItem(AItems: TChmSiteMapItems; AName: String): TChmSiteMapItem;
function GetAlphaItem(AItems: TChmSiteMapItems; AName: String): TChmSiteMapItem;
procedure MultiAlphaItem(AItems: TChmSiteMapItems; AName: String;
APasEl: TPasElement; Prefix:String);
procedure GenerateTOC; procedure GenerateTOC;
procedure GenerateIndex; procedure GenerateIndex;
public public
@ -50,7 +55,7 @@ type
implementation implementation
uses SysUtils, HTMWrite, chmsitemap; uses SysUtils, HTMWrite;
{ TFpDocChmWriter } { TFpDocChmWriter }
@ -157,7 +162,8 @@ begin
Result := CompareText(LowerCase(Item1.Text), LowerCase(Item2.Text)); Result := CompareText(LowerCase(Item1.Text), LowerCase(Item2.Text));
end; end;
function GetAlphaItem(AItems: TChmSiteMapItems; AName: String): TChmSiteMapItem; function TCHMHTMLWriter.FindAlphaItem(AItems: TChmSiteMapItems; AName: String
): TChmSiteMapItem;
var var
x: Integer; x: Integer;
begin begin
@ -167,10 +173,39 @@ begin
if AItems.Item[x].Text = AName then if AItems.Item[x].Text = AName then
Exit(AItems.Item[x]); Exit(AItems.Item[x]);
end; end;
end;
function TCHMHTMLWriter.GetAlphaItem(AItems: TChmSiteMapItems; AName: String
): TChmSiteMapItem;
begin
Result := FindAlphaItem(AItems, AName);
if Result <> nil then Exit;
Result := AItems.NewItem; Result := AItems.NewItem;
Result.Text := AName; Result.Text := AName;
end; end;
procedure TCHMHTMLWriter.MultiAlphaItem(AItems: TChmSiteMapItems; AName: String;
APasEl: TPasElement; Prefix: String);
var
AChmItem, AChmChld: TChmSiteMapItem;
begin
AChmItem:= FindAlphaItem(AItems, AName);
if AChmItem = nil then
begin
// add new
AChmItem := AItems.NewItem;
AChmItem.Text := AName;
AChmItem.addLocal(FixHTMLpath(Allocator.GetFilename(APasEl, 0)));
end
else
begin
// add as child
AChmChld := AChmItem.Children.NewItem;
AChmChld.Text := Prefix + '.' + AName;
AChmChld.addLocal(FixHTMLpath(Allocator.GetFilename(APasEl, 0)));
end;
end;
procedure TCHMHTMLWriter.GenerateTOC; procedure TCHMHTMLWriter.GenerateTOC;
var var
TOC: TChmSiteMap; TOC: TChmSiteMap;
@ -279,20 +314,26 @@ begin
fchm.AppendTOC(Stream); fchm.AppendTOC(Stream);
Stream.Free; Stream.Free;
DoLog('Generating TOC done');
end; end;
type type
TClassMemberType = (cmtProcedure, cmtFunction, cmtConstructor, cmtDestructor, TClassMemberType = (cmtProcedure, cmtFunction, cmtConstructor, cmtDestructor,
cmtInterface, cmtProperty, cmtVariable, cmtUnknown); cmtInterface, cmtProperty, cmtVariable, cmtOperator, cmtConstant, cmtUnknown);
function ElementType(Element: TPasElement): TClassMemberType; function ElementType(Element: TPasElement): TClassMemberType;
var var
ETypeName: String; ETypeName: String;
begin begin
Result := cmtUnknown; Result := cmtUnknown;
if not Assigned(Element) then Exit;
ETypeName := Element.ElementTypeName; ETypeName := Element.ElementTypeName;
//overloaded we don't care if Length(ETypeName) = 0 then Exit;
if ETypeName[1] = 'o' then ETypeName := Copy(ETypeName, 11, Length(ETypeName)); // opearator
if ETypeName[2] = 'p' then Exit(cmtOperator);
if ETypeName[3] = 'n' then Exit(cmtConstant);
// overloaded we don't care
if ETypeName[1] = 'o' then ETypeName := Copy(ETypeName, 12, Length(ETypeName));
if ETypeName[1] = 'f' then Exit(cmtFunction); if ETypeName[1] = 'f' then Exit(cmtFunction);
if ETypeName[1] = 'c' then Exit(cmtConstructor); if ETypeName[1] = 'c' then Exit(cmtConstructor);
@ -301,7 +342,8 @@ begin
// the p's // the p's
if ETypeName[4] = 'c' then Exit(cmtProcedure); if ETypeName[4] = 'c' then Exit(cmtProcedure);
if ETypeName[4] = 'p' then Exit(cmtProperty); if ETypeName[4] = 'p' then Exit(cmtProperty);
// Unknown
// WriteLn(' Warning El name: '+ Element.Name+' path: '+Element.PathName+' TypeName: '+Element.ElementTypeName);
end; end;
procedure TCHMHTMLWriter.GenerateIndex; procedure TCHMHTMLWriter.GenerateIndex;
@ -315,7 +357,7 @@ var
ParentElement: TPasElement; ParentElement: TPasElement;
MemberItem: TChmSiteMapItem; MemberItem: TChmSiteMapItem;
Stream: TMemoryStream; Stream: TMemoryStream;
RedirectUrl,Urls: String; RedirectUrl,Urls,SName: String;
begin begin
DoLog('Generating Index...'); DoLog('Generating Index...');
@ -356,7 +398,7 @@ begin
if(trim(RedirectUrl)<>'') and (RedirectUrl<>urls) then if(trim(RedirectUrl)<>'') and (RedirectUrl<>urls) then
begin begin
writeln('Hint: Index Resolved:',urls,' to ',RedirectUrl); //writeln('Hint: Index Resolved:',urls,' to ',RedirectUrl);
urls:=RedirectUrl; urls:=RedirectUrl;
end; end;
@ -369,6 +411,8 @@ begin
cmtProperty : TmpItem.Text := TmpElement.Name + ' property'; cmtProperty : TmpItem.Text := TmpElement.Name + ' property';
cmtVariable : TmpItem.Text := TmpElement.Name + ' variable'; cmtVariable : TmpItem.Text := TmpElement.Name + ' variable';
cmtInterface : TmpItem.Text := TmpElement.Name + ' interface'; cmtInterface : TmpItem.Text := TmpElement.Name + ' interface';
cmtOperator : TmpItem.Text := TmpElement.Name + ' operator';
cmtConstant : TmpItem.Text := TmpElement.Name + ' const';
cmtUnknown : TmpItem.Text := TmpElement.Name; cmtUnknown : TmpItem.Text := TmpElement.Name;
end; end;
TmpItem.addLocal(Urls); TmpItem.addLocal(Urls);
@ -389,18 +433,24 @@ begin
// routines // routines
for j := 0 to AModule.InterfaceSection.Functions.Count-1 do for j := 0 to AModule.InterfaceSection.Functions.Count-1 do
begin begin
ParentElement := TPasProcedureType(AModule.InterfaceSection.Functions[j]); // routine name
TmpItem := Index.Items.NewItem; ParentElement := TPasElement(AModule.InterfaceSection.Functions[j]);
TmpItem.Text := ParentElement.Name + ' ' + ParentElement.ElementTypeName; case ElementType(ParentElement) of
TmpItem.addLocal(FixHTMLpath(Allocator.GetFilename(ParentElement, 0))); cmtProcedure : SName:= ' procedure';
cmtFunction : SName:= ' function';
cmtOperator : SName:= ' operator';
//cmtConstant : SName:= ' const';
else SName:= ' unknown'
end;
SName:= ParentElement.Name + ' ' + SName;
MultiAlphaItem(Index.Items, SName, ParentElement, AModule.Name);
end; end;
// consts // consts
for j := 0 to AModule.InterfaceSection.Consts.Count-1 do for j := 0 to AModule.InterfaceSection.Consts.Count-1 do
begin begin
ParentElement := TPasElement(AModule.InterfaceSection.Consts[j]); ParentElement := TPasElement(AModule.InterfaceSection.Consts[j]);
TmpItem := Index.Items.NewItem; SName:= ParentElement.Name + ' const';
TmpItem.Text := ParentElement.Name; MultiAlphaItem(Index.Items, SName, ParentElement, AModule.Name);
TmpItem.addLocal(FixHTMLpath(Allocator.GetFilename(ParentElement, 0)));
end; end;
// types // types
for j := 0 to AModule.InterfaceSection.Types.Count-1 do for j := 0 to AModule.InterfaceSection.Types.Count-1 do
@ -431,9 +481,8 @@ begin
for j := 0 to AModule.InterfaceSection.Variables.Count-1 do for j := 0 to AModule.InterfaceSection.Variables.Count-1 do
begin begin
ParentElement := TPasElement(AModule.InterfaceSection.Variables[j]); ParentElement := TPasElement(AModule.InterfaceSection.Variables[j]);
TmpItem := Index.Items.NewItem; SName:= ParentElement.Name + ' variable';
TmpItem.Text := ParentElement.Name + ' var'; MultiAlphaItem(Index.Items, SName, ParentElement, AModule.Name);
TmpItem.addLocal(FixHTMLpath(Allocator.GetFilename(ParentElement, 0)));
end; end;
// declarations // declarations
{ {
@ -471,6 +520,7 @@ begin
FChm.AppendIndex(Stream); FChm.AppendIndex(Stream);
Stream.Free; Stream.Free;
end; end;
DoLog('Generating Index Done');
end; end;
procedure TCHMHTMLWriter.WriteHTMLPages; procedure TCHMHTMLWriter.WriteHTMLPages;
@ -548,6 +598,7 @@ begin
FChm.Execute; FChm.Execute;
FChm.Free; FChm.Free;
DoLog('Collecting done');
// we don't need to free FTempUncompressed // we don't need to free FTempUncompressed
// FTempUncompressed.Free; // FTempUncompressed.Free;
FOutChm.Free; FOutChm.Free;

60
utils/fpdoc/dw_html.pp
View File

@ -53,6 +53,8 @@ type
function GetCSSFilename(ARelativeTo: TPasElement): DOMString; virtual; function GetCSSFilename(ARelativeTo: TPasElement): DOMString; virtual;
end; end;
{ TLongNameFileAllocator }
TLongNameFileAllocator = class(TFileAllocator) TLongNameFileAllocator = class(TFileAllocator)
private private
FExtension: String; FExtension: String;
@ -255,7 +257,6 @@ type
// Start producing html complete package documentation // Start producing html complete package documentation
procedure WriteHTMLPages; virtual; procedure WriteHTMLPages; virtual;
procedure WriteXHTMLPages; procedure WriteXHTMLPages;
function ModuleForElement(AnElement:TPasElement):TPasModule;
Function InterPretOption(Const Cmd,Arg : String) : boolean; override; Function InterPretOption(Const Cmd,Arg : String) : boolean; override;
Procedure WriteDoc; override; Procedure WriteDoc; override;
@ -276,7 +277,6 @@ type
Property ImageFileList : TStrings Read FImageFileList; Property ImageFileList : TStrings Read FImageFileList;
end; end;
Function FixHTMLpath(S : String) : STring; Function FixHTMLpath(S : String) : STring;
implementation implementation
@ -310,7 +310,6 @@ begin
end; end;
constructor TLongNameFileAllocator.Create(const AExtension: String); constructor TLongNameFileAllocator.Create(const AExtension: String);
begin begin
inherited Create; inherited Create;
@ -331,12 +330,12 @@ begin
Result := 'index'; Result := 'index';
excl := True; excl := True;
end end
else if AElement.ClassType = TPasModule then else if AElement.ClassType = TPasModule then
begin begin
Result := LowerCase(AElement.Name) + PathDelim + 'index'; Result := LowerCase(AElement.Name) + PathDelim + 'index';
excl := True; excl := True;
end end
else else
begin begin
if AElement is TPasOperator then if AElement is TPasOperator then
begin begin
@ -371,9 +370,11 @@ begin
excl := (ASubindex > 0); excl := (ASubindex > 0);
end; end;
// searching for TPasModule - it is on the 2nd level // searching for TPasModule - it is on the 2nd level
if Assigned(AElement.Parent) then if AElement.GetModule <> nil then
while Assigned(AElement.Parent.Parent) do AElement := AElement.GetModule
AElement := AElement.Parent; else
Raise EFPDocWriterError.Create(
'TLongNameFileAllocator error: Unresolved module name for element: ' +AElement.PathName);
// cut off Package Name // cut off Package Name
Result := Copy(Result, Length(AElement.Parent.Name) + 2, MaxInt); Result := Copy(Result, Length(AElement.Parent.Name) + 2, MaxInt);
// to skip dots in unit name // to skip dots in unit name
@ -834,15 +835,6 @@ begin
end; end;
end; end;
function THTMLWriter.ModuleForElement(AnElement:TPasElement):TPasModule;
begin
result:=TPasModule(AnElement);
while assigned(result) and not (result is TPasModule) do
result:=TPasModule(result.parent);
if not (result is TPasModule) then
result:=nil;
end;
procedure THTMLWriter.CreateCSSFile; procedure THTMLWriter.CreateCSSFile;
@ -1691,7 +1683,7 @@ begin
end else end else
begin begin
Result := nil; Result := nil;
AppendText(Parent, Element.Name); AppendText(Parent, Element.Name); // unresolved items
end; end;
end else end else
begin begin
@ -2294,7 +2286,7 @@ begin
else else
AppendText(NewEl,El['id']); AppendText(NewEl,El['id']);
l:=El['id']; l:=El['id'];
DescrEl := Engine.FindShortDescr(ModuleForElement(AElement),UTF8Encode(L)); DescrEl := Engine.FindShortDescr(AElement.GetModule,UTF8Encode(L));
if Assigned(DescrEl) then if Assigned(DescrEl) then
begin begin
AppendNbSp(CreatePara(CreateTD(TREl)), 2); AppendNbSp(CreatePara(CreateTD(TREl)), 2);
@ -2494,7 +2486,7 @@ type
if (PE<>Nil) then if (PE<>Nil) then
begin begin
AppendHyperLink(CurOutputNode,PE); AppendHyperLink(CurOutputNode,PE);
PM:=ModuleForElement(PE); PM:=PE.GetModule();
if (PM<>Nil) then if (PM<>Nil) then
begin begin
AppendText(CurOutputNode,' ('); AppendText(CurOutputNode,' (');
@ -3157,7 +3149,7 @@ var
i: Integer; i: Integer;
s: String; s: String;
t : TPasType; t : TPasType;
ah,ol,wt,ct,wc,cc : boolean; ah,ol,wt,ct,wc,cc : boolean;
isRecord : Boolean; isRecord : Boolean;
begin begin
@ -3172,30 +3164,24 @@ begin
begin begin
Member := TPasElement(Members[i]); Member := TPasElement(Members[i]);
MVisibility:=Member.Visibility; MVisibility:=Member.Visibility;
cc:=(Member is TPasConst);
ct:=(Member is TPasType);
ol:=(Member is TPasOverloadedProc); ol:=(Member is TPasOverloadedProc);
ah:=ol or ((Member is TPasProcedure) and (TPasProcedure(Member).ProcType.Args.Count > 0)); ah:=ol or ((Member is TPasProcedure) and (TPasProcedure(Member).ProcType.Args.Count > 0));
if ol then if ol then
Member:=TPasElement((Member as TPasOverloadedProc).Overloads[0]); Member:=TPasElement((Member as TPasOverloadedProc).Overloads[0]);
if Not Engine.ShowElement(Member) then if Not Engine.ShowElement(Member) then
continue; continue;
if (CurVisibility <> MVisibility) then if (CurVisibility <> MVisibility) or (cc <> wc) or (ct <> wt) then
begin begin
CurVisibility := MVisibility; CurVisibility := MVisibility;
wc:=cc;
wt:=ct;
s:=VisibilityNames[MVisibility]; s:=VisibilityNames[MVisibility];
AppendKw(CreateCode(CreatePara(CreateTD(CreateTR(TableEl)))), UTF8Decode(s)); AppendKw(CreateCode(CreatePara(CreateTD(CreateTR(TableEl)))), UTF8Decode(s));
if (ct) then AppendKw(CreateCode(CreatePara(CreateTD(CreateTR(TableEl)))), 'type');
if (cc) then AppendKw(CreateCode(CreatePara(CreateTD(CreateTR(TableEl)))), 'const');
end; end;
ct:=(Member is TPasType);
if ct and (not wt) then
begin
AppendKw(CreateCode(CreatePara(CreateTD(CreateTR(TableEl)))), 'Type');
end;
wt:=ct;
cc:=(Member is TPasConst);
if cc and (not wc) then
begin
AppendKw(CreateCode(CreatePara(CreateTD(CreateTR(TableEl)))), 'Const');
end;
wc:=cc;
TREl := CreateTR(TableEl); TREl := CreateTR(TableEl);
CodeEl := CreateCode(CreatePara(CreateTD_vtop(TREl))); CodeEl := CreateCode(CreatePara(CreateTD_vtop(TREl)));
AppendNbSp(CodeEl, 2); AppendNbSp(CodeEl, 2);
@ -3218,7 +3204,7 @@ begin
If Assigned(TPasConst(Member).VarType) then If Assigned(TPasConst(Member).VarType) then
begin begin
AppendSym(CodeEl, ' = '); AppendSym(CodeEl, ' = ');
AppendTypeDecl(TPasType(Member),TableEl,CodeEl); AppendTypeDecl(TPasType(TPasConst(Member).VarType),TableEl,CodeEl);
end; end;
AppendSym(CodeEl, ' = '); AppendSym(CodeEl, ' = ');
AppendText(CodeEl,UTF8Decode(TPasConst(Member).Expr.GetDeclaration(True))); AppendText(CodeEl,UTF8Decode(TPasConst(Member).Expr.GetDeclaration(True)));
@ -3270,7 +3256,7 @@ begin
else else
AppendText(CodeEl, UTF8Decode(Member.Name)); AppendText(CodeEl, UTF8Decode(Member.Name));
AppendSym(CodeEl, ': '); AppendSym(CodeEl, ': ');
AppendHyperlink(CodeEl, TPasVariable(Member).VarType); AppendType(CodeEl, TableEl, TPasVariable(Member).VarType,False);
AppendSym(CodeEl, ';'); AppendSym(CodeEl, ';');
end end
else else
@ -3490,6 +3476,7 @@ var
AppendText(ParaEl, 'pt'); AppendText(ParaEl, 'pt');
visPublished: visPublished:
AppendText(ParaEl, 'pl'); AppendText(ParaEl, 'pl');
else
end; end;
AppendNbSp(ParaEl, 1); AppendNbSp(ParaEl, 1);
@ -3558,6 +3545,7 @@ var
AppendText(ParaEl, 'pt'); AppendText(ParaEl, 'pt');
visPublished: visPublished:
AppendText(ParaEl, 'pl'); AppendText(ParaEl, 'pl');
else
end; end;
AppendNbSp(ParaEl, 1); AppendNbSp(ParaEl, 1);

13
utils/fpdoc/fpdoc.pp
View File

@ -55,8 +55,9 @@ Type
procedure OutputLog(Sender: TObject; const Msg: String); procedure OutputLog(Sender: TObject; const Msg: String);
procedure ParseCommandLine; procedure ParseCommandLine;
procedure ParseOption(const S: String); procedure ParseOption(const S: String);
Procedure Usage(AnExitCode : Byte); procedure Usage(AnExitCode : Byte);
Procedure DoRun; override; procedure ExceptProc(Sender: TObject; E: Exception);
procedure DoRun; override;
Public Public
Constructor Create(AOwner : TComponent); override; Constructor Create(AOwner : TComponent); override;
Destructor Destroy; override; Destructor Destroy; override;
@ -64,7 +65,7 @@ Type
end; end;
Procedure TFPDocApplication.Usage(AnExitCode : Byte); procedure TFPDocApplication.Usage(AnExitCode: Byte);
Var Var
I,P : Integer; I,P : Integer;
@ -148,6 +149,11 @@ begin
Halt(AnExitCode); Halt(AnExitCode);
end; end;
procedure TFPDocApplication.ExceptProc(Sender: TObject; E: Exception);
begin
OutputLog(Sender, DumpExceptionCallStack(E));
end;
destructor TFPDocApplication.Destroy; destructor TFPDocApplication.Destroy;
begin begin
@ -427,6 +433,7 @@ begin
StopOnException:=true; StopOnException:=true;
FCreator:=TFPDocCreator.Create(Self); FCreator:=TFPDocCreator.Create(Self);
FCreator.OnLog:=@OutputLog; FCreator.OnLog:=@OutputLog;
OnException:= @ExceptProc;
end; end;
begin begin