Menu
▾
▴
[JVCL-Checkins] CVS: dev/help/tools/GenDtx DelphiParser.pas,1.5,1.6 MainCtrl.pas,1.7,1.8 ParserTypes.pas,1.5,1.6 Settings.pas,1.6,1.7 SettingsDlg.pas,1.4,1.5
|
From: Remko B. <rem...@us...> - 2003-08-30 16:00:57
|
Update of /cvsroot/jvcl/dev/help/tools/GenDtx
In directory sc8-pr-cvs1:/tmp/cvs-serv1228
Modified Files:
DelphiParser.pas MainCtrl.pas ParserTypes.pas Settings.pas
SettingsDlg.pas
Log Message:
* Can compare params
* Metaclass, Class var added
* Some more options
Index: DelphiParser.pas
===================================================================
RCS file: /cvsroot/jvcl/dev/help/tools/GenDtx/DelphiParser.pas,v
retrieving revision 1.5
retrieving revision 1.6
diff -C2 -d -r1.5 -r1.6
*** DelphiParser.pas 24 Aug 2003 22:23:36 -0000 1.5
--- DelphiParser.pas 30 Aug 2003 16:00:48 -0000 1.6
***************
*** 38,41 ****
--- 38,42 ----
FRecording: Boolean;
FCompilerDirectives: TStringList;
+ FLastWasNextLine: Boolean;
procedure ReadBuffer;
function ReadPortion: Boolean;
***************
*** 159,182 ****
TDtxCompareTokenType = (ctHelpTag, ctText, ctParseTag, ctSeperator);
TDtxCompareParser = class(TBasicParser)
private
! FList: TStrings;
FErrors: TDtxCompareErrorFlags;
FDefaultTexts: TDefaultTexts;
! function GeTDtxCompareTokenType: TDtxCompareTokenType;
protected
function ReadNextToken: Char; override;
- //function Parse: Boolean;
function Parse: Boolean;
- procedure ReadPackage;
procedure ReadAuthor;
! procedure ReadStatus;
procedure ReadJVCLINFO;
! procedure ReadStartBlock;
! procedure ReadSeeAlso;
procedure ReadRest;
! property CompareTokenType: TDtxCompareTokenType read GeTDtxCompareTokenType;
public
constructor Create; override;
--- 160,202 ----
TDtxCompareTokenType = (ctHelpTag, ctText, ctParseTag, ctSeperator);
+ TDtxItem = class
+ private
+ FTag: string;
+ FParameters: TStrings;
+ FTitle: string;
+ FCombine: string;
+ FCombineWith: string;
+ public
+ constructor Create(const ATag: string); virtual;
+ destructor Destroy; override;
+ property Tag: string read FTag write FTag;
+ property Parameters: TStrings read FParameters;
+ property Title: string read FTitle write FTitle;
+ property Combine: string read FCombine write FCombine;
+ property CombineWith: string read FCombineWith write FCombineWith;
+ end;
+
TDtxCompareParser = class(TBasicParser)
private
! FList: TList;
FErrors: TDtxCompareErrorFlags;
FDefaultTexts: TDefaultTexts;
! function GetDtxCompareTokenType: TDtxCompareTokenType;
protected
function ReadNextToken: Char; override;
function Parse: Boolean;
procedure ReadAuthor;
! procedure ReadCombine(Item: TDtxItem);
! procedure ReadCombineWith(Item: TDtxItem);
procedure ReadJVCLINFO;
! procedure ReadPackage;
! procedure ReadParameters(List: TStrings);
procedure ReadRest;
+ procedure ReadSeeAlso;
+ procedure ReadStartBlock;
+ procedure ReadStatus;
! property CompareTokenType: TDtxCompareTokenType read GetDtxCompareTokenType;
public
constructor Create; override;
***************
*** 184,188 ****
function Execute(const AFileName: string): Boolean;
! property List: TStrings read FList;
property Errors: TDtxCompareErrorFlags read FErrors;
property DefaultTexts: TDefaultTexts read FDefaultTexts;
--- 204,208 ----
function Execute(const AFileName: string): Boolean;
! property List: TList read FList;
property Errors: TDtxCompareErrorFlags read FErrors;
property DefaultTexts: TDefaultTexts read FDefaultTexts;
***************
*** 277,281 ****
uses
! SysUtils, Dialogs, Windows;
const
--- 297,301 ----
uses
! SysUtils, Dialogs, Windows, Math, Contnrs;
const
***************
*** 427,430 ****
--- 447,452 ----
procedure TBasicParser.SkipBlanks;
begin
+ FLastWasNextLine := False;
+
while True do
begin
***************
*** 442,445 ****
--- 464,468 ----
Exit;
end;
+ FLastWasNextLine := (FSourcePtr^ = #10) or (FLastWasNextLine and (FSourcePtr^ in [#0..#32]));
Inc(FSourcePtr);
end;
***************
*** 863,866 ****
--- 886,890 ----
var
ClassItem: TClassItem;
+ MetaClassItem: TMetaClassItem;
begin
{ VB:
***************
*** 885,897 ****
end;
- { Nu pas toevoegen }
- if AddToList then
- begin
- ClassItem := TClassItem.Create(TypeName);
- FTypeList.Add(ClassItem);
- end
- else
- ClassItem := nil;
-
if Token = toHaakjeOpen then
begin
--- 909,912 ----
***************
*** 901,906 ****
end;
! { TODO: Iets doen met meta-class }
! if (Token <> toSemiColon) and not TokenSymbolIs('of') then
ReadClassMethods(ClassItem, AddToList)
{ Token staat op eerste token na [end]; }
--- 916,950 ----
end;
! ClassItem := nil;
! MetaClassItem := nil;
!
! { Nu pas toevoegen }
! if AddToList then
! begin
! if TokenSymbolIs('of') then
! begin
! MetaClassItem := TMetaClassItem.Create(TypeName);
! FTypeList.Add(MetaClassItem);
! end
! else
! begin
! ClassItem := TClassItem.Create(TypeName);
! FTypeList.Add(ClassItem);
! end
! end;
!
! if TokenSymbolIs('of') then
! begin
! NextToken;
! CheckToken(toSymbol);
! if MetaClassItem <> nil then
! MetaClassItem.Value := TokenString;
!
! SkipUntilToken(toSemiColon); //SkipUntilSemiColon;
! CheckToken(toSemiColon);
! NextToken;
! end
! else
! if Token <> toSemiColon then
ReadClassMethods(ClassItem, AddToList)
{ Token staat op eerste token na [end]; }
***************
*** 1504,1508 ****
begin
ReadClass_Property(AClassItem, Position,
! AddToList and (Position in [inProtected, inPublic, inPublished]));
{ Token is eerste token na ; }
Continue;
--- 1548,1552 ----
begin
ReadClass_Property(AClassItem, Position,
! AddToList and (Position in AcceptVisibilities + [inProtected, inPublic, inPublished]));
{ Token is eerste token na ; }
Continue;
***************
*** 1805,1809 ****
repeat
Result := ReadNextToken;
! until not SkipBlanks or (Token <> toComment);
end;
--- 1849,1853 ----
repeat
Result := ReadNextToken;
! until not SkipBlanks or not (Token in [toComment, #10]);
end;
***************
*** 2475,2480 ****
begin
inherited;
! FList := TStringList.Create;
! TStringList(FList).Sorted := True;
end;
--- 2519,2523 ----
begin
inherited;
! FList := TObjectList.Create;
end;
***************
*** 2517,2521 ****
);
! function TDtxCompareParser.GeTDtxCompareTokenType: TDtxCompareTokenType;
var
S: string;
--- 2560,2564 ----
);
! function TDtxCompareParser.GetDtxCompareTokenType: TDtxCompareTokenType;
var
S: string;
***************
*** 2555,2558 ****
--- 2598,2635 ----
end;
+ procedure TDtxCompareParser.ReadCombine(Item: TDtxItem);
+ var
+ S: string;
+ begin
+ if Item = nil then
+ ErrorStr('ReadCombine, Item = nil');
+ NextToken;
+ if CompareTokenType = ctText then
+ begin
+ S := TokenString;
+ if (S > '') and (S[Length(S)] = '>') then
+ Delete(S, Length(S), 1);
+ Item.Combine := S;
+ NextToken;
+ end;
+ end;
+
+ procedure TDtxCompareParser.ReadCombineWith(Item: TDtxItem);
+ var
+ S: string;
+ begin
+ if Item = nil then
+ ErrorStr('ReadCombineWith, Item = nil');
+ NextToken;
+ if CompareTokenType = ctText then
+ begin
+ S := TokenString;
+ if (S > '') and (S[Length(S)] = '>') then
+ Delete(S, Length(S), 1);
+ Item.CombineWith := S;
+ NextToken;
+ end;
+ end;
+
procedure TDtxCompareParser.ReadJVCLINFO;
begin
***************
*** 2624,2627 ****
--- 2701,2739 ----
end;
+ procedure TDtxCompareParser.ReadParameters(List: TStrings);
+ var
+ S: string;
+ begin
+ NextToken;
+ while True do
+ begin
+ while not FLastWasNextLine and (Token <> toEof) do
+ NextToken;
+
+ if Token = toEof then
+ Exit;
+
+ if CompareTokenType <> ctText then
+ Break;
+
+ S := TokenString;
+ NextToken;
+
+ if CompareTokenType <> ctText then
+ Break;
+
+ if SameText(S, 'See') and SameText(TokenString, 'Also') then
+ begin
+ ReadSeeAlso;
+ Break;
+ end;
+
+ if (Token <> toSymbol) or (TokenSymbolIn(['-', ':']) < 0) then
+ Continue;
+
+ List.Add(S);
+ end;
+ end;
+
procedure TDtxCompareParser.ReadRest;
type
***************
*** 2649,2655 ****
--- 2761,2769 ----
S: string;
State: TState;
+ DtxItem: TDtxItem;
begin
Check := '';
State := stNone;
+ DtxItem := nil;
while Token <> toEof do
***************
*** 2659,2663 ****
ctHelpTag:
begin
! FList.Add(S);
Check := '';
end;
--- 2773,2778 ----
ctHelpTag:
begin
! DtxItem := TDtxItem.Create(S);
! FList.Add(DtxItem);
Check := '';
end;
***************
*** 2672,2677 ****
if Check = '' then
Check := S;
! if (State = stNone) and TokenSymbolIsExact('See') then
! State := stSee
else
if (State = stSee) and TokenSymbolIsExact('Also') then
--- 2787,2809 ----
if Check = '' then
Check := S;
! if (State = stNone) and FLastWasNextLine then
! begin
! if TokenSymbolIsExact('See') then
! State := stSee
! else
! if TokenSymbolIsExact('Parameters') then
! begin
! if DtxItem = nil then
! ErrorStr('''Parameters'' found but no help tag');
!
! ReadParameters(DtxItem.Parameters);
! end
! else
! if TokenSymbolIs('<COMBINE') then
! ReadCombine(DtxItem)
! else
! if TokenSymbolIs('<COMBINEWith') then
! ReadCombineWith(DtxItem)
! end
else
if (State = stSee) and TokenSymbolIsExact('Also') then
***************
*** 2729,2733 ****
ctHelpTag:
begin
! FList.Add(TokenString);
if (LState = stNone) and
SameText(Copy(TokenString, Length(TokenString) - 3, 4), '.pas') then
--- 2861,2865 ----
ctHelpTag:
begin
! FList.Add(TDtxItem.Create(TokenString));
if (LState = stNone) and
SameText(Copy(TokenString, Length(TokenString) - 3, 4), '.pas') then
***************
*** 3162,3165 ****
--- 3294,3311 ----
ErrorFmt(SNotCharExpected, [T]);
end;
+ end;
+
+ { TDtxItem }
+
+ constructor TDtxItem.Create(const ATag: string);
+ begin
+ FParameters := TStringList.Create;
+ FTag := ATag;
+ end;
+
+ destructor TDtxItem.Destroy;
+ begin
+ FParameters.Free;
+ inherited;
end;
Index: MainCtrl.pas
===================================================================
RCS file: /cvsroot/jvcl/dev/help/tools/GenDtx/MainCtrl.pas,v
retrieving revision 1.7
retrieving revision 1.8
diff -C2 -d -r1.7 -r1.8
*** MainCtrl.pas 24 Aug 2003 22:23:36 -0000 1.7
--- MainCtrl.pas 30 Aug 2003 16:00:49 -0000 1.8
***************
*** 8,14 ****
const
CSummaryDescription = 'Summary'#13#10' Write here a summary (1 line)';
! CSummaryDescriptionOverride = CSummaryDescription +
#13#10' This is an overridden method, you don''t have to describe these' +
! #13#10' if it does the same as the inherited method';
CDescriptionDescription = 'Description'#13#10' Write here a description'#13#10;
CSeeAlsoDescription = 'See Also'#13#10' List here other properties, methods (comma seperated)'#13#10 +
--- 8,14 ----
const
CSummaryDescription = 'Summary'#13#10' Write here a summary (1 line)';
! {CSummaryDescriptionOverride = CSummaryDescription +
#13#10' This is an overridden method, you don''t have to describe these' +
! #13#10' if it does the same as the inherited method';}
CDescriptionDescription = 'Description'#13#10' Write here a description'#13#10;
CSeeAlsoDescription = 'See Also'#13#10' List here other properties, methods (comma seperated)'#13#10 +
***************
*** 51,55 ****
procedure FillWithHeaders(ATypeList: TTypeList; Optional, NotOptional: TStrings);
procedure CompareDtxFile(const AFileName: string;
! DtxHeaders, NotInDtx, NotInPas: TStrings; ATypeList: TTypeList);
procedure SettingsChanged(Sender: TObject; ChangeType: TSettingsChangeType);
procedure DetermineCheckable(CheckableList, NotInPasDir, NotInRealDtxDir: TStrings);
--- 51,57 ----
procedure FillWithHeaders(ATypeList: TTypeList; Optional, NotOptional: TStrings);
procedure CompareDtxFile(const AFileName: string;
! DtxHeaders: TList; NotInDtx, NotInPas: TStrings; ATypeList: TTypeList);
! procedure CompareParameters(ATypeList: TTypeList; DtxHeaders: TList;
! NotInDtx, NotInPas: TStrings);
procedure SettingsChanged(Sender: TObject; ChangeType: TSettingsChangeType);
procedure DetermineCheckable(CheckableList, NotInPasDir, NotInRealDtxDir: TStrings);
***************
*** 110,124 ****
const
- {TDelphiType = (dtClass, dtConst, dtDispInterface, dtFunction, dtFunctionType,
- dtInterface, dtMethodFunc, dtMethodProc, dtProcedure, dtProcedureType,
- dtProperty, dtRecord, dtResourceString, dtSet, dtType, dtVar);}
- {TOutputType = (otClass, otConst, otDispInterface, otFunction, otFunctionType,
- otInterface, otProcedure, otProcedureType, otProperty, otRecord,
- otResourceString, otSet, otType, otVar);}
-
CConvert: array[TDelphiType] of TOutputType =
(otClass, otConst, otType, otFunction, otFunctionType,
otInterface, otFunction, otProcedure, otProcedure, otProcedureType,
! otProperty, otRecord, otResourcestring, otSet, otType, otVar, otField);
{ efJVCLInfoGroup, efJVCLInfoFlag, efNoPackageTag, efPackageTagNotFilled,
--- 112,119 ----
const
CConvert: array[TDelphiType] of TOutputType =
(otClass, otConst, otType, otFunction, otFunctionType,
otInterface, otFunction, otProcedure, otProcedure, otProcedureType,
! otProperty, otRecord, otResourcestring, otSet, otType, otVar, otField, otMetaClass);
{ efJVCLInfoGroup, efJVCLInfoFlag, efNoPackageTag, efPackageTagNotFilled,
***************
*** 245,249 ****
begin
if Assigned(InBoth) then
! InBoth.Add(Source1[Index1]);
Inc(Index1);
Inc(Index2);
--- 240,244 ----
begin
if Assigned(InBoth) then
! InBoth.AddObject(Source1[Index1], Source1.Objects[Index1]);
Inc(Index1);
Inc(Index2);
***************
*** 253,257 ****
begin
if Assigned(NotInSource2) then
! NotInSource2.Add(Source1[Index1]);
Inc(Index1)
end
--- 248,252 ----
begin
if Assigned(NotInSource2) then
! NotInSource2.AddObject(Source1[Index1], Source1.Objects[Index1]);
Inc(Index1)
end
***************
*** 260,264 ****
begin
if Assigned(NotInSource1) then
! NotInSource1.Add(Source2[Index2]);
Inc(Index2);
end;
--- 255,259 ----
begin
if Assigned(NotInSource1) then
! NotInSource1.AddObject(Source2[Index2], Source2.Objects[Index2]);
Inc(Index2);
end;
***************
*** 268,272 ****
while Index2 < Source2.Count do
begin
! NotInSource1.Add(Source2[Index2]);
Inc(Index2);
end;
--- 263,267 ----
while Index2 < Source2.Count do
begin
! NotInSource1.AddObject(Source2[Index2], Source2.Objects[Index2]);
Inc(Index2);
end;
***************
*** 274,278 ****
while Index1 < Source1.Count do
begin
! NotInSource2.Add(Source1[Index1]);
Inc(Index1);
end;
--- 269,273 ----
while Index1 < Source1.Count do
begin
! NotInSource2.AddObject(Source1[Index1], Source1.Objects[Index1]);
Inc(Index1);
end;
***************
*** 311,314 ****
--- 306,330 ----
end;
+ procedure FillWithDtxHeaders(DtxHeaders: TList; Dest: TStrings);
+ var
+ I: Integer;
+ begin
+ for I := 0 to DtxHeaders.Count - 1 do
+ Dest.Add(TDtxItem(DtxHeaders[I]).Tag);
+ end;
+
+ function IndexInDtxHeaders(DtxHeaders: TList; const S: string): Integer;
+ var
+ I: Integer;
+ begin
+ for I := 0 to DtxHeaders.Count - 1 do
+ if SameText(TDtxItem(DtxHeaders[I]).Tag, S) then
+ begin
+ Result := I;
+ Exit;
+ end;
+ Result := -1;
+ end;
+
function GetClassInfoStr(AItem: TAbstractItem): string;
begin
***************
*** 328,343 ****
function GetSummaryStr(AItem: TAbstractItem): string;
begin
! if (AItem.DelphiType in [dtMethodFunc, dtMethodProc]) and (AItem is TParamClassMethod) and
(diOverride in TParamClassMethod(AItem).Directives) then
Result := CSummaryDescriptionOverride
else
! Result := CSummaryDescription;
end;
function GetDescriptionStr(AItem: TAbstractItem): string;
begin
! Result := CDescriptionDescription + AItem.AddDescriptionString;
end;
--- 344,373 ----
function GetSummaryStr(AItem: TAbstractItem): string;
+ const
+ CSummaryDescription = 'Summary'#13#10' Write here a summary (1 line)';
begin
! {if (AItem.DelphiType in [dtMethodFunc, dtMethodProc]) and (AItem is TParamClassMethod) and
(diOverride in TParamClassMethod(AItem).Directives) then
Result := CSummaryDescriptionOverride
else
! Result := CSummaryDescription;}
!
! Result := AItem.AddSummaryString;
! if Result = '' then
! Result := CSummaryDescription
! else
! Result := 'Summary'#13#10 + Result;
end;
function GetDescriptionStr(AItem: TAbstractItem): string;
begin
! //Result := CDescriptionDescription + AItem.AddDescriptionString;
!
! Result := AItem.AddDescriptionString;
! if Result = '' then
! Result := CDescriptionDescription
! else
! Result := 'Description'#13#10 + Result;
end;
***************
*** 752,755 ****
--- 782,789 ----
Exit;
+ if (ATypeItem is TTypeItem) and
+ (StrLIComp(PChar(TTypeItem(ATypeItem).Value), 'class of', 8) = 0) then
+ Exit;
+
if not TSettings.Instance.OutputTypeEnabled[CConvert[ATypeItem.DelphiType]] then
Exit;
***************
*** 833,836 ****
--- 867,871 ----
DtxParser: TDtxCompareParser;
NotInDtx, NotInPas: TStringList;
+ ParametersNotInDtx, ParametersNotInPas: TStringList;
I: Integer;
FileStatus: string;
***************
*** 842,848 ****
--- 877,887 ----
NotInDtx := TStringList.Create;
NotInPas := TStringList.Create;
+ ParametersNotInDtx := TStringList.Create;
+ ParametersNotInPas := TStringList.Create;
try
NotInDtx.Sorted := True;
NotInPas.Sorted := True;
+ ParametersNotInDtx.Sorted := True;
+ ParametersNotInPas.Sorted := True;
DelphiParser.AcceptCompilerDirectives := TSettings.Instance.AcceptCompilerDirectives;
***************
*** 866,869 ****
--- 905,909 ----
CompareDtxFile(AFileName, DtxParser.List, NotInDtx, NotInPas, DelphiParser.TypeList);
+ CompareParameters(DelphiParser.TypeList, DtxParser.List, ParametersNotInDtx, ParametersNotInPas);
FileStatus := '';
***************
*** 880,883 ****
--- 920,928 ----
else
FileStatus := FileStatus + ' & contains default texts';
+ if (ParametersNotInDtx.Count > 0) or (ParametersNotInPas.Count > 0) then
+ if FileStatus = '' then
+ FileStatus := 'Params diff'
+ else
+ FileStatus := FileStatus + ' & params diff';
if FileStatus = '' then
***************
*** 906,910 ****
for I := 0 to NotInDtx.Count - 1 do
DoMessage(NotInDtx[I] +
! CCaseRelatied[DtxParser.List.IndexOf(NotInDtx[I]) >= 0]);
end;
if NotInPas.Count > 0 then
--- 951,955 ----
for I := 0 to NotInDtx.Count - 1 do
DoMessage(NotInDtx[I] +
! CCaseRelatied[IndexInDtxHeaders(DtxParser.List, NotInDtx[I]) >= 0]);
end;
if NotInPas.Count > 0 then
***************
*** 914,917 ****
--- 959,972 ----
DoMessage(NotInPas[I]);
end;
+ if ParametersNotInDtx.Count > 0 then
+ begin
+ DoMessage('-- Params not in dtx file');
+ DoMessage(ParametersNotInDtx);
+ end;
+ if ParametersNotInPas.Count > 0 then
+ begin
+ DoMessage('-- Params not in pas file');
+ DoMessage(ParametersNotInPas);
+ end;
Inc(FParsedOK);
***************
*** 920,923 ****
--- 975,980 ----
NotInDtx.Free;
NotInPas.Free;
+ ParametersNotInDtx.Free;
+ ParametersNotInPas.Free;
DtxParser.Free;
DelphiParser.Free;
***************
*** 1063,1067 ****
procedure TMainCtrl.CompareDtxFile(
const AFileName: string;
! DtxHeaders, NotInDtx, NotInPas: TStrings;
ATypeList: TTypeList);
var
--- 1120,1124 ----
procedure TMainCtrl.CompareDtxFile(
const AFileName: string;
! DtxHeaders: TList; NotInDtx, NotInPas: TStrings;
ATypeList: TTypeList);
var
***************
*** 1081,1085 ****
TSettings.Instance.RunTimePasDir,
ChangeFileExt(AFileName, '.pas')));
! LDtxHeaders.Assign(DtxHeaders);
NotOptional.CustomSort(CaseSensitiveSort);
--- 1138,1143 ----
TSettings.Instance.RunTimePasDir,
ChangeFileExt(AFileName, '.pas')));
! FillWithDtxHeaders(DtxHeaders, LDtxHeaders);
! //LDtxHeaders.Assign(DtxHeaders);
NotOptional.CustomSort(CaseSensitiveSort);
***************
*** 1087,1093 ****
LDtxHeaders.CustomSort(CaseSensitiveSort);
! //Optional.SaveToFile('C:\Temp\Optional.txt');
! //NotOptional.SaveToFile('C:\Temp\NotOptional.txt');
! //LDtxHeaders.SaveToFile('C:\Temp\DtxHeaders.txt');
DiffLists(LDtxHeaders, NotOptional, nil, LNotInDtx, LNotInPas, True);
--- 1145,1151 ----
LDtxHeaders.CustomSort(CaseSensitiveSort);
! Optional.SaveToFile('C:\Temp\Optional.txt');
! NotOptional.SaveToFile('C:\Temp\NotOptional.txt');
! LDtxHeaders.SaveToFile('C:\Temp\DtxHeaders.txt');
DiffLists(LDtxHeaders, NotOptional, nil, LNotInDtx, LNotInPas, True);
***************
*** 1727,1730 ****
--- 1785,1856 ----
finally
Free;
+ end;
+ end;
+
+ procedure TMainCtrl.CompareParameters(ATypeList: TTypeList; DtxHeaders: TList;
+ NotInDtx, NotInPas: TStrings);
+ var
+ I, J: Integer;
+ Index: Integer;
+ AllPasParameters, AllDtxParameters: TStringList;
+ ParamsNotInPas, ParamsNotInDtx: TStringList;
+ Params: TStrings;
+ DtxItem: TDtxItem;
+ TagName: string;
+ begin
+ AllPasParameters := TStringList.Create;
+ AllDtxParameters := TStringList.Create;
+ ParamsNotInPas := TStringList.Create;
+ ParamsNotInDtx := TStringList.Create;
+ try
+ AllPasParameters.Sorted := True;
+ AllPasParameters.Duplicates := dupIgnore;
+
+ AllDtxParameters.Duplicates := dupAccept;
+
+ for I := 0 to ATypeList.Count - 1 do
+ begin
+ Params := ATypeList[I].ParamList;
+ if Params <> nil then
+ begin
+ TagName := '@@' + ATypeList[I].ReferenceName;
+ Index := IndexInDtxHeaders(DtxHeaders, TagName);
+ if Index >= 0 then
+ begin
+ DtxItem := TDtxItem(DtxHeaders[Index]);
+ if DtxItem.Combine > '' then
+ TagName := '@@' + DtxItem.Combine;
+ for J := 0 to Params.Count - 1 do
+ AllPasParameters.Add(TagName + ' - ' + Params[J]);
+ end;
+ end;
+ end;
+
+ for I := 0 to DtxHeaders.Count - 1 do
+ begin
+ Params := TDtxItem(DtxHeaders[I]).Parameters;
+ if Params <> nil then
+ for J := 0 to Params.Count - 1 do
+ AllDtxParameters.Add(TDtxItem(DtxHeaders[I]).Tag + ' - ' + Params[J]);
+ end;
+
+ AllPasParameters.Sorted := False;
+
+ AllPasParameters.CustomSort(CaseSensitiveSort);
+ AllDtxParameters.CustomSort(CaseSensitiveSort);
+
+ AllPasParameters.SaveToFile('C:\temp\AllPasParameters.txt');
+ AllDtxParameters.SaveToFile('C:\temp\AllDtxParameters.txt');
+
+ DiffLists(AllPasParameters, AllDtxParameters,
+ nil, ParamsNotInPas, ParamsNotInDtx, True);
+
+ NotInDtx.AddStrings(ParamsNotInDtx);
+ NotInPas.AddStrings(ParamsNotInPas);
+ finally
+ AllPasParameters.Free;
+ AllDtxParameters.Free;
+ ParamsNotInDtx.Free;
+ ParamsNotInPas.Free;
end;
end;
Index: ParserTypes.pas
===================================================================
RCS file: /cvsroot/jvcl/dev/help/tools/GenDtx/ParserTypes.pas,v
retrieving revision 1.5
retrieving revision 1.6
diff -C2 -d -r1.5 -r1.6
*** ParserTypes.pas 24 Aug 2003 22:23:36 -0000 1.5
--- ParserTypes.pas 30 Aug 2003 16:00:49 -0000 1.6
***************
*** 15,19 ****
TDelphiType = (dtClass, dtConst, dtDispInterface, dtFunction, dtFunctionType,
dtInterface, dtMethodFunc, dtMethodProc, dtProcedure, dtProcedureType,
! dtProperty, dtRecord, dtResourceString, dtEnum, dtType, dtVar, dtClassField);
TDelphiTypes = set of TDelphiType;
--- 15,20 ----
TDelphiType = (dtClass, dtConst, dtDispInterface, dtFunction, dtFunctionType,
dtInterface, dtMethodFunc, dtMethodProc, dtProcedure, dtProcedureType,
! dtProperty, dtRecord, dtResourceString, dtEnum, dtType, dtVar,
! dtClassField, dtMetaClass);
TDelphiTypes = set of TDelphiType;
***************
*** 76,95 ****
FCombineList: TObjectList;
FCombineWithList: TObjectList;
function GetDelphiType: TDelphiType; virtual; abstract;
function GetItemsString: string; virtual;
! function GetRealParamString: string; virtual;
! function GetParamString: string; virtual;
!
function GetReferenceName: string; virtual;
function GetSortName: string; virtual;
function GetTitleName: string; virtual;
-
function GetValueString: string; virtual;
! function GetClassString: string; virtual;
! function GetCombineString: string; virtual;
! function GetCanCombine: Boolean;
! function GetCombineCount: Integer;
! function GetCombineWithCount: Integer;
! function GetAddDescriptionString: string; virtual;
protected
procedure AddCombine(AItem: TAbstractItem);
--- 77,98 ----
FCombineList: TObjectList;
FCombineWithList: TObjectList;
+ function GetParamString: string;
+ function GetRealParamString: string;
+
+ function GetAddDescriptionString: string; virtual;
+ function GetAddSummaryString: string; virtual;
+ function GetCanCombine: Boolean;
+ function GetClassString: string; virtual;
+ function GetCombineCount: Integer;
+ function GetCombineString: string; virtual;
+ function GetCombineWithCount: Integer;
function GetDelphiType: TDelphiType; virtual; abstract;
function GetItemsString: string; virtual;
! function GetParamList: TStrings; virtual;
function GetReferenceName: string; virtual;
function GetSortName: string; virtual;
function GetTitleName: string; virtual;
function GetValueString: string; virtual;
! function GetRealParamList: TStrings; virtual;
protected
procedure AddCombine(AItem: TAbstractItem);
***************
*** 109,116 ****
--- 112,122 ----
property ParamString: string read GetParamString;
property RealParamString: string read GetRealParamString;
+ property ParamList: TStrings read GetParamList;
+ property RealParamList: TStrings read GetRealParamList;
property ValueString: string read GetValueString;
property ClassString: string read GetClassString;
property CombineString: string read GetCombineString;
property AddDescriptionString: string read GetAddDescriptionString;
+ property AddSummaryString: string read GetAddSummaryString;
{ Voor function of object type > 0 als > 1 dan CanCombine = false }
property CombineCount: Integer read GetCombineCount;
***************
*** 150,156 ****
FParamTypes: TStringList;
FDirectives: TDirectives;
! function GetRealParamString: string; override;
function GetReferenceName: string; override;
function GetAddDescriptionString: string; override;
public
constructor Create(const AName: string); override;
--- 156,163 ----
FParamTypes: TStringList;
FDirectives: TDirectives;
! //function GetRealParamString: string; override;
function GetReferenceName: string; override;
function GetAddDescriptionString: string; override;
+ function GetRealParamList: TStrings; override;
public
constructor Create(const AName: string); override;
***************
*** 182,186 ****
FDirectives: TDirectives;
FIsClassMethod: Boolean;
! function GetRealParamString: string; override;
function GetReferenceName: string; override;
function GetAddDescriptionString: string; override;
--- 189,194 ----
FDirectives: TDirectives;
FIsClassMethod: Boolean;
! function GetRealParamList: TStrings; override;
! //function GetRealParamString: string; override;
function GetReferenceName: string; override;
function GetAddDescriptionString: string; override;
***************
*** 252,256 ****
FInheritedProp: Boolean;
FTypeStr: string;
! function GetParamString: string; override;
function GetDelphiType: TDelphiType; override;
public
--- 260,266 ----
FInheritedProp: Boolean;
FTypeStr: string;
! function GetAddDescriptionString: string; override;
! //function GetParamList: TStrings; override;
! function GetParamList: TStrings; override;
function GetDelphiType: TDelphiType; override;
public
***************
*** 300,304 ****
--- 310,321 ----
private
function GetAddDescriptionString: string; override;
+ function GetDelphiType: TDelphiType; override;
function GetTitleName: string; override;
+ end;
+
+ TMetaClassItem = class(TTypeItem)
+ private
+ function GetAddDescriptionString: string; override;
+ function GetAddSummaryString: string; override;
function GetDelphiType: TDelphiType; override;
end;
***************
*** 306,311 ****
TVarItem = class(TValueItem)
private
- function GetTitleName: string; override;
function GetDelphiType: TDelphiType; override;
end;
--- 323,328 ----
TVarItem = class(TValueItem)
private
function GetDelphiType: TDelphiType; override;
+ function GetTitleName: string; override;
end;
***************
*** 335,339 ****
begin
Result := '';
! if AStrings.Count = 0 then
Exit;
--- 352,356 ----
begin
Result := '';
! if (AStrings = nil) or (AStrings.Count = 0) then
Exit;
***************
*** 376,379 ****
--- 393,401 ----
end;
+ function TAbstractItem.GetAddSummaryString: string;
+ begin
+
+ end;
+
function TAbstractItem.GetCanCombine: Boolean;
begin
***************
*** 434,443 ****
end;
! function TAbstractItem.GetParamString: string;
begin
if CanCombine then
Result := ''
else
! Result := RealParamString;
end;
--- 456,479 ----
end;
! function TAbstractItem.GetParamList: TStrings;
begin
if CanCombine then
+ Result := nil
+ else
+ Result := RealParamList;
+ end;
+
+ function TAbstractItem.GetParamString: string;
+ begin
+ Result := ParamListToString(ParamList);
+ {if CanCombine then
Result := ''
else
! Result := RealParamString;}
! end;
!
! function TAbstractItem.GetRealParamList: TStrings;
! begin
! Result := nil;
end;
***************
*** 498,505 ****
end;
! function TBaseFuncItem.GetRealParamString: string;
begin
Result := ParamListToString(FParams);
! end;
function TBaseFuncItem.GetAddDescriptionString: string;
--- 534,541 ----
end;
! {function TBaseFuncItem.GetRealParamString: string;
begin
Result := ParamListToString(FParams);
! end;}
function TBaseFuncItem.GetAddDescriptionString: string;
***************
*** 515,518 ****
--- 551,563 ----
end;
+ {function TBaseFuncItem.GetParamList: TStrings;
+ begin
+ end;}
+
+ function TBaseFuncItem.GetRealParamList: TStrings;
+ begin
+ Result := FParams;
+ end;
+
{ TListItem }
***************
*** 753,775 ****
end;
! function TParamClassMethod.GetRealParamString: string;
begin
Result := ParamListToString(FParams);
! end;
function TParamClassMethod.GetAddDescriptionString: string;
begin
if diOverload in Directives then
! Result :=
' This is an overloaded function/procedure, if possible you may combine the description'#13#10 +
' of all these functions into 1 general description. If you do so, combine all "Parameter" '#13#10 +
' lists into 1 list, and leave the "Summary", "Description" etc. fields empty for all'#13#10 +
! ' other overloaded functions with the same name.'#13#10
! else
! Result := '';
Result := Result + inherited GetAddDescriptionString;
end;
{ TVarItem }
--- 798,838 ----
end;
! {function TParamClassMethod.GetRealParamString: string;
begin
Result := ParamListToString(FParams);
! end;}
function TParamClassMethod.GetAddDescriptionString: string;
begin
+ Result := '';
+
+ if diOverride in Directives then
+ Result := Result +
+ ' This is an overridden method, you don''t have to describe these' +
+ ' if it does the same as the inherited method'#13#10;
+
if diOverload in Directives then
! Result := Result +
' This is an overloaded function/procedure, if possible you may combine the description'#13#10 +
' of all these functions into 1 general description. If you do so, combine all "Parameter" '#13#10 +
' lists into 1 list, and leave the "Summary", "Description" etc. fields empty for all'#13#10 +
! ' other overloaded functions with the same name.'#13#10;
Result := Result + inherited GetAddDescriptionString;
end;
+ {function TParamClassMethod.GetParamList: TStrings;
+ begin
+ if CanCombine then
+ Result := nil
+ else
+ Result := FParams;
+ end;}
+
+ function TParamClassMethod.GetRealParamList: TStrings;
+ begin
+ Result := FParams;
+ end;
+
{ TVarItem }
***************
*** 875,878 ****
--- 938,949 ----
{ TClassProperty }
+ function TClassProperty.GetAddDescriptionString: string;
+ begin
+ if Position = inPrivate then
+ Result := inherited GetAddDescriptionString
+ else
+ Result := '';
+ end;
+
function TClassProperty.GetDelphiType: TDelphiType;
begin
***************
*** 880,884 ****
end;
! function TClassProperty.GetParamString: string;
begin
if (CombineWithCount = 1) and (TAbstractItem(FCombineWithList[0]).CombineCount = 1) then
--- 951,963 ----
end;
! function TClassProperty.GetParamList: TStrings;
! begin
! if (CombineWithCount = 1) and (TAbstractItem(FCombineWithList[0]).CombineCount = 1) then
! Result := TAbstractItem(FCombineWithList[0]).RealParamList
! else
! Result := nil;
! end;
!
! {function TClassProperty.GetParamString: string;
begin
if (CombineWithCount = 1) and (TAbstractItem(FCombineWithList[0]).CombineCount = 1) then
***************
*** 886,890 ****
else
Result := '';
! end;
{ TMethodProc }
--- 965,969 ----
else
Result := '';
! end;}
{ TMethodProc }
***************
*** 1045,1048 ****
--- 1124,1147 ----
begin
Result := dtClassField;
+ end;
+
+ { TMetaClassItem }
+
+ function TMetaClassItem.GetAddDescriptionString: string;
+ begin
+ Result := Format(
+ ' %s is the metaclass for %s. Its value is the class reference for'#13#10 +
+ ' %s or for one of its descendants.', [SimpleName, Value, Value]);
+ end;
+
+ function TMetaClassItem.GetAddSummaryString: string;
+ begin
+ Result :=
+ Format(' Defines the metaclass for %s.', [Value]);
+ end;
+
+ function TMetaClassItem.GetDelphiType: TDelphiType;
+ begin
+ Result := dtMetaClass;
end;
Index: Settings.pas
===================================================================
RCS file: /cvsroot/jvcl/dev/help/tools/GenDtx/Settings.pas,v
retrieving revision 1.6
retrieving revision 1.7
diff -C2 -d -r1.6 -r1.7
*** Settings.pas 24 Aug 2003 22:23:36 -0000 1.6
--- Settings.pas 30 Aug 2003 16:00:49 -0000 1.7
***************
*** 9,15 ****
TOutputType = (otClass, otClassHeader, otConst, otDispInterface,
otField, otFunction, otFunctionType,
! otHeader, otInterface, otProcedure, otProcedureType, otProperty, otRecord,
otResourceString, otSet, otType, otVar);
TOutputTypeBool = array[TOutputType] of Boolean;
TOutputTypeStrs = array[TOutputType] of string;
--- 9,38 ----
TOutputType = (otClass, otClassHeader, otConst, otDispInterface,
otField, otFunction, otFunctionType,
! otHeader, otInterface, otMetaClass, otProcedure, otProcedureType, otProperty, otRecord,
otResourceString, otSet, otType, otVar);
+ const
+ COutputTypeSection: array[TOutputType] of string = (
+ 'Class', {otClass}
+ 'ClassHeader', {otClassHeader}
+ 'Const', {otConst}
+ 'DispInterface', {otDispInterface}
+ 'Field', {otField}
+ 'Function', {otFunction}
+ 'FunctionType', {otFunctionType}
+ 'Header', {otHeader}
+ 'Interface', {otInterface}
+ 'Metaclass', {otMetaClass}
+ 'Procedure', {otProcedure}
+ 'ProcedureType', {otProcedureType}
+ 'Property', {otProperty}
+ 'Record', {otRecord}
+ 'ResourceString', {otResourceString}
+ 'Set', {otSet}
+ 'Type', {otType}
+ 'Var' {otVar}
+ );
+
+ type
TOutputTypeBool = array[TOutputType] of Boolean;
TOutputTypeStrs = array[TOutputType] of string;
***************
*** 157,182 ****
SysUtils, Forms, IniFiles;
! const
! COutputTypeSection: array[TOutputType] of string = (
! 'Class', {otClass}
! 'ClassHeader', {otClassHeader}
! 'Const', {otConst}
! 'DispInterface', {otDispInterface}
! 'Field', {otField}
! 'Function', {otFunction}
! 'FunctionType', {otFunctionType}
! 'Header', {otHeader}
! 'Interface', {otInterface}
! 'Procedure', {otProcedure}
! 'ProcedureType', {otProcedureType}
! 'Property', {otProperty}
! 'Record', {otRecord}
! 'ResourceString', {otResourceString}
! 'Set', {otSet}
! 'Type', {otType}
! 'Var' {otVar}
! );
!
! { TSettings }
procedure TSettings.AddToUnitStatus(const AUnitStatus: TUnitStatus; const AFileName: string);
--- 180,184 ----
SysUtils, Forms, IniFiles;
! { TSettings }
procedure TSettings.AddToUnitStatus(const AUnitStatus: TUnitStatus; const AFileName: string);
Index: SettingsDlg.pas
===================================================================
RCS file: /cvsroot/jvcl/dev/help/tools/GenDtx/SettingsDlg.pas,v
retrieving revision 1.4
retrieving revision 1.5
diff -C2 -d -r1.4 -r1.5
*** SettingsDlg.pas 16 Aug 2003 11:24:06 -0000 1.4
--- SettingsDlg.pas 30 Aug 2003 16:00:49 -0000 1.5
***************
*** 102,105 ****
--- 102,107 ----
procedure Uitvoeren;
+ procedure InitTabs;
+
procedure SaveEnabled;
procedure SaveOutput;
***************
*** 156,159 ****
--- 158,163 ----
FSettings.Assign(TSettings.Instance);
+ InitTabs;
+
(*with FSettings do
begin
***************
*** 609,612 ****
--- 613,630 ----
begin
FSettings.RegisteredClasses.Assign(lsbRegisteredClasses.Items);
+ end;
+
+ procedure TfrmSettings.InitTabs;
+ var
+ OutputType: TOutputType;
+ begin
+ tbcOutputTypes.Tabs.BeginUpdate;
+ try
+ tbcOutputTypes.Tabs.Clear;
+ for OutputType := Low(TOutputType) to High(TOutputType) do
+ tbcOutputTypes.Tabs.Add(COutputTypeSection[OutputType]);
+ finally
+ tbcOutputTypes.Tabs.EndUpdate;
+ end;
end;
|