* Write class local consts and types in correct way

git-svn-id: trunk@22151 -
This commit is contained in:
michael 2012-08-20 22:26:57 +00:00
parent 9d528c65e3
commit 74624a0c37
2 changed files with 245 additions and 145 deletions

View File

@ -88,6 +88,7 @@ type
FOnTest: TNotifyEvent; FOnTest: TNotifyEvent;
FPackage: TPasPackage; FPackage: TPasPackage;
FCharSet : String; FCharSet : String;
procedure AppendTypeDecl(AType: TPasType; TableEl, CodeEl: TDomElement);
function GetPageCount: Integer; function GetPageCount: Integer;
procedure SetOnTest(const AValue: TNotifyEvent); procedure SetOnTest(const AValue: TNotifyEvent);
protected protected
@ -260,6 +261,7 @@ type
Procedure WriteDoc; override; Procedure WriteDoc; override;
Class Function FileNameExtension : String; override; Class Function FileNameExtension : String; override;
class procedure Usage(List: TStrings); override; class procedure Usage(List: TStrings); override;
Class procedure SplitImport(var AFilename, ALinkPrefix: String); override;
Property SearchPage: String Read FSearchPage Write FSearchPage; Property SearchPage: String Read FSearchPage Write FSearchPage;
property Allocator: TFileAllocator read FAllocator; property Allocator: TFileAllocator read FAllocator;
property Package: TPasPackage read FPackage; property Package: TPasPackage read FPackage;
@ -2713,6 +2715,114 @@ begin
FinishElementPage(AConst); FinishElementPage(AConst);
end; end;
procedure THTMLWriter.AppendTypeDecl(AType: TPasType; TableEl,CodeEl : TDomElement);
Var
TREl : TDomElement;
i: Integer;
s: String;
EnumType: TPasEnumType;
EnumValue: TPasEnumValue;
Variable: TPasVariable;
begin
// Alias
if AType.ClassType = TPasAliasType then
begin
if Assigned(TPasAliasType(AType).DestType) then
AppendHyperlink(CodeEl, TPasAliasType(AType).DestType)
else
AppendText(CreateWarning(CodeEl), '<Destination type is NIL>');
AppendSym(CodeEl, ';');
end else
// Class of
if AType.ClassType = TPasClassOfType then
begin
AppendKw(CodeEl, 'class of ');
AppendHyperlink(CodeEl, TPasClassOfType(AType).DestType);
AppendSym(CodeEl, ';');
end else
// Enumeration
if AType.ClassType = TPasEnumType then
begin
AppendSym(CodeEl, '(');
for i := 0 to TPasEnumType(AType).Values.Count - 1 do
begin
EnumValue := TPasEnumValue(TPasEnumType(AType).Values[i]);
TREl := CreateTR(TableEl);
CodeEl := CreateCode(CreatePara(CreateTD_vtop(TREl)));
AppendShortDescrCell(TREl, EnumValue);
AppendNbSp(CodeEl, 2);
s := EnumValue.Name;
if EnumValue.AssignedValue<>'' then
s := s + ' = ' + EnumValue.AssignedValue;
if i < TPasEnumType(AType).Values.Count - 1 then
s := s + ',';
AppendPasSHFragment(CodeEl, s, 0);
end;
AppendSym(CreateCode(CreatePara(CreateTD(CreateTR(TableEl)))), ');');
end else
// Pointer type
if AType.ClassType = TPasPointerType then
begin
AppendSym(CodeEl, '^');
if Assigned(TPasPointerType(AType).DestType) then
AppendHyperlink(CodeEl, TPasPointerType(AType).DestType)
else
AppendText(CreateWarning(CodeEl), '<Destination type is NIL>');
AppendSym(CodeEl, ';');
end else
if AType.InheritsFrom(TPasProcedureType) then
begin
AppendSym(AppendType(CodeEl, TableEl, TPasType(AType), True), ';');
AppendProcArgsSection(BodyElement, TPasProcedureType(AType));
end else
// Record
if AType.ClassType = TPasRecordType then
begin
CodeEl := AppendRecordType(CodeEl, TableEl, TPasRecordType(AType), 0);
AppendSym(CodeEl, ';');
end else
// Set
if AType.ClassType = TPasSetType then
begin
AppendKw(CodeEl, 'set of ');
if TPasSetType(AType).EnumType.ClassType = TPasEnumType then
begin
AppendSym(CodeEl, '(');
EnumType := TPasEnumType(TPasSetType(AType).EnumType);
for i := 0 to EnumType.Values.Count - 1 do
begin
EnumValue := TPasEnumValue(EnumType.Values[i]);
TREl := CreateTR(TableEl);
CodeEl := CreateCode(CreatePara(CreateTD_vtop(TREl)));
AppendShortDescrCell(TREl, EnumValue);
AppendNbSp(CodeEl, 2);
s := EnumValue.Name;
if (EnumValue.AssignedValue<>'') then
s := s + ' = ' + EnumValue.AssignedValue;
if i < EnumType.Values.Count - 1 then
s := s + ',';
AppendPasSHFragment(CodeEl, s, 0);
end;
AppendSym(CreateCode(CreatePara(CreateTD(CreateTR(TableEl)))), ');');
end else
begin
AppendHyperlink(CodeEl, TPasSetType(AType).EnumType);
AppendSym(CodeEl, ';');
end;
end else
// Type alias
if AType.ClassType = TPasTypeAliasType then
begin
AppendKw(CodeEl, 'type ');
AppendHyperlink(CodeEl, TPasTypeAliasType(AType).DestType);
AppendSym(CodeEl, ';');
end else
// Probably one of the simple types, which allowed in other places as wel...
AppendSym(AppendType(CodeEl, TableEl, TPasType(AType), True), ';');
end;
procedure THTMLWriter.CreateTypePageBody(AType: TPasType); procedure THTMLWriter.CreateTypePageBody(AType: TPasType);
var var
TableEl, TREl, TDEl, CodeEl: TDOMElement; TableEl, TREl, TDEl, CodeEl: TDOMElement;
@ -2745,101 +2855,7 @@ begin
AppendText(CodeEl,SDocOpaque) AppendText(CodeEl,SDocOpaque)
else else
begin begin
// Alias AppendTypeDecl(AType,TableEl,CodeEl);
if AType.ClassType = TPasAliasType then
begin
if Assigned(TPasAliasType(AType).DestType) then
AppendHyperlink(CodeEl, TPasAliasType(AType).DestType)
else
AppendText(CreateWarning(CodeEl), '<Destination type is NIL>');
AppendSym(CodeEl, ';');
end else
// Class of
if AType.ClassType = TPasClassOfType then
begin
AppendKw(CodeEl, 'class of ');
AppendHyperlink(CodeEl, TPasClassOfType(AType).DestType);
AppendSym(CodeEl, ';');
end else
// Enumeration
if AType.ClassType = TPasEnumType then
begin
AppendSym(CodeEl, '(');
for i := 0 to TPasEnumType(AType).Values.Count - 1 do
begin
EnumValue := TPasEnumValue(TPasEnumType(AType).Values[i]);
TREl := CreateTR(TableEl);
CodeEl := CreateCode(CreatePara(CreateTD_vtop(TREl)));
AppendShortDescrCell(TREl, EnumValue);
AppendNbSp(CodeEl, 2);
s := EnumValue.Name;
if EnumValue.AssignedValue<>'' then
s := s + ' = ' + EnumValue.AssignedValue;
if i < TPasEnumType(AType).Values.Count - 1 then
s := s + ',';
AppendPasSHFragment(CodeEl, s, 0);
end;
AppendSym(CreateCode(CreatePara(CreateTD(CreateTR(TableEl)))), ');');
end else
// Pointer type
if AType.ClassType = TPasPointerType then
begin
AppendSym(CodeEl, '^');
if Assigned(TPasPointerType(AType).DestType) then
AppendHyperlink(CodeEl, TPasPointerType(AType).DestType)
else
AppendText(CreateWarning(CodeEl), '<Destination type is NIL>');
AppendSym(CodeEl, ';');
end else
if AType.InheritsFrom(TPasProcedureType) then
begin
AppendSym(AppendType(CodeEl, TableEl, TPasType(AType), True), ';');
AppendProcArgsSection(BodyElement, TPasProcedureType(AType));
end else
// Record
if AType.ClassType = TPasRecordType then
begin
CodeEl := AppendRecordType(CodeEl, TableEl, TPasRecordType(AType), 0);
AppendSym(CodeEl, ';');
end else
// Set
if AType.ClassType = TPasSetType then
begin
AppendKw(CodeEl, 'set of ');
if TPasSetType(AType).EnumType.ClassType = TPasEnumType then
begin
AppendSym(CodeEl, '(');
EnumType := TPasEnumType(TPasSetType(AType).EnumType);
for i := 0 to EnumType.Values.Count - 1 do
begin
EnumValue := TPasEnumValue(EnumType.Values[i]);
TREl := CreateTR(TableEl);
CodeEl := CreateCode(CreatePara(CreateTD_vtop(TREl)));
AppendShortDescrCell(TREl, EnumValue);
AppendNbSp(CodeEl, 2);
s := EnumValue.Name;
if (EnumValue.AssignedValue<>'') then
s := s + ' = ' + EnumValue.AssignedValue;
if i < EnumType.Values.Count - 1 then
s := s + ',';
AppendPasSHFragment(CodeEl, s, 0);
end;
AppendSym(CreateCode(CreatePara(CreateTD(CreateTR(TableEl)))), ');');
end else
begin
AppendHyperlink(CodeEl, TPasSetType(AType).EnumType);
AppendSym(CodeEl, ';');
end;
end else
// Type alias
if AType.ClassType = TPasTypeAliasType then
begin
AppendKw(CodeEl, 'type ');
AppendHyperlink(CodeEl, TPasTypeAliasType(AType).DestType);
AppendSym(CodeEl, ';');
end else
// Probably one of the simple types, which allowed in other places as wel...
AppendSym(AppendType(CodeEl, TableEl, TPasType(AType), True), ';');
end; end;
FinishElementPage(AType); FinishElementPage(AType);
end; end;
@ -2917,9 +2933,11 @@ var
TableEl, TREl, TDEl, CodeEl: TDOMElement; TableEl, TREl, TDEl, CodeEl: TDOMElement;
DocNode: TDocNode; DocNode: TDocNode;
Member: TPasElement; Member: TPasElement;
MVisibility,
CurVisibility: TPasMemberVisibility; CurVisibility: TPasMemberVisibility;
i: Integer; i: Integer;
s: String; s: String;
ah,ol,wt,ct,wc,cc : boolean;
ThisInterface, ThisInterface,
ThisClass: TPasClassType; ThisClass: TPasClassType;
HaveSeenTObject: Boolean; HaveSeenTObject: Boolean;
@ -2976,58 +2994,82 @@ var
AppendSym(CodeEl, ')'); AppendSym(CodeEl, ')');
end; end;
end; end;
if AClass.Members.Count > 0 then if AClass.Members.Count > 0 then
begin begin
wt:=False;
wc:=False;
CurVisibility := visDefault; CurVisibility := visDefault;
for i := 0 to AClass.Members.Count - 1 do for i := 0 to AClass.Members.Count - 1 do
begin
Member := TPasElement(AClass.Members[i]);
if CurVisibility <> Member.Visibility then
begin begin
CurVisibility := Member.Visibility; Member := TPasElement(AClass.Members[i]);
if ((CurVisibility = visPrivate) and Engine.HidePrivate) or MVisibility:=Member.Visibility;
((CurVisibility = visProtected) and Engine.HideProtected) then ol:=(Member is TPasOverloadedProc);
continue; ah:=ol or ((Member is TPasProcedure) and (TPasProcedure(Member).ProcType.Args.Count > 0));
case CurVisibility of if ol then
visPrivate: s := 'private'; Member:=TPasElement((Member as TPasOverloadedProc).Overloads[0]);
visProtected: s := 'protected'; if ((MVisibility = visPrivate) and Engine.HidePrivate) or
visPublic: s := 'public'; ( (MVisibility = visProtected) and Engine.HideProtected) then
visPublished: s := 'published'; continue;
visAutomated: s := 'automated'; if (CurVisibility <> MVisibility) then
end; begin
CurVisibility := MVisibility;
s:=VisibilityNames[MVisibility];
AppendKw(CreateCode(CreatePara(CreateTD(CreateTR(TableEl)))), s); AppendKw(CreateCode(CreatePara(CreateTD(CreateTR(TableEl)))), s);
end else end;
if ((CurVisibility = visPrivate) and Engine.HidePrivate) or ct:=(Member is TPasType);
((CurVisibility = visProtected) and Engine.HideProtected) then if ct and (not wt) then
continue; 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);
AppendShortDescrCell(TREl, Member); AppendShortDescrCell(TREl, Member);
if Member.InheritsFrom(TPasProcedureBase) then if (Member is TPasProcedureBase) then
begin begin
AppendKw(CodeEl, TPasProcedureBase(Member).TypeName + ' '); AppendKw(CodeEl, TPasProcedureBase(Member).TypeName + ' ');
AppendHyperlink(CodeEl, Member); AppendHyperlink(CodeEl, Member);
if (Member.ClassType = TPasOverloadedProc) or if ah then
(TPasProcedure(Member).ProcType.Args.Count > 0) then
AppendSym(CodeEl, '();') AppendSym(CodeEl, '();')
else else
AppendSym(CodeEl, ';'); AppendSym(CodeEl, ';');
if Member.ClassType <> TPasOverloadedProc then if Not OL then
AppendProcExt(CodeEl, TPasProcedure(Member)); AppendProcExt(CodeEl, TPasProcedure(Member));
end else end
if Member.ClassType = TPasVariable then else if (Member is TPasConst) then
begin begin
AppendHyperlink(CodeEl, Member);
If Assigned(TPasConst(Member).VarType) then
begin
AppendSym(CodeEl, ' = ');
AppendTypeDecl(TPasType(Member),TableEl,CodeEl);
end;
AppendSym(CodeEl, ' = ');
AppendText(CodeEl,TPasConst(Member).Expr.GetDeclaration(True));
end
else if (Member is TPasVariable) then
begin
AppendHyperlink(CodeEl, Member); AppendHyperlink(CodeEl, Member);
AppendSym(CodeEl, ': '); AppendSym(CodeEl, ': ');
AppendHyperlink(CodeEl, TPasVariable(Member).VarType); AppendHyperlink(CodeEl, TPasVariable(Member).VarType);
AppendSym(CodeEl, ';'); AppendSym(CodeEl, ';');
end else end
if Member.ClassType = TPasProperty then else if (Member is TPasType) then
begin begin
AppendHyperlink(CodeEl, Member);
AppendSym(CodeEl, ' = ');
AppendTypeDecl(TPasType(Member),TableEl,CodeEl);
end
else if (Member is TPasProperty) then
begin
AppendKw(CodeEl, 'property '); AppendKw(CodeEl, 'property ');
AppendHyperlink(CodeEl, Member); AppendHyperlink(CodeEl, Member);
if Assigned(TPasProperty(Member).VarType) then if Assigned(TPasProperty(Member).VarType) then
@ -3056,7 +3098,8 @@ var
s := s + 's'; s := s + 's';
if Length(s) > 0 then if Length(s) > 0 then
AppendText(CodeEl, ' [' + s + ']'); AppendText(CodeEl, ' [' + s + ']');
end else end
else
AppendText(CreateWarning(CodeEl), '<' + Member.ClassName + '>'); AppendText(CreateWarning(CodeEl), '<' + Member.ClassName + '>');
end; end;
@ -3297,11 +3340,35 @@ var
AppendText(CodeEl, Element.Name); AppendText(CodeEl, Element.Name);
if Assigned(Element.VarType) then if Assigned(Element.VarType) then
begin begin
AppendSym(CodeEl, ': '); AppendSym(CodeEl, ' : ');
AppendSym(AppendType(CodeEl, TableEl, Element.VarType, False), ';'); AppendSym(AppendType(CodeEl, TableEl, Element.VarType, False), ';');
end; end;
end; end;
procedure CreateTypePage(Element: TPasType);
begin
AppendKw(CodeEl, 'type ');
AppendHyperlink(CodeEl, Element.Parent);
AppendSym(CodeEl, '.');
AppendText(CodeEl, Element.Name);
AppendSym(CodeEl, ' = ');
AppendTypeDecl(Element,TableEl,CodeEl)
end;
procedure CreateConstPage(Element: TPasConst);
begin
AppendKw(CodeEl, 'const ');
AppendHyperlink(CodeEl, Element.Parent);
AppendSym(CodeEl, '.');
AppendText(CodeEl, Element.Name);
if Assigned(Element.VarType) then
begin
AppendSym(CodeEl, ': ');
AppendType(CodeEl, TableEl, Element.VarType, False);
end;
AppendPasSHFragment(CodeEl, ' = ' + Element.Expr.GetDeclaration(True) + ';', 0);
end;
procedure CreatePropertyPage(Element: TPasProperty); procedure CreatePropertyPage(Element: TPasProperty);
var var
NeedBreak: Boolean; NeedBreak: Boolean;
@ -3312,7 +3379,7 @@ var
AppendText(CodeEl, Element.Name); AppendText(CodeEl, Element.Name);
if Assigned(Element.VarType) then if Assigned(Element.VarType) then
begin begin
AppendSym(CodeEl, ': '); AppendSym(CodeEl, ' : ');
AppendType(CodeEl, TableEl, Element.VarType, False); AppendType(CodeEl, TableEl, Element.VarType, False);
end; end;
@ -3390,24 +3457,23 @@ begin
CodeEl := CreateCode(CreatePara(CreateTD(TREl))); CodeEl := CreateCode(CreatePara(CreateTD(TREl)));
AppendText(CodeEl, ' '); // !!!: Workaround for current HTML writer AppendText(CodeEl, ' '); // !!!: Workaround for current HTML writer
case AElement.Visibility of if (AElement.Visibility<>visDefault) then
visPrivate: s := 'private'; begin
visProtected: s := 'protected'; s:=VisibilityNames[AElement.Visibility];
visPublic: s := 'public';
visPublished: s := 'published';
visAutomated: s := 'automated';
else s := '';
end;
if Length(s) > 0 then
AppendKw(CodeEl, s); AppendKw(CodeEl, s);
end;
AppendText(CodeEl, ' '); AppendText(CodeEl, ' ');
if AElement.ClassType = TPasVariable then if AElement is TPasProperty then
CreateVarPage(TPasVariable(AElement))
else if AElement.InheritsFrom(TPasProcedureBase) then
AppendProcDecl(CodeEl, TableEl, TPasProcedureBase(AElement))
else if AElement.ClassType = TPasProperty then
CreatePropertyPage(TPasProperty(AElement)) CreatePropertyPage(TPasProperty(AElement))
else if AElement is TPasConst then
CreateConstPage(TPasConst(AElement))
else if (AElement is TPasVariable) then
CreateVarPage(TPasVariable(AElement))
else if AElement is TPasProcedureBase then
AppendProcDecl(CodeEl, TableEl, TPasProcedureBase(AElement))
else if AElement is TPasType then
CreateTypePage(TPasType(AElement))
else else
AppendText(CreateWarning(BodyElement), '<' + AElement.ClassName + '>'); AppendText(CreateWarning(BodyElement), '<' + AElement.ClassName + '>');
@ -3518,6 +3584,23 @@ begin
List.Add(SHTMLDisableMenuBrackets); List.Add(SHTMLDisableMenuBrackets);
end; end;
class procedure THTMLWriter.SplitImport(var AFilename, ALinkPrefix: String);
var
i: integer;
begin
i := Pos(',', AFilename);
if i > 0 then
begin //split into filename and prefix
ALinkPrefix := Copy(AFilename,i+1,Length(AFilename));
SetLength(AFilename, i-1);
end
else if ALinkPrefix = '' then
begin //synthesize outdir\pgk.xct, ..\pkg
ALinkPrefix := '../' + ChangeFileExt(ExtractFileName(AFilename), '');
AFilename := ChangeFileExt(AFilename, '.xct');
end;
end;
Class Function THTMLWriter.FileNameExtension : String; Class Function THTMLWriter.FileNameExtension : String;
begin begin
result:=''; result:='';

View File

@ -32,7 +32,7 @@ type
class procedure Usage(List: TStrings); override; class procedure Usage(List: TStrings); override;
Class Function FileNameExtension : String; override; Class Function FileNameExtension : String; override;
Class procedure SplitImport(var AFilename, ALinkPrefix: String); override;
end; end;
{$ELSE} // implementation {$ELSE} // implementation
@ -565,4 +565,21 @@ begin
result:='.chm'; result:='.chm';
end; end;
class procedure TCHMHTMLWriter.SplitImport(var AFilename, ALinkPrefix: String);
var
i: integer;
begin
i := Pos(',', AFilename);
if i > 0 then
begin //split into filename and prefix
ALinkPrefix := Copy(AFilename,i+1,Length(AFilename));
SetLength(AFilename, i-1);
end
else if ALinkPrefix = '' then
begin //synthesize outdir\pgk.xct, ms-its:pkg.chm::/
ALinkPrefix := 'ms-its:' + ChangeFileExt(ExtractFileName(AFilename), '.chm') + '::/';
AFilename := ChangeFileExt(AFilename, '.xct');
end;
end;
{$ENDIF} {$ENDIF}