1 { Copyright (C) 2006 Mattias Gaertner
2 
3   This source is free software; you can redistribute it and/or modify it under
4   the terms of the GNU General Public License as published by the Free
5   Software Foundation; either version 2 of the License, or (at your option)
6   any later version.
7 
8   This code is distributed in the hope that it will be useful, but WITHOUT ANY
9   WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
10   FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
11   details.
12 
13   A copy of the GNU General Public License is available on the World Wide Web
14   at <http://www.gnu.org/copyleft/gpl.html>. You can also obtain it by writing
15   to the Free Software Foundation, Inc., 51 Franklin Street - Fifth Floor,
16   Boston, MA 02110-1335, USA.
17 
18 }
19 unit H2PasConvert;
20 
21 {$mode objfpc}{$H+}
22 
23 interface
24 
25 uses
26   Classes, SysUtils, Laz_AVL_Tree,
27   // LCL
28   LCLProc, LResources, Forms, Controls, Dialogs, XMLPropStorage,
29   // LazUtils
30   LazConfigStorage, FileUtil, LazFileUtils, LazFileCache, LazUTF8Classes,
31   // CodeTools
32   CodeAtom, CodeTree, KeywordFuncLists, NonPascalCodeTools, BasicCodeTools,
33   FileProcs, CodeCache, SourceChanger, CodeToolManager,
34   // IDEIntf
35   TextTools, IDEExternToolIntf, IDEDialogs, LazIDEIntf, SrcEditorIntf,
36   IDEMsgIntf, IDETextConverter,
37   // H2Pas
38   H2PasStrConsts;
39 
40 type
41 
42   { TRemoveCPlusPlusExternCTool  (for C header files)
43     Remove C++ 'extern "C"' lines }
44 
45   TRemoveCPlusPlusExternCTool = class(TCustomTextConverterTool)
46   public
ClassDescriptionnull47     class function ClassDescription: string; override;
Executenull48     function Execute(aText: TIDETextConverter): TModalResult; override;
49   end;
50 
51 
52   { TRemoveEmptyCMacrosTool   (for C header files)
53     Remove empty C macros}
54 
55   TRemoveEmptyCMacrosTool = class(TCustomTextConverterTool)
56   public
ClassDescriptionnull57     class function ClassDescription: string; override;
Executenull58     function Execute(aText: TIDETextConverter): TModalResult; override;
59   end;
60 
61 
62   { TReplaceEdgedBracketPairWithStar  (for C header files)
63     Replace [] with * }
64 
65   TReplaceEdgedBracketPairWithStar = class(TCustomTextReplaceTool)
66   public
ClassDescriptionnull67     class function ClassDescription: string; override;
68     constructor Create(TheOwner: TComponent); override;
69   end;
70 
71 
72   { TReplaceMacro0PointerWithNULL  (for C header files)
73     Replace macro values 0 pointer like (char *)0 with NULL }
74 
75   TReplaceMacro0PointerWithNULL = class(TCustomTextConverterTool)
76   public
ClassDescriptionnull77     class function ClassDescription: string; override;
Executenull78     function Execute(aText: TIDETextConverter): TModalResult; override;
79   end;
80 
81 
82   { TConvertFunctionTypesToPointers  (for C header files)
83     Replace function types with pointer to function type }
84 
85   TConvertFunctionTypesToPointers = class(TCustomTextConverterTool)
86   public
ClassDescriptionnull87     class function ClassDescription: string; override;
Executenull88     function Execute(aText: TIDETextConverter): TModalResult; override;
89   end;
90 
91 
92   { TConvertEnumsToTypeDef  (for C header files)
93     Give anoymous enums a name }
94 
95   TConvertEnumsToTypeDef = class(TCustomTextConverterTool)
96   public
ClassDescriptionnull97     class function ClassDescription: string; override;
Executenull98     function Execute(aText: TIDETextConverter): TModalResult; override;
99   end;
100 
101 
102   { TCommentComplexCMacros (for C header files)
103     Comment macros that are too complex for h2pas }
104 
105   TCommentComplexCMacros = class(TCustomTextConverterTool)
106   public
ClassDescriptionnull107     class function ClassDescription: string; override;
Executenull108     function Execute(aText: TIDETextConverter): TModalResult; override;
109   end;
110 
111 
112   { TCommentComplexCFunctions (for C header files)
113     Comment functions that are too complex for h2pas }
114 
115   TCommentComplexCFunctions = class(TCustomTextConverterTool)
116   public
ClassDescriptionnull117     class function ClassDescription: string; override;
Executenull118     function Execute(aText: TIDETextConverter): TModalResult; override;
119   end;
120 
121 
122   { TAddMissingMacroBrackets (for C header files)
123     Add missing brackets around macro values }
124 
125   TAddMissingMacroBrackets = class(TCustomTextConverterTool)
126   public
ClassDescriptionnull127     class function ClassDescription: string; override;
Executenull128     function Execute(aText: TIDETextConverter): TModalResult; override;
129   end;
130 
131 
132   { TReplaceUnitFilenameWithUnitName -
133     Replace "unit filename;" with "unit name;" }
134 
135   TReplaceUnitFilenameWithUnitName = class(TCustomTextReplaceTool)
136   public
ClassDescriptionnull137     class function ClassDescription: string; override;
138     constructor Create(TheOwner: TComponent); override;
139   end;
140 
141 
142   { TRemoveIncludeDirectives - Remove all $i filename }
143 
144   TRemoveIncludeDirectives = class(TCustomTextReplaceTool)
145   public
ClassDescriptionnull146     class function ClassDescription: string; override;
147     constructor Create(TheOwner: TComponent); override;
148   end;
149 
150 
151   { TRemoveDoubleSemicolons -
152     Remove double semicolons }
153 
154   TRemoveDoubleSemicolons = class(TCustomTextConverterTool)
155   public
ClassDescriptionnull156     class function ClassDescription: string; override;
Executenull157     function Execute(aText: TIDETextConverter): TModalResult; override;
158   end;
159 
160 
161   { TRemoveSystemTypes -
162     Remove type redefinitions like PLongint }
163 
164   TRemoveSystemTypes = class(TCustomTextConverterTool)
165   public
ClassDescriptionnull166     class function ClassDescription: string; override;
Executenull167     function Execute(aText: TIDETextConverter): TModalResult; override;
168   end;
169 
170 
171   { TRemoveRedefinedPointerTypes - Remove redefined pointer types }
172 
173   TRemoveRedefinedPointerTypes = class(TCustomTextConverterTool)
174   public
ClassDescriptionnull175     class function ClassDescription: string; override;
Executenull176     function Execute(aText: TIDETextConverter): TModalResult; override;
177   end;
178 
179 
180   { TRemoveEmptyTypeVarConstSections - Remove empty type/var/const sections }
181 
182   TRemoveEmptyTypeVarConstSections = class(TCustomTextConverterTool)
183   public
ClassDescriptionnull184     class function ClassDescription: string; override;
Executenull185     function Execute(aText: TIDETextConverter): TModalResult; override;
186   end;
187 
188 
189   { TReplaceImplicitTypes -
190     Search implicit types in parameters and add types for them
191     For example:
192         procedure ProcName(a: array[0..2] of char);
193       is replaced with
194         procedure ProcName(a: Tarray_0to2_of_char);
195       and a new type is added
196         Tarray_0to2_of_char = array[0..2] of char;
197        }
198 
199   TReplaceImplicitTypes = class(TCustomTextConverterTool)
200   private
201     Src: String;
202     ImplicitTypes: TAVLTree;// tree of TImplicitType
203     ExplicitTypes: TAVLTree;// tree of TImplicitType
204     TypeStart: LongInt;
205     TypeEnd: integer; // 0 means invalid
206     ConstSectionStart: LongInt;
207     ConstSectionEnd: LongInt; // 0 means invalid
FindNextImplicitTypenull208     function FindNextImplicitType(var Position: integer;
209                                   out aTypeStart, aTypeEnd: integer): boolean;
SearchImplicitParameterTypesnull210     function SearchImplicitParameterTypes(
211                                         var ModalResult: TModalResult): boolean;
PosToStrnull212     function PosToStr(Position: integer): string;
213     procedure AdjustMinPositions(const Identifier: string);
ReadWordnull214     function ReadWord(var Position: integer): boolean;
ReadUntilAtomnull215     function ReadUntilAtom(var Position: integer;
216                  const StopAtom: string; SkipBrackets: boolean = true): boolean;
ReadRecordnull217     function ReadRecord(var Position: integer): boolean;
ReadClassnull218     function ReadClass(var Position: integer): boolean;
ReadTypeDefinitionnull219     function ReadTypeDefinition(var Position: integer): boolean;
ReadConstSectionnull220     function ReadConstSection(var Position: integer): boolean;
FindExplicitTypesAndConstantsnull221     function FindExplicitTypesAndConstants(
222                                         var ModalResult: TModalResult): boolean;
InsertNewTypesnull223     function InsertNewTypes(var ModalResult: TModalResult): boolean;
FindInsertPositionnull224     function FindInsertPosition(MinPos: integer): integer;
UseNewTypesnull225     function UseNewTypes(var ModalResult: TModalResult): boolean;
226   public
ClassDescriptionnull227     class function ClassDescription: string; override;
Executenull228     function Execute(aText: TIDETextConverter): TModalResult; override;
CodeToIdentifiernull229     function CodeToIdentifier(const Code: string): string;
230   end;
231 
232 
233   { TFixArrayOfParameterType - Replace "array of )" with "array of const)" }
234 
235   TFixArrayOfParameterType = class(TCustomTextConverterTool)
236   public
ClassDescriptionnull237     class function ClassDescription: string; override;
Executenull238     function Execute(aText: TIDETextConverter): TModalResult; override;
239   end;
240 
241 
242   { TRemoveRedefinitionsInUnit
243     Removes redefinitions of types, variables, constants and resourcestrings }
244 
245   TRemoveRedefinitionsInUnit = class(TCustomTextConverterTool)
246   public
ClassDescriptionnull247     class function ClassDescription: string; override;
Executenull248     function Execute(aText: TIDETextConverter): TModalResult; override;
249   end;
250 
251 
252   { TAddMissingPointerTypes
253     Add missing pointer types like PPPChar }
254 
255   TAddMissingPointerTypes = class(TCustomTextConverterTool)
256   public
ClassDescriptionnull257     class function ClassDescription: string; override;
Executenull258     function Execute(aText: TIDETextConverter): TModalResult; override;
259   end;
260 
261 
262   { TFixAliasDefinitionsInUnit - fix section type of alias definitions
263 
264     Checks all alias definitions of the form
265     const LeftSide = RightSide;
266     looks up RightSide in the unit and if RightSide is a type or var, changes
267     the section accordingly }
268 
269   TFixAliasDefinitionsInUnit = class(TCustomTextConverterTool)
270   public
ClassDescriptionnull271     class function ClassDescription: string; override;
Executenull272     function Execute(aText: TIDETextConverter): TModalResult; override;
273   end;
274 
275 
276   { TFixH2PasMissingIFDEFsInUnit - add missing IFDEFs for function bodies }
277 
278   TFixH2PasMissingIFDEFsInUnit = class(TCustomTextConverterTool)
279   public
ClassDescriptionnull280     class function ClassDescription: string; override;
Executenull281     function Execute(aText: TIDETextConverter): TModalResult; override;
282   end;
283 
284 
285   { TReduceCompilerDirectivesInUnit - removes unneeded directives }
286 
287   TReduceCompilerDirectivesInUnit = class(TCustomTextConverterTool)
288   private
289     FDefines: TStrings;
290     FUndefines: TStrings;
291     procedure SetDefines(const AValue: TStrings);
292     procedure SetUndefines(const AValue: TStrings);
293   public
294     constructor Create(TheOwner: TComponent); override;
295     destructor Destroy; override;
ClassDescriptionnull296     class function ClassDescription: string; override;
Executenull297     function Execute(aText: TIDETextConverter): TModalResult; override;
298   published
299     property Undefines: TStrings read FUndefines write SetUndefines;
300     property Defines: TStrings read FDefines write SetDefines;
301   end;
302 
303 
304   { TReplaceConstFunctionsInUnit - replace simple assignment functions with constants }
305 
306   TReplaceConstFunctionsInUnit = class(TCustomTextConverterTool)
307   public
ClassDescriptionnull308     class function ClassDescription: string; override;
Executenull309     function Execute(aText: TIDETextConverter): TModalResult; override;
310   end;
311 
312   { TReplaceTypeCastFunctionsInUnit - replace simple type cast functions with types }
313 
314   TReplaceTypeCastFunctionsInUnit = class(TCustomTextConverterTool)
315   public
ClassDescriptionnull316     class function ClassDescription: string; override;
Executenull317     function Execute(aText: TIDETextConverter): TModalResult; override;
318   end;
319 
320   { TFixForwardDefinitions - reorder definitions }
321 
322   TFixForwardDefinitions = class(TCustomTextConverterTool)
323   public
ClassDescriptionnull324     class function ClassDescription: string; override;
Executenull325     function Execute(aText: TIDETextConverter): TModalResult; override;
326   end;
327 
328   { TAddToUsesSection - add units to uses section }
329 
330   TAddToUsesSection = class(TCustomTextConverterTool)
331   private
332     FUseUnits: TStrings;
333     procedure SetUseUnits(const AValue: TStrings);
334   public
335     constructor Create(TheOwner: TComponent); override;
336     destructor Destroy; override;
ClassDescriptionnull337     class function ClassDescription: string; override;
Executenull338     function Execute(aText: TIDETextConverter): TModalResult; override;
339   published
340     property UseUnits: TStrings read FUseUnits write SetUseUnits;
341   end;
342 
343 type
344   { TPretH2PasTools - Combines the common tools. }
345 
346   TPreH2PasToolsOption = (
347     phRemoveCPlusPlusExternCTool, // Remove C++ 'extern "C"' lines
348     phRemoveEmptyCMacrosTool, // Remove empty C macros
349     phReplaceEdgedBracketPairWithStar, // Replace [] with *
350     phReplaceMacro0PointerWithNULL, // Replace macro values 0 pointer like (char *)0
typesnull351     phConvertFunctionTypesToPointers, // Convert function types to pointers
352     phConvertEnumsToTypeDef, // Convert anonymous enums to ypedef enums
353     phCommentComplexCMacros, // Comment macros too complex for hpas
354     phCommentComplexCFunctions, // Comment functions too complex for hpas
355     phAddMissingMacroBrackets // Add missing macro brackets
356     );
357   TPreH2PasToolsOptions = set of TPreH2PasToolsOption;
358 const
359   DefaultPreH2PasToolsOptions =
360                         [Low(TPreH2PasToolsOption)..High(TPreH2PasToolsOption)];
361 
362 type
363   { TPreH2PasTools }
364 
365   TPreH2PasTools = class(TCustomTextConverterTool)
366   private
367     FOptions: TPreH2PasToolsOptions;
368   public
369     constructor Create(TheOwner: TComponent); override;
ClassDescriptionnull370     class function ClassDescription: string; override;
Executenull371     function Execute(aText: TIDETextConverter): TModalResult; override;
372   published
373     property Options: TPreH2PasToolsOptions read FOptions write FOptions default DefaultPreH2PasToolsOptions;
374   end;
375 
376 type
377   { TPostH2PasTools - Combines the common tools. }
378   TPostH2PasToolsOption = (
379     phReplaceUnitFilenameWithUnitName, // Replace "unit filename;" with "unit name;"
380     phRemoveIncludeDirectives, // remove include directives
381     phRemoveDoubleSemicolons, // Remove double semicolons
382     phRemoveSystemTypes, // Remove type redefinitons like PLongint
bodiesnull383     phFixH2PasMissingIFDEFsInUnit, // add missing IFDEFs for function bodies
384     phReduceCompilerDirectivesInUnit, // removes unneeded directives
385     phRemoveRedefinedPointerTypes, // Remove redefined pointer types
386     phRemoveEmptyTypeVarConstSections, // Remove empty type/var/const sections
387     phReplaceImplicitTypes, // Search implicit types in parameters and add types for them
388     phFixArrayOfParameterType, // Replace "array of )" with "array of const)"
389     phAddMissingPointerTypes, // add missing pointer types
390     phRemoveRedefinitionsInUnit, // Removes redefinitions of types, variables, constants and resourcestrings
391     phFixAliasDefinitionsInUnit, // fix section type of alias definitions
392     phReplaceConstFunctionsInUnit, // replace simple assignment functions with constants
393     phReplaceTypeCastFunctionsInUnit, // replace simple type cast functions with types
394     phFixForwardDefinitions, // fix forward definitions by reordering
395     phAddUnitsToUsesSection // add units to uses section
396     );
397   TPostH2PasToolsOptions = set of TPostH2PasToolsOption;
398 const
399   DefaultPostH2PasToolsOptions =
400                         [Low(TPostH2PasToolsOption)..High(TPostH2PasToolsOption)];
401 type
402   TPostH2PasTools = class(TCustomTextConverterTool)
403   private
404     FDefines: TStrings;
405     FOptions: TPostH2PasToolsOptions;
406     FUndefines: TStrings;
407     FUseUnits: TStrings;
408     procedure SetDefines(const AValue: TStrings);
409     procedure SetUndefines(const AValue: TStrings);
410     procedure SetUseUnits(const AValue: TStrings);
411   public
412     constructor Create(TheOwner: TComponent); override;
413     destructor Destroy; override;
ClassDescriptionnull414     class function ClassDescription: string; override;
Executenull415     function Execute(aText: TIDETextConverter): TModalResult; override;
416   published
417     property Undefines: TStrings read FUndefines write SetUndefines;
418     property Defines: TStrings read FDefines write SetDefines;
419     property UseUnits: TStrings read FUseUnits write SetUseUnits;
420     property Options: TPostH2PasToolsOptions read FOptions write FOptions default DefaultPostH2PasToolsOptions;
421   end;
422 
423   TH2PasFile = class;
424 
425   { TH2PasFileCInclude }
426 
427   TH2PasFileCInclude = class
428   private
429     FFilename: string;
430     FH2PasFile: TH2PasFile;
431     FOwner: TH2PasFile;
432     FSrcFilename: string;
433     FSrcPos: TPoint;
434     procedure SetFilename(const AValue: string);
435     procedure SetH2PasFile(const AValue: TH2PasFile);
436     procedure SetSrcFilename(const AValue: string);
437     procedure SetSrcPos(const AValue: TPoint);
438   public
439     constructor Create(TheOwner: TH2PasFile);
440     destructor Destroy; override;
441     property Owner: TH2PasFile read FOwner;
442     property SrcFilename: string read FSrcFilename write SetSrcFilename;
443     property SrcPos: TPoint read FSrcPos write SetSrcPos;
444     property Filename: string read FFilename write SetFilename;
445     property H2PasFile: TH2PasFile read FH2PasFile write SetH2PasFile;
446   end;
447 
448   TH2PasProject = class;
449   TH2PasConverter = class;
450 
451   { TH2PasFile }
452 
453   TH2PasFile = class(TPersistent)
454   private
455     FCIncludes: TFPList; // list of TH2PasFileCInclude
456     FCIncludesValid: boolean;
457     FCIncludesFileAge: TDateTime;
458     FCIncludedBy: TFPList; // list of TH2PasFileCInclude
459     FEnabled: boolean;
460     FFilename: string;
461     FMerge: boolean;
462     FMergedBy: TH2PasFile;
463     FModified: boolean;
464     FProject: TH2PasProject;
GetCIncludeCountnull465     function GetCIncludeCount: integer;
GetCIncludedBynull466     function GetCIncludedBy(Index: integer): TH2PasFileCInclude;
GetCIncludedByCountnull467     function GetCIncludedByCount: integer;
GetCIncludesnull468     function GetCIncludes(Index: integer): TH2PasFileCInclude;
469     procedure SetEnabled(const AValue: boolean);
470     procedure SetFilename(const AValue: string);
471     procedure SetMerge(const AValue: boolean);
472     procedure SetModified(const AValue: boolean);
473     procedure SetProject(const AValue: TH2PasProject);
474     procedure SearchCIncFilenames;
475     procedure InternalAddCIncludedBy(CIncludedBy: TH2PasFileCInclude);
476     procedure InternalRemoveCIncludedBy(CIncludedBy: TH2PasFileCInclude);
477   public
478     constructor Create;
479     destructor Destroy; override;
480     procedure Clear;
481     procedure ClearIncludedByReferences;
482     procedure ClearCIncludes;
483     procedure Assign(Source: TPersistent); override;
IsEqualnull484     function IsEqual(AFile: TH2PasFile): boolean;
485     procedure Load(Config: TConfigStorage);
486     procedure Save(Config: TConfigStorage);
GetOutputFilenamenull487     function GetOutputFilename: string;
GetOutputDirectorynull488     function GetOutputDirectory: string;
GetOutputExtensionnull489     function GetOutputExtension: string;
GetH2PasParametersnull490     function GetH2PasParameters(const InputFilename: string = ''): string;
ReadCIncludesnull491     function ReadCIncludes(ForceUpdate: boolean): TModalResult;
CIncludesValidnull492     function CIncludesValid: boolean;
FindCIncludedByWithOwnernull493     function FindCIncludedByWithOwner(ByOwner: TH2PasFile): TH2PasFileCInclude;
494   public
495     property Project: TH2PasProject read FProject write SetProject;
496     property Filename: string read FFilename write SetFilename;
497     property Enabled: boolean read FEnabled write SetEnabled;
498     property Modified: boolean read FModified write SetModified;
499     property CIncludeCount: integer read GetCIncludeCount;
500     property CIncludes[Index: integer]: TH2PasFileCInclude read GetCIncludes;
501     property CIncludedByCount: integer read GetCIncludedByCount;
502     property CIncludedBy[Index: integer]: TH2PasFileCInclude read GetCIncludedBy;
503     property Merge: boolean read FMerge write SetMerge;
504     property MergedBy: TH2PasFile read FMergedBy;// automatically chosen by the project
505   end;
506 
507   { TH2PasProject }
508 
509   TH2PasProject = class(TPersistent)
510   private
511     FBaseDir: string;
512     FCHeaderFiles: TFPList;// list of TH2PasFile
513     FCompactOutputmode: boolean;
514     FConstantsInsteadOfEnums: boolean;
515     FConverter: TH2PasConverter;
516     FCreateIncludeFile: boolean;
517     FFilename: string;
518     FIsVirtual: boolean;
519     FLibname: string;
520     FModified: boolean;
521     FOutputDirectory: string;
522     FOutputExt: string;
523     FPackAllRecords: boolean;
524     FPalmOSSYSTrap: boolean;
525     FPforPointers: boolean;
526     FPostH2PasTools: TComponent;
527     FPreH2PasTools: TComponent;
528     FStripComments: boolean;
529     FStripCommentsAndInfo: boolean;
530     FTforTypedefs: boolean;
531     FTforTypedefsRemoveUnderscore: boolean;
532     FUseExternal: boolean;
533     FUseExternalLibname: boolean;
534     FUseProcVarsForImport: boolean;
535     FVarParams: boolean;
536     FWin32Header: boolean;
537     FUseCTypes : boolean;
GetCHeaderFileCountnull538     function GetCHeaderFileCount: integer;
GetCHeaderFilesnull539     function GetCHeaderFiles(Index: integer): TH2PasFile;
540     procedure InternalAddCHeaderFile(AFile: TH2PasFile);
541     procedure InternalRemoveCHeaderFile(AFile: TH2PasFile);
542     procedure SetCompactOutputmode(const AValue: boolean);
543     procedure SetConstantsInsteadOfEnums(const AValue: boolean);
544     procedure SetCreateIncludeFile(const AValue: boolean);
545     procedure SetFilename(const AValue: string);
546     procedure SetLibname(const AValue: string);
547     procedure SetModified(const AValue: boolean);
548     procedure FilenameChanged;
549     procedure SetOutputDirectory(const AValue: string);
550     procedure SetOutputExt(const AValue: string);
551     procedure SetPackAllRecords(const AValue: boolean);
552     procedure SetPalmOSSYSTrap(const AValue: boolean);
553     procedure SetPforPointers(const AValue: boolean);
554     procedure SetStripComments(const AValue: boolean);
555     procedure SetStripCommentsAndInfo(const AValue: boolean);
556     procedure SetTforTypedefs(const AValue: boolean);
557     procedure SetTforTypedefsRemoveUnderscore(const AValue: boolean);
558     procedure SetUseExternal(const AValue: boolean);
559     procedure SetUseExternalLibname(const AValue: boolean);
560     procedure SetUseProcVarsForImport(const AValue: boolean);
561     procedure SetVarParams(const AValue: boolean);
562     procedure SetWin32Header(const AValue: boolean);
563     procedure SetUseCTypes(const AValue: boolean);
564   public
565     constructor Create;
566     destructor Destroy; override;
567     procedure Clear(AddDefaults: boolean);
568     procedure Assign(Source: TPersistent); override;
IsEqualnull569     function IsEqual(AProject: TH2PasProject): boolean;
570     procedure Load(Config: TConfigStorage);
571     procedure Save(Config: TConfigStorage);
572     procedure LoadFromFile(const AFilename: string);
573     procedure SaveToFile(const AFilename: string);
574     procedure AddFiles(List: TStrings);
575     procedure DeleteFiles(List: TStrings);
CHeaderFileWithFilenamenull576     function CHeaderFileWithFilename(const AFilename: string): TH2PasFile;
CHeaderFileIndexWithFilenamenull577     function CHeaderFileIndexWithFilename(const AFilename: string): integer;
578     procedure CHeaderFileMove(OldIndex, NewIndex: integer);
ShortenFilenamenull579     function ShortenFilename(const AFilename: string): string;
LongenFilenamenull580     function LongenFilename(const AFilename: string): string;
NormalizeFilenamenull581     function NormalizeFilename(const AFilename: string): string;
HasEnabledFilesnull582     function HasEnabledFiles: boolean;
583     procedure AddDefaultPreH2PasTools;
584     procedure AddDefaultPostH2PasTools;
SearchIncludedCHeaderFilenull585     function SearchIncludedCHeaderFile(aFile: TH2PasFile;
586                                        const SrcFilename: string): string;
ReadAllCIncludesnull587     function ReadAllCIncludes(ForceUpdate: boolean): TModalResult;
588   public
589     property CHeaderFileCount: integer read GetCHeaderFileCount;
590     property CHeaderFiles[Index: integer]: TH2PasFile read GetCHeaderFiles;
591     property Modified: boolean read FModified write SetModified;
592     property Filename: string read FFilename write SetFilename;
593     property BaseDir: string read FBaseDir;
594     property IsVirtual: boolean read FIsVirtual;
595     property Converter: TH2PasConverter read FConverter;
596     property PreH2PasTools: TComponent read FPreH2PasTools;
597     property PostH2PasTools: TComponent read FPostH2PasTools;
598 
599     // h2pas options
600     property ConstantsInsteadOfEnums: boolean read FConstantsInsteadOfEnums write SetConstantsInsteadOfEnums;
601     property CompactOutputmode: boolean read FCompactOutputmode write SetCompactOutputmode;
602     property CreateIncludeFile: boolean read FCreateIncludeFile write SetCreateIncludeFile;
603     property Libname: string read FLibname write SetLibname;
604     property OutputExt: string read FOutputExt write SetOutputExt;
605     property PalmOSSYSTrap: boolean read FPalmOSSYSTrap write SetPalmOSSYSTrap;
606     property PforPointers: boolean read FPforPointers write SetPforPointers;
607     property PackAllRecords: boolean read FPackAllRecords write SetPackAllRecords;
608     property StripComments: boolean read FStripComments write SetStripComments;
609     property StripCommentsAndInfo: boolean read FStripCommentsAndInfo write SetStripCommentsAndInfo;
610     property TforTypedefs: boolean read FTforTypedefs write SetTforTypedefs;
611     property TforTypedefsRemoveUnderscore: boolean read FTforTypedefsRemoveUnderscore write SetTforTypedefsRemoveUnderscore;
612     property UseExternal: boolean read FUseExternal write SetUseExternal;
613     property UseExternalLibname: boolean read FUseExternalLibname write SetUseExternalLibname;
614     property UseProcVarsForImport: boolean read FUseProcVarsForImport write SetUseProcVarsForImport;
615     property VarParams: boolean read FVarParams write SetVarParams;
616     property Win32Header: boolean read FWin32Header write SetWin32Header;
617     property UseCTypes: boolean read FUseCTypes write SetUseCTypes;
618     property OutputDirectory: string read FOutputDirectory write SetOutputDirectory;
619   end;
620 
621 const
622   SubToolH2Pas = 'h2pas';
623 type
624   { TH2PasParser }
625 
626   TH2PasParser = class(TExtToolParser)
627   public
DefaultSubToolnull628     class function DefaultSubTool: string; override;
629     procedure ReadLine(Line: string; OutputIndex: integer; var {%H-}Handled: boolean
630       ); override; // (worker thread)
631   end;
632 
633   { TH2PasTool }
634 
635   TH2PasTool = class(TIDEExternalToolOptions)
636   private
637     FH2PasFile: TH2PasFile;
638     FTargetFilename: string;
639   public
640     property H2PasFile: TH2PasFile read FH2PasFile write FH2PasFile;
641     property TargetFilename: string read FTargetFilename write FTargetFilename;
642   end;
643 
644   { TH2PasConverter }
645 
646   TH2PasConverter = class(TPersistent)
647   private
648     FAutoOpenLastProject: boolean;
649     FExecuting: boolean;
650     Fh2pasFilename: string;
651     FLastUsedFilename: string;
652     FModified: boolean;
653     FProject: TH2PasProject;
654     FProjectHistory: TStrings;
655     FWindowBounds: TRect;
GetCurrentProjectFilenamenull656     function GetCurrentProjectFilename: string;
657     procedure SetAutoOpenLastProject(const AValue: boolean);
658     procedure SetCurrentProjectFilename(const AValue: string);
659     procedure SetProject(const AValue: TH2PasProject);
660     procedure SetProjectHistory(const AValue: TStrings);
661     procedure SetWindowBounds(const AValue: TRect);
662     procedure Seth2pasFilename(const AValue: string);
663   public
664     constructor Create;
665     destructor Destroy; override;
666     procedure Clear;
667     procedure Assign(Source: TPersistent); override;
IsEqualnull668     function IsEqual(AConverter: TH2PasConverter): boolean;
669     procedure Load(Config: TConfigStorage);
670     procedure Save(Config: TConfigStorage);
671     procedure LoadFromFile(const AFilename: string);
672     procedure SaveToFile(const AFilename: string);
673     procedure LoadProject(const Filename: string);
674     procedure SaveProject(const Filename: string);
Executenull675     function Execute: TModalResult;
ConvertFilenull676     function ConvertFile(AFile: TH2PasFile): TModalResult;
CheckMergeDependenciesnull677     function CheckMergeDependencies: TModalResult;
MergeIncludeFilesnull678     function MergeIncludeFiles(AFile: TH2PasFile;
679                                TextConverter: TIDETextConverter): TModalResult;
GetH2PasFilenamenull680     function GetH2PasFilename: string;
FileIsRelatednull681     function FileIsRelated(const aFilename: string): Boolean;
682   public
683     property Project: TH2PasProject read FProject write SetProject;
684     property ProjectHistory: TStrings read FProjectHistory write SetProjectHistory;
685     property CurrentProjectFilename: string read GetCurrentProjectFilename
686                                             write SetCurrentProjectFilename;
687     property WindowBounds: TRect read FWindowBounds write SetWindowBounds;
688     property AutoOpenLastProject: boolean read FAutoOpenLastProject
689                                           write SetAutoOpenLastProject;
690     property h2pasFilename: string read Fh2pasFilename write Seth2pasFilename;
691     property Modified: boolean read FModified write FModified;
692     property Executing: boolean read FExecuting;
693     property LastUsedFilename: string read FLastUsedFilename;
694   end;
695 
696 const
697   PreDefinedH2PasTypes: array[1..10] of string = (
698     'Char',
699     'Byte',
700     'SmallInt',
701     'Word',
702     'Longint',
703     'DWord',
704     'Int64',
705     'QWord',
706     'Single',
707     'Double'
708     );
709 
710 implementation
711 
712 { TH2PasParser }
713 
TH2PasParser.DefaultSubToolnull714 class function TH2PasParser.DefaultSubTool: string;
715 begin
716   Result:=SubToolH2Pas;
717 end;
718 
719 procedure TH2PasParser.ReadLine(Line: string; OutputIndex: integer;
720   var Handled: boolean);
721 
ReadStringnull722   function ReadString(var p: PChar; Expected: PChar): boolean;
723   begin
724     while Expected^<>#0 do begin
725       if p^<>Expected^ then exit(false);
726       inc(p);
727       inc(Expected);
728     end;
729     Result:=true;
730   end;
731 
732 var
733   p: PChar;
734   LineNumber: Integer;
735   Msg: String;
736   MsgLine: TMessageLine;
737 begin
738   p:=PChar(Line);
739   // read 'at line '
740   if not ReadString(p,'at line ') then exit;
741   // read line number
742   if not (p^ in ['0'..'9']) then exit;
743   LineNumber:=0;
744   while (LineNumber<999999) and (p^ in ['0'..'9']) do begin
745     LineNumber:=LineNumber*10+ord(p^)-ord('0');
746     inc(p);
747   end;
748   // read ' error : '
749   if not ReadString(p,' error : ') then exit;
750   Msg:=p;
751   MsgLine:=CreateMsgLine(OutputIndex);
752   MsgLine.SubTool:=SubToolH2Pas;
753   MsgLine.Urgency:=mluError;
754   MsgLine.Msg:=Msg;
755 end;
756 
757 { TH2PasFile }
758 
759 procedure TH2PasFile.SetFilename(const AValue: string);
760 var
761   NewValue: String;
762 begin
763   NewValue:=TrimFilename(AValue);
764   if FFilename=NewValue then exit;
765   FFilename:=NewValue;
766   FCIncludesValid:=false;
767   Modified:=true;
768 end;
769 
770 procedure TH2PasFile.SetMerge(const AValue: boolean);
771 begin
772   if FMerge=AValue then exit;
773   FMerge:=AValue;
774   Modified:=true;
775 end;
776 
777 procedure TH2PasFile.SetEnabled(const AValue: boolean);
778 begin
779   if FEnabled=AValue then exit;
780   FEnabled:=AValue;
781   Modified:=true;
782 end;
783 
TH2PasFile.GetCIncludeCountnull784 function TH2PasFile.GetCIncludeCount: integer;
785 begin
786   if (FCIncludes=nil) or (not FCIncludesValid) then
787     Result:=0
788   else
789     Result:=FCIncludes.Count;
790 end;
791 
TH2PasFile.GetCIncludedBynull792 function TH2PasFile.GetCIncludedBy(Index: integer): TH2PasFileCInclude;
793 begin
794   Result:=TH2PasFileCInclude(FCIncludedBy[Index]);
795 end;
796 
TH2PasFile.GetCIncludedByCountnull797 function TH2PasFile.GetCIncludedByCount: integer;
798 begin
799   if (FCIncludedBy=nil) then
800     Result:=0
801   else
802     Result:=FCIncludedBy.Count;
803 end;
804 
GetCIncludesnull805 function TH2PasFile.GetCIncludes(Index: integer): TH2PasFileCInclude;
806 begin
807   Result:=TH2PasFileCInclude(FCIncludes[Index]);
808 end;
809 
810 procedure TH2PasFile.SetModified(const AValue: boolean);
811 begin
812   if FModified=AValue then exit;
813   FModified:=AValue;
814   if FModified and (Project<>nil) then
815     Project.Modified:=true;
816 end;
817 
818 procedure TH2PasFile.SetProject(const AValue: TH2PasProject);
819 begin
820   if FProject=AValue then exit;
821   FCIncludesValid:=false;
822   if FProject<>nil then begin
823     FProject.InternalRemoveCHeaderFile(Self);
824   end;
825   FProject:=AValue;
826   if FProject<>nil then begin
827     FProject.InternalAddCHeaderFile(Self);
828   end;
829   Modified:=true;
830 end;
831 
832 procedure TH2PasFile.SearchCIncFilenames;
833 var
834   i: Integer;
835   IncFile: TH2PasFileCInclude;
836 begin
837   if FCIncludes=nil then exit;
838   if Project=nil then exit;
839   for i:=0 to FCIncludes.Count-1 do begin
840     IncFile:=CIncludes[i];
841     IncFile.Filename:=
842                     Project.SearchIncludedCHeaderFile(Self,IncFile.SrcFilename);
843     IncFile.H2PasFile:=Project.CHeaderFileWithFilename(IncFile.Filename);
844   end;
845 end;
846 
847 procedure TH2PasFile.InternalAddCIncludedBy(CIncludedBy: TH2PasFileCInclude);
848 begin
849   if FCIncludedBy=nil then
850     FCIncludedBy:=TFPList.Create;
851   FCIncludedBy.Add(CIncludedBy);
852   //DebugLn(['TH2PasFile.InternalAddCIncludedBy ',Filename,' included by ',CIncludedBy.Filename]);
853 end;
854 
855 procedure TH2PasFile.InternalRemoveCIncludedBy(CIncludedBy: TH2PasFileCInclude);
856 begin
857   if FCIncludedBy=nil then exit;
858   FCIncludedBy.Remove(CIncludedBy);
859 end;
860 
861 constructor TH2PasFile.Create;
862 begin
863   Clear;
864 end;
865 
866 destructor TH2PasFile.Destroy;
867 begin
868   if FProject<>nil then begin
869     Project:=nil;
870   end;
871   Clear;
872   ClearIncludedByReferences;
873   FCIncludedBy.Free;
874   inherited Destroy;
875 end;
876 
877 procedure TH2PasFile.Clear;
878 begin
879   FEnabled:=true;
880   FFilename:='';
881   FModified:=false;
882   FMerge:=false;
883   FMergedBy:=nil;
884   ClearCIncludes;
885 end;
886 
887 procedure TH2PasFile.ClearIncludedByReferences;
888 var
889   i: Integer;
890   IncFile: TH2PasFileCInclude;
891 begin
892   if FCIncludedBy=nil then exit;
893   for i:=FCIncludedBy.Count-1 downto 0 do begin
894     IncFile:=TH2PasFileCInclude(FCIncludedBy[i]);
895     if IncFile=nil then continue;
896     IncFile.FH2PasFile:=nil;
897   end;
898   FCIncludedBy.Clear;
899 end;
900 
901 procedure TH2PasFile.ClearCIncludes;
902 var
903   i: Integer;
904   IncFile: TH2PasFileCInclude;
905 begin
906   FCIncludesValid:=false;
907   if FCIncludes<>nil then begin
908     for i:=0 to FCIncludes.Count-1 do begin
909       IncFile:=TH2PasFileCInclude(FCIncludes[i]);
910       IncFile.Free;
911     end;
912     FreeAndNil(FCIncludes);
913   end;
914 end;
915 
916 procedure TH2PasFile.Assign(Source: TPersistent);
917 var
918   Src: TH2PasFile;
919 begin
920   if Source is TH2PasFile then begin
921     Src:=TH2PasFile(Source);
922     if not IsEqual(Src) then begin
923       FEnabled:=Src.FEnabled;
924       FFilename:=Src.FFilename;
925       FCIncludesValid:=false;
926       Modified:=true;
927     end;
928   end else begin
929     inherited Assign(Source);
930   end;
931 end;
932 
TH2PasFile.IsEqualnull933 function TH2PasFile.IsEqual(AFile: TH2PasFile): boolean;
934 begin
935   Result:=(CompareFilenames(Filename,AFile.Filename)=0)
936           and (Enabled=AFile.Enabled)
937           and (Merge=AFile.Merge);
938 end;
939 
940 procedure TH2PasFile.Load(Config: TConfigStorage);
941 begin
942   FEnabled:=Config.GetValue('Enabled/Value',true);
943   FMerge:=Config.GetValue('Merge/Value',true);
944   FFilename:=Config.GetValue('Filename/Value','');
945   if Project<>nil then
946     FFilename:=Project.NormalizeFilename(FFilename);
947   FCIncludesValid:=false;
948   FModified:=false;
949 end;
950 
951 procedure TH2PasFile.Save(Config: TConfigStorage);
952 var
953   AFilename: String;
954 begin
955   Config.SetDeleteValue('Enabled/Value',Enabled,true);
956   Config.SetDeleteValue('Merge/Value',Merge,true);
957   AFilename:=FFilename;
958   if Project<>nil then
959     AFilename:=Project.ShortenFilename(AFilename);
960   Config.SetDeleteValue('Filename/Value',AFilename,'');
961   FModified:=false;
962 end;
963 
TH2PasFile.GetOutputFilenamenull964 function TH2PasFile.GetOutputFilename: string;
965 begin
966   Result:=GetOutputDirectory+ExtractFileNameOnly(Filename)+GetOutputExtension;
967 end;
968 
TH2PasFile.GetOutputDirectorynull969 function TH2PasFile.GetOutputDirectory: string;
970 begin
971   Result:=Project.OutputDirectory;
972   if Result='' then
973     Result:=Project.BaseDir;
974 end;
975 
GetOutputExtensionnull976 function TH2PasFile.GetOutputExtension: string;
977 begin
978   Result:=Project.OutputExt;
979 end;
980 
TH2PasFile.GetH2PasParametersnull981 function TH2PasFile.GetH2PasParameters(const InputFilename: string): string;
982 
983   procedure Add(const AnOption: string);
984   begin
985     if Result<>'' then
986       Result:=Result+' ';
987     Result:=Result+AnOption;
988   end;
989 
990 begin
991   Result:='';
992   if Project.ConstantsInsteadOfEnums then Add('-e');
993   if Project.CompactOutputmode then Add('-c');
994   if Project.CreateIncludeFile then Add('-i');
995   if Project.PalmOSSYSTrap then Add('-x');
996   if Project.PforPointers then Add('-p');
997   if Project.PackAllRecords then Add('-pr');
998   if Project.StripComments then Add('-s');
999   if Project.StripCommentsAndInfo then Add('-S');
1000   if Project.TforTypedefs then Add('-t');
1001   if Project.TforTypedefsRemoveUnderscore then Add('-T');
1002   if Project.UseExternal then Add('-d');
1003   if Project.UseExternalLibname then Add('-D');
1004   if Project.UseProcVarsForImport then Add('-P');
1005   if Project.VarParams then Add('-v');
1006   if Project.Win32Header then Add('-w');
1007   if Project.UseCTypes then Add('-C');
1008   if Project.Libname<>'' then Add('-l '+Project.Libname);
1009   Add('-o '+GetOutputFilename);
1010   if InputFilename<>'' then
1011     Add(InputFilename)
1012   else
1013     Add(Filename);
1014 end;
1015 
ReadCIncludesnull1016 function TH2PasFile.ReadCIncludes(ForceUpdate: boolean): TModalResult;
1017 var
1018   sl: TStringList;
1019   i: Integer;
1020   SrcFilename: String;
1021   Item: TH2PasFileCInclude;
1022 begin
1023   if (not ForceUpdate) and CIncludesValid then exit(mrOk);
1024   Result:=mrCancel;
1025   if not FileExistsCached(Filename) then exit;
1026   ClearCIncludes;
1027   FCIncludesFileAge:=FileAgeUTF8(Filename);
1028   FCIncludesValid:=true;
1029   //DebugLn(['TH2PasFile.ReadCIncludes Filename="',Filename,'"']);
1030   try
1031     sl:=TStringListUTF8.Create;
1032     try
1033       sl.LoadFromFile(Filename);
1034       for i:=0 to sl.Count-1 do begin
1035         if not REMatches(sl[i],'^#include "(.+)"') then continue;
1036         SrcFilename:=Trim(REVar(1));
1037         if SrcFilename='' then continue;
1038         // add new include
1039         if FCIncludes=nil then FCIncludes:=TFPList.Create;
1040         Item:=TH2PasFileCInclude.Create(Self);
1041         Item.SrcFilename:=SrcFilename;
1042         Item.SrcPos:=Point(1,i);
1043         //DebugLn(['TH2PasFile.ReadCIncludes Self=',Filename,' include=',SrcFilename,' ',dbgs(Item.SrcPos)]);
1044         FCIncludes.Add(Item);
1045       end;
1046     finally
1047       sl.Free;
1048     end;
1049     SearchCIncFilenames;
1050     Result:=mrOk;
1051   except
1052     on e: Exception do begin
1053       DebugLn(['TH2PasFile.ReadCIncludes File="',Filename,'" Msg=',E.Message]);
1054     end;
1055   end;
1056 end;
1057 
TH2PasFile.CIncludesValidnull1058 function TH2PasFile.CIncludesValid: boolean;
1059 begin
1060   Result:=false;
1061   if not FCIncludesValid then exit;
1062   FCIncludesValid:=false;
1063   if Project=nil then exit;
1064   if (not FileExistsCached(Filename)) then exit;
1065   if FileAgeUTF8(Filename)>FCIncludesFileAge then exit;
1066   FCIncludesValid:=true;
1067   Result:=true;
1068 end;
1069 
TH2PasFile.FindCIncludedByWithOwnernull1070 function TH2PasFile.FindCIncludedByWithOwner(ByOwner: TH2PasFile
1071   ): TH2PasFileCInclude;
1072 var
1073   i: Integer;
1074 begin
1075   if FCIncludedBy<>nil then begin
1076     for i:=0 to CIncludedByCount-1 do begin
1077       Result:=CIncludedBy[i];
1078       if Result.Owner=ByOwner then exit;
1079     end;
1080   end;
1081   Result:=nil;
1082 end;
1083 
1084 { TH2PasProject }
1085 
TH2PasProject.GetCHeaderFileCountnull1086 function TH2PasProject.GetCHeaderFileCount: integer;
1087 begin
1088   Result:=FCHeaderFiles.Count;
1089 end;
1090 
TH2PasProject.GetCHeaderFilesnull1091 function TH2PasProject.GetCHeaderFiles(Index: integer): TH2PasFile;
1092 begin
1093   Result:=TH2PasFile(FCHeaderFiles[Index]);
1094 end;
1095 
1096 procedure TH2PasProject.InternalAddCHeaderFile(AFile: TH2PasFile);
1097 begin
1098   FCHeaderFiles.Add(AFile);
1099 end;
1100 
1101 procedure TH2PasProject.InternalRemoveCHeaderFile(AFile: TH2PasFile);
1102 begin
1103   FCHeaderFiles.Remove(AFile);
1104 end;
1105 
1106 procedure TH2PasProject.SetCompactOutputmode(const AValue: boolean);
1107 begin
1108   if FCompactOutputmode=AValue then exit;
1109   FCompactOutputmode:=AValue;
1110   Modified:=true;
1111 end;
1112 
1113 procedure TH2PasProject.SetConstantsInsteadOfEnums(const AValue: boolean);
1114 begin
1115   if FConstantsInsteadOfEnums=AValue then exit;
1116   FConstantsInsteadOfEnums:=AValue;
1117   Modified:=true;
1118 end;
1119 
1120 procedure TH2PasProject.SetCreateIncludeFile(const AValue: boolean);
1121 begin
1122   if FCreateIncludeFile=AValue then exit;
1123   FCreateIncludeFile:=AValue;
1124   Modified:=true;
1125 end;
1126 
1127 procedure TH2PasProject.SetFilename(const AValue: string);
1128 var
1129   NewValue: String;
1130 begin
1131   NewValue:=TrimFilename(AValue);
1132   if FFilename=NewValue then exit;
1133   FFilename:=NewValue;
1134   FilenameChanged;
1135   Modified:=true;
1136 end;
1137 
1138 procedure TH2PasProject.SetLibname(const AValue: string);
1139 begin
1140   if FLibname=AValue then exit;
1141   FLibname:=AValue;
1142   Modified:=true;
1143 end;
1144 
1145 procedure TH2PasProject.SetModified(const AValue: boolean);
1146 begin
1147   if FModified=AValue then exit;
1148   FModified:=AValue;
1149 end;
1150 
1151 procedure TH2PasProject.FilenameChanged;
1152 begin
1153   FIsVirtual:=(FFilename='') or (not FilenameIsAbsolute(FFilename));
1154   FBaseDir:=ExtractFilePath(FFilename);
1155 end;
1156 
1157 procedure TH2PasProject.SetOutputDirectory(const AValue: string);
1158 begin
1159   if FOutputDirectory=AValue then exit;
1160   FOutputDirectory:=AValue;
1161   Modified:=true;
1162 end;
1163 
1164 procedure TH2PasProject.SetOutputExt(const AValue: string);
1165 begin
1166   if FOutputExt=AValue then exit;
1167   FOutputExt:=AValue;
1168   Modified:=true;
1169 end;
1170 
1171 procedure TH2PasProject.SetPackAllRecords(const AValue: boolean);
1172 begin
1173   if FPackAllRecords=AValue then exit;
1174   FPackAllRecords:=AValue;
1175   Modified:=true;
1176 end;
1177 
1178 procedure TH2PasProject.SetPalmOSSYSTrap(const AValue: boolean);
1179 begin
1180   if FPalmOSSYSTrap=AValue then exit;
1181   FPalmOSSYSTrap:=AValue;
1182   Modified:=true;
1183 end;
1184 
1185 procedure TH2PasProject.SetPforPointers(const AValue: boolean);
1186 begin
1187   if FPforPointers=AValue then exit;
1188   FPforPointers:=AValue;
1189   Modified:=true;
1190 end;
1191 
1192 procedure TH2PasProject.SetStripComments(const AValue: boolean);
1193 begin
1194   if FStripComments=AValue then exit;
1195   FStripComments:=AValue;
1196   Modified:=true;
1197 end;
1198 
1199 procedure TH2PasProject.SetStripCommentsAndInfo(const AValue: boolean);
1200 begin
1201   if FStripCommentsAndInfo=AValue then exit;
1202   FStripCommentsAndInfo:=AValue;
1203   Modified:=true;
1204 end;
1205 
1206 procedure TH2PasProject.SetTforTypedefs(const AValue: boolean);
1207 begin
1208   if FTforTypedefs=AValue then exit;
1209   FTforTypedefs:=AValue;
1210   Modified:=true;
1211 end;
1212 
1213 procedure TH2PasProject.SetTforTypedefsRemoveUnderscore(const AValue: boolean);
1214 begin
1215   if FTforTypedefsRemoveUnderscore=AValue then exit;
1216   FTforTypedefsRemoveUnderscore:=AValue;
1217   Modified:=true;
1218 end;
1219 
1220 procedure TH2PasProject.SetUseExternal(const AValue: boolean);
1221 begin
1222   if FUseExternal=AValue then exit;
1223   FUseExternal:=AValue;
1224   Modified:=true;
1225 end;
1226 
1227 procedure TH2PasProject.SetUseExternalLibname(const AValue: boolean);
1228 begin
1229   if FUseExternalLibname=AValue then exit;
1230   FUseExternalLibname:=AValue;
1231   Modified:=true;
1232 end;
1233 
1234 procedure TH2PasProject.SetUseProcVarsForImport(const AValue: boolean);
1235 begin
1236   if FUseProcVarsForImport=AValue then exit;
1237   FUseProcVarsForImport:=AValue;
1238   Modified:=true;
1239 end;
1240 
1241 procedure TH2PasProject.SetVarParams(const AValue: boolean);
1242 begin
1243   if FVarParams=AValue then exit;
1244   FVarParams:=AValue;
1245   Modified:=true;
1246 end;
1247 
1248 procedure TH2PasProject.SetWin32Header(const AValue: boolean);
1249 begin
1250   if FWin32Header=AValue then exit;
1251   FWin32Header:=AValue;
1252   Modified:=true;
1253 end;
1254 
1255 procedure TH2PasProject.SetUseCTypes(const AValue: boolean);
1256 begin
1257   if FUseCTypes=AValue then exit;
1258   FUseCTypes:=AValue;
1259   Modified:=true;
1260 end;
1261 
1262 constructor TH2PasProject.Create;
1263 begin
1264   FCHeaderFiles:=TFPList.Create;
1265   Clear(true);
1266 end;
1267 
1268 destructor TH2PasProject.Destroy;
1269 begin
1270   Clear(false);
1271   if (Converter<>nil) and (Converter.Project=Self) then
1272     Converter.Project:=nil;
1273   FreeAndNil(FCHeaderFiles);
1274   FreeAndNil(FPreH2PasTools);
1275   FreeAndNil(FPostH2PasTools);
1276   inherited Destroy;
1277 end;
1278 
1279 procedure TH2PasProject.Clear(AddDefaults: boolean);
1280 begin
1281   // FFilename is kept
1282   FConstantsInsteadOfEnums:=true;
1283   FCompactOutputmode:=false;
1284   FCreateIncludeFile:=false;
1285   FLibname:='';
1286   FOutputExt:='.pas';
1287   FPackAllRecords:=false;
1288   FPalmOSSYSTrap:=false;
1289   FPforPointers:=true;
1290   FStripComments:=false;
1291   FStripCommentsAndInfo:=false;
1292   FTforTypedefs:=false;
1293   FTforTypedefsRemoveUnderscore:=false;
1294   FUseExternal:=false;
1295   FUseExternalLibname:=true;
1296   FUseProcVarsForImport:=false;
1297   FVarParams:=false;
1298   FWin32Header:=true;
1299   FUseCTypes:=false;
1300   FOutputDirectory:='';
1301   while CHeaderFileCount>0 do
1302     CHeaderFiles[CHeaderFileCount-1].Free;
1303   FPreH2PasTools.Free;
1304   FPreH2PasTools:=TComponent.Create(nil);
1305   FPostH2PasTools.Free;
1306   FPostH2PasTools:=TComponent.Create(nil);
1307   if AddDefaults then
1308   begin
1309     AddDefaultPreH2PasTools;
1310     AddDefaultPostH2PasTools;
1311   end;
1312   FModified:=false;
1313 end;
1314 
1315 procedure TH2PasProject.Assign(Source: TPersistent);
1316 
1317   procedure CopyTools(SrcList: TComponent; var DestList: TComponent);
1318   var
1319     SrcComponent: TComponent;
1320     NewComponent: TObject;
1321     i: Integer;
1322   begin
1323     DestList.Free;
1324     DestList:=TComponent.Create(nil);
1325     for i:=0 to SrcList.ComponentCount-1 do begin
1326       SrcComponent:=SrcList.Components[i];
1327       if SrcComponent is TCustomTextConverterTool then begin
1328         NewComponent:=
1329                TComponentClass(SrcComponent.ClassType).Create(DestList);
1330         TCustomTextConverterTool(NewComponent).Assign(SrcComponent);
1331       end;
1332     end;
1333   end;
1334 
1335 var
1336   Src: TH2PasProject;
1337   i: Integer;
1338   NewCHeaderFile: TH2PasFile;
1339 begin
1340   if Source is TH2PasProject then begin
1341     Src:=TH2PasProject(Source);
1342     if not IsEqual(Src) then begin
1343       // FFilename is kept
1344       FConstantsInsteadOfEnums:=Src.FConstantsInsteadOfEnums;
1345       FCompactOutputmode:=Src.FCompactOutputmode;
1346       FCreateIncludeFile:=Src.FCreateIncludeFile;
1347       FLibname:=Src.FLibname;
1348       FOutputExt:=Src.FOutputExt;
1349       FPackAllRecords:=Src.FPackAllRecords;
1350       FPalmOSSYSTrap:=Src.FPalmOSSYSTrap;
1351       FPforPointers:=Src.FPforPointers;
1352       FStripComments:=Src.FStripComments;
1353       FStripCommentsAndInfo:=Src.FStripCommentsAndInfo;
1354       FTforTypedefs:=Src.FTforTypedefs;
1355       FTforTypedefsRemoveUnderscore:=Src.FTforTypedefsRemoveUnderscore;
1356       FUseExternal:=Src.FUseExternal;
1357       FUseExternalLibname:=Src.FUseExternalLibname;
1358       FUseProcVarsForImport:=Src.FUseProcVarsForImport;
1359       FVarParams:=Src.FVarParams;
1360       FWin32Header:=Src.FWin32Header;
1361       FUseCTypes:=Src.FUseCTypes;
1362       FOutputDirectory:=Src.FOutputDirectory;
1363       Clear(false);
1364       for i:=0 to Src.CHeaderFileCount-1 do begin
1365         NewCHeaderFile:=TH2PasFile.Create;
1366         NewCHeaderFile.Project:=Self;
1367         NewCHeaderFile.Assign(Src.CHeaderFiles[i]);
1368       end;
1369       CopyTools(Src.FPreH2PasTools,FPreH2PasTools);
1370       CopyTools(Src.FPostH2PasTools,FPostH2PasTools);
1371       Modified:=true;
1372     end;
1373   end else begin
1374     inherited Assign(Source);
1375   end;
1376 end;
1377 
TH2PasProject.IsEqualnull1378 function TH2PasProject.IsEqual(AProject: TH2PasProject): boolean;
1379 var
1380   i: Integer;
1381 begin
1382   Result:=(AProject.CHeaderFileCount=CHeaderFileCount)
1383       and (FConstantsInsteadOfEnums=AProject.FConstantsInsteadOfEnums)
1384       and (FCompactOutputmode=AProject.FCompactOutputmode)
1385       and (FCreateIncludeFile=AProject.FCreateIncludeFile)
1386       and (FLibname=AProject.FLibname)
1387       and (FOutputExt=AProject.FOutputExt)
1388       and (FPackAllRecords=AProject.FPackAllRecords)
1389       and (FPalmOSSYSTrap=AProject.FPalmOSSYSTrap)
1390       and (FPforPointers=AProject.FPforPointers)
1391       and (FStripComments=AProject.FStripComments)
1392       and (FStripCommentsAndInfo=AProject.FStripCommentsAndInfo)
1393       and (FTforTypedefs=AProject.FTforTypedefs)
1394       and (FTforTypedefsRemoveUnderscore=AProject.FTforTypedefsRemoveUnderscore)
1395       and (FUseExternal=AProject.FUseExternal)
1396       and (FUseExternalLibname=AProject.FUseExternalLibname)
1397       and (FUseProcVarsForImport=AProject.FUseProcVarsForImport)
1398       and (FVarParams=AProject.FVarParams)
1399       and (FWin32Header=AProject.FWin32Header)
1400       and (FUseCTypes=AProject.FUseCTypes)
1401       and (FOutputDirectory=AProject.FOutputDirectory);
1402   if not Result then exit;
1403   for i:=0 to CHeaderFileCount-1 do
1404     if not CHeaderFiles[i].IsEqual(AProject.CHeaderFiles[i]) then
1405       exit(false);
1406   if (not CompareComponents(FPreH2PasTools,AProject.FPreH2PasTools))
1407   or (not CompareComponents(FPostH2PasTools,AProject.FPostH2PasTools)) then
1408     exit(false);
1409 end;
1410 
1411 procedure TH2PasProject.Load(Config: TConfigStorage);
1412   procedure LoadTools(const SubPath: string; List: TComponent);
1413   var
1414     NewComponent: TComponent;
1415     NewCount: LongInt;
1416     i: Integer;
1417   begin
1418     // load PreH2PasTools
1419     Config.AppendBasePath(SubPath);
1420     try
1421       NewCount:=Config.GetValue('Count',0);
1422       for i:=0 to NewCount-1 do begin
1423         Config.AppendBasePath('Tool'+IntToStr(i+1));
1424         try
1425           NewComponent:=nil;
1426           LoadComponentFromConfig(Config,'Value',NewComponent,
1427                                   @TextConverterToolClasses.FindClass,List);
1428         finally
1429           Config.UndoAppendBasePath;
1430         end;
1431       end;
1432     finally
1433       Config.UndoAppendBasePath;
1434     end;
1435   end;
1436 
1437 var
1438   NewCount: LongInt;
1439   i: Integer;
1440   NewCHeaderFile: TH2PasFile;
1441 begin
1442   Clear(false);
1443 
1444   // FFilename is not saved
1445   FConstantsInsteadOfEnums:=Config.GetValue('ConstantsInsteadOfEnums/Value',true);
1446   FCompactOutputmode:=Config.GetValue('CompactOutputmode/Value',false);
1447   FCreateIncludeFile:=Config.GetValue('CreateIncludeFile/Value',false);
1448   FLibname:=Config.GetValue('Libname/Value','');
1449   FOutputExt:=Config.GetValue('OutputExt/Value','.pas');
1450   FPackAllRecords:=Config.GetValue('PackAllRecords/Value',false);
1451   FPalmOSSYSTrap:=Config.GetValue('PalmOSSYSTrap/Value',false);
1452   FPforPointers:=Config.GetValue('PforPointers/Value',true);
1453   FStripComments:=Config.GetValue('StripComments/Value',false);
1454   FStripCommentsAndInfo:=Config.GetValue('StripCommentsAndInfo/Value',false);
1455   FTforTypedefs:=Config.GetValue('TforTypedefs/Value',false);
1456   FTforTypedefsRemoveUnderscore:=Config.GetValue('TforTypedefsRemoveUnderscore/Value',false);
1457   FUseExternal:=Config.GetValue('UseExternal/Value',false);
1458   FUseExternalLibname:=Config.GetValue('UseExternalLibname/Value',true);
1459   FUseProcVarsForImport:=Config.GetValue('UseProcVarsForImport/Value',false);
1460   FVarParams:=Config.GetValue('VarParams/Value',false);
1461   FWin32Header:=Config.GetValue('Win32Header/Value',true);
1462   FUseCTypes:=Config.GetValue('UseCTypes/Value',false);
1463   FOutputDirectory:=NormalizeFilename(Config.GetValue('OutputDirectory/Value',''));
1464 
1465   // load CHeaderFiles
1466   Config.AppendBasePath('CHeaderFiles');
1467   try
1468     NewCount:=Config.GetValue('Count',0);
1469     for i:=0 to NewCount-1 do begin
1470       Config.AppendBasePath('File'+IntToStr(i+1));
1471       try
1472         NewCHeaderFile:=TH2PasFile.Create;
1473         NewCHeaderFile.Project:=Self;
1474         NewCHeaderFile.Load(Config);
1475       finally
1476         Config.UndoAppendBasePath;
1477       end;
1478     end;
1479   finally
1480     Config.UndoAppendBasePath;
1481   end;
1482 
1483   LoadTools('PreH2PasTools',FPreH2PasTools);
1484   LoadTools('PostH2PasTools',FPostH2PasTools);
1485 
1486   FModified:=false;
1487 end;
1488 
1489 procedure TH2PasProject.Save(Config: TConfigStorage);
1490 
1491   procedure SaveTools(const SubPath: string; List: TComponent);
1492   var
1493     i: Integer;
1494   begin
1495     Config.AppendBasePath(SubPath);
1496     try
1497       Config.SetDeleteValue('Count',List.ComponentCount,0);
1498       for i:=0 to List.ComponentCount-1 do begin
1499         Config.AppendBasePath('Tool'+IntToStr(i+1));
1500         try
1501           SaveComponentToConfig(Config,'Value',List.Components[i]);
1502         finally
1503           Config.UndoAppendBasePath;
1504         end;
1505       end;
1506     finally
1507       Config.UndoAppendBasePath;
1508     end;
1509   end;
1510 
1511 var
1512   i: Integer;
1513 begin
1514   // FFilename is kept
1515   Config.SetDeleteValue('ConstantsInsteadOfEnums/Value',FConstantsInsteadOfEnums,true);
1516   Config.SetDeleteValue('CompactOutputmode/Value',FCompactOutputmode,false);
1517   Config.SetDeleteValue('CreateIncludeFile/Value',FCreateIncludeFile,false);
1518   Config.SetDeleteValue('Libname/Value',FLibname,'');
1519   Config.SetDeleteValue('OutputExt/Value',FOutputExt,'.pas');
1520   Config.SetDeleteValue('PackAllRecords/Value',FPackAllRecords,false);
1521   Config.SetDeleteValue('PalmOSSYSTrap/Value',FPalmOSSYSTrap,false);
1522   Config.SetDeleteValue('PforPointers/Value',FPforPointers,true);
1523   Config.SetDeleteValue('StripComments/Value',FStripComments,false);
1524   Config.SetDeleteValue('StripCommentsAndInfo/Value',FStripCommentsAndInfo,false);
1525   Config.SetDeleteValue('TforTypedefs/Value',FTforTypedefs,false);
1526   Config.SetDeleteValue('TforTypedefsRemoveUnderscore/Value',FTforTypedefsRemoveUnderscore,false);
1527   Config.SetDeleteValue('UseExternal/Value',FUseExternal,false);
1528   Config.SetDeleteValue('UseExternalLibname/Value',FUseExternalLibname,true);
1529   Config.SetDeleteValue('UseProcVarsForImport/Value',FUseProcVarsForImport,false);
1530   Config.SetDeleteValue('VarParams/Value',FVarParams,false);
1531   Config.SetDeleteValue('Win32Header/Value',FWin32Header,true);
1532   Config.SetDeleteValue('UseCTypes/Value',FUseCTypes,false);
1533   Config.SetDeleteValue('OutputDirectory/Value',ShortenFilename(FOutputDirectory),'');
1534 
1535   // save CHeaderFiles
1536   Config.AppendBasePath('CHeaderFiles');
1537   try
1538     Config.SetDeleteValue('Count',CHeaderFileCount,0);
1539     for i:=0 to CHeaderFileCount-1 do begin
1540       Config.AppendBasePath('File'+IntToStr(i+1));
1541       try
1542         CHeaderFiles[i].Save(Config);
1543       finally
1544         Config.UndoAppendBasePath;
1545       end;
1546     end;
1547   finally
1548     Config.UndoAppendBasePath;
1549   end;
1550 
1551   SaveTools('PreH2PasTools',FPreH2PasTools);
1552   SaveTools('PostH2PasTools',FPostH2PasTools);
1553   FModified:=false;
1554 end;
1555 
1556 procedure TH2PasProject.LoadFromFile(const AFilename: string);
1557 var
1558   Config: TXMLConfigStorage;
1559 begin
1560   Config:=TXMLConfigStorage.Create(AFilename,true);
1561   try
1562     Load(Config);
1563   finally
1564     Config.Free;
1565   end;
1566 end;
1567 
1568 procedure TH2PasProject.SaveToFile(const AFilename: string);
1569 var
1570   Config: TXMLConfigStorage;
1571 begin
1572   Config:=TXMLConfigStorage.Create(AFilename,false);
1573   try
1574     Save(Config);
1575     DebugLn(['TH2PasProject.SaveToFile ',AFilename]);
1576     Config.WriteToDisk;
1577   finally
1578     Config.Free;
1579   end;
1580 end;
1581 
1582 procedure TH2PasProject.AddFiles(List: TStrings);
1583 var
1584   i: Integer;
1585   NewFilename: string;
1586   NewFile: TH2PasFile;
1587 begin
1588   if List=nil then exit;
1589   for i:=0 to List.Count-1 do begin
1590     NewFilename:=CleanAndExpandFilename(List[i]);
1591     if (NewFilename='') or (not FileExistsUTF8(NewFilename)) then exit;
1592     if CHeaderFileWithFilename(NewFilename)<>nil then exit;
1593     NewFile:=TH2PasFile.Create;
1594     NewFile.Project:=Self;
1595     NewFile.Filename:=NewFilename;
1596   end;
1597 end;
1598 
1599 procedure TH2PasProject.DeleteFiles(List: TStrings);
1600 var
1601   i: Integer;
1602   NewFilename: String;
1603   CurFile: TH2PasFile;
1604 begin
1605   if List=nil then exit;
1606   for i:=0 to List.Count-1 do begin
1607     NewFilename:=CleanAndExpandFilename(List[i]);
1608     if (NewFilename='') then exit;
1609     CurFile:=CHeaderFileWithFilename(NewFilename);
1610     if CurFile<>nil then begin
1611       CurFile.Free;
1612     end;
1613   end;
1614 end;
1615 
TH2PasProject.CHeaderFileWithFilenamenull1616 function TH2PasProject.CHeaderFileWithFilename(const AFilename: string
1617   ): TH2PasFile;
1618 var
1619   i: LongInt;
1620 begin
1621   i:=CHeaderFileIndexWithFilename(AFilename);
1622   if i>=0 then
1623     Result:=CHeaderFiles[i]
1624   else
1625     Result:=nil;
1626 end;
1627 
TH2PasProject.CHeaderFileIndexWithFilenamenull1628 function TH2PasProject.CHeaderFileIndexWithFilename(const AFilename: string
1629   ): integer;
1630 begin
1631   Result:=CHeaderFileCount-1;
1632   while (Result>=0)
1633   and (CompareFilenames(AFilename,CHeaderFiles[Result].Filename)<>0) do
1634     dec(Result);
1635 end;
1636 
1637 procedure TH2PasProject.CHeaderFileMove(OldIndex, NewIndex: integer);
1638 begin
1639   FCHeaderFiles.Move(OldIndex,NewIndex);
1640 end;
1641 
ShortenFilenamenull1642 function TH2PasProject.ShortenFilename(const AFilename: string): string;
1643 begin
1644   if IsVirtual then
1645     Result:=AFilename
1646   else
1647     Result:=CreateRelativePath(AFilename,fBaseDir);
1648 end;
1649 
TH2PasProject.LongenFilenamenull1650 function TH2PasProject.LongenFilename(const AFilename: string): string;
1651 begin
1652   if IsVirtual then
1653     Result:=AFilename
1654   else if not FilenameIsAbsolute(AFilename) then
1655     Result:=TrimFilename(BaseDir+AFilename);
1656 end;
1657 
NormalizeFilenamenull1658 function TH2PasProject.NormalizeFilename(const AFilename: string): string;
1659 begin
1660   Result:=LongenFilename(GetForcedPathDelims(AFilename));
1661 end;
1662 
TH2PasProject.HasEnabledFilesnull1663 function TH2PasProject.HasEnabledFiles: boolean;
1664 var
1665   i: Integer;
1666 begin
1667   for i:=0 to CHeaderFileCount-1 do
1668     if CHeaderFiles[i].Enabled and (not CHeaderFiles[i].Merge) then exit(true);
1669   Result:=false;
1670 end;
1671 
1672 procedure TH2PasProject.AddDefaultPreH2PasTools;
1673 begin
1674   AddNewTextConverterTool(FPreH2PasTools,TPreH2PasTools);
1675 end;
1676 
1677 procedure TH2PasProject.AddDefaultPostH2PasTools;
1678 begin
1679   AddNewTextConverterTool(FPostH2PasTools,TPostH2PasTools);
1680 end;
1681 
SearchIncludedCHeaderFilenull1682 function TH2PasProject.SearchIncludedCHeaderFile(aFile: TH2PasFile;
1683   const SrcFilename: string): string;
1684 var
1685   AFilename: String;
1686   i: Integer;
1687   CurFile: TH2PasFile;
1688 begin
1689   AFilename:=GetForcedPathDelims(SrcFilename);
1690   if System.Pos(PathDelim,AFilename)>0 then begin
1691     // with sub path -> only search relative to AFile
1692     Result:=TrimFilename(ExtractFilePath(aFile.Filename)+AFilename);
1693     if FileExistsCached(Result) then exit;
1694   end else begin
1695     // search relative to AFile
1696     Result:=TrimFilename(ExtractFilePath(aFile.Filename)+AFilename);
1697     if FileExistsCached(Result) then exit;
1698     // search relative to all other .h files
1699     for i:=0 to CHeaderFileCount-1 do begin
1700       CurFile:=CHeaderFiles[i];
1701       Result:=TrimFilename(ExtractFilePath(CurFile.Filename)+AFilename);
1702       if FileExistsCached(Result) then exit;
1703     end;
1704   end;
1705   Result:='';
1706 end;
1707 
TH2PasProject.ReadAllCIncludesnull1708 function TH2PasProject.ReadAllCIncludes(ForceUpdate: boolean): TModalResult;
1709 var
1710   i: Integer;
1711   CurFile: TH2PasFile;
1712   DefaultMergeFile: TH2PasFile;
1713 begin
1714   // read includes
1715   DefaultMergeFile:=nil;
1716   for i:=0 to CHeaderFileCount-1 do begin
1717     CurFile:=CHeaderFiles[i];
1718     CurFile.FMergedBy:=nil;
1719     Result:=CurFile.ReadCIncludes(ForceUpdate);
1720     if Result=mrAbort then exit;
1721     if (not CurFile.Merge) then
1722       DefaultMergeFile:=CurFile;
1723   end;
1724 
1725   // create merge connections
1726   for i:=0 to CHeaderFileCount-1 do begin
1727     CurFile:=CHeaderFiles[i];
1728     if CurFile.Merge and (CurFile.CIncludedByCount=0) then begin
1729       // this file should be merged, but is not included by any other file
1730       // append it to the first unit
1731       CurFile.FMergedBy:=DefaultMergeFile;
1732     end;
1733   end;
1734 
1735   Result:=mrOk;
1736 end;
1737 
1738 { TH2PasConverter }
1739 
GetCurrentProjectFilenamenull1740 function TH2PasConverter.GetCurrentProjectFilename: string;
1741 begin
1742   if FProjectHistory.Count>0 then
1743     Result:=FProjectHistory[FProjectHistory.Count-1]
1744   else
1745     Result:='';
1746 end;
1747 
1748 procedure TH2PasConverter.SetAutoOpenLastProject(const AValue: boolean);
1749 begin
1750   if FAutoOpenLastProject=AValue then exit;
1751   FAutoOpenLastProject:=AValue;
1752   Modified:=true;
1753 end;
1754 
1755 procedure TH2PasConverter.SetCurrentProjectFilename(const AValue: string);
1756 const
1757   ProjectHistoryMax=30;
1758 var
1759   NewValue: String;
1760 begin
1761   NewValue:=TrimFilename(AValue);
1762   if NewValue='' then exit;
1763   if CompareFilenames(GetCurrentProjectFilename,NewValue)=0 then exit;
1764   FProjectHistory.Add(NewValue);
1765   while FProjectHistory.Count>ProjectHistoryMax do
1766     FProjectHistory.Delete(0);
1767   Modified:=true;
1768 end;
1769 
1770 procedure TH2PasConverter.SetProject(const AValue: TH2PasProject);
1771 begin
1772   if FProject=AValue then exit;
1773   if FProject<>nil then begin
1774     FProject.fConverter:=nil;
1775   end;
1776   FProject:=AValue;
1777   if FProject<>nil then begin
1778     FProject.fConverter:=Self;
1779     if FProject.Filename<>'' then
1780       CurrentProjectFilename:=FProject.Filename;
1781   end;
1782 end;
1783 
1784 procedure TH2PasConverter.SetProjectHistory(const AValue: TStrings);
1785 begin
1786   if FProjectHistory=AValue then exit;
1787   FProjectHistory.Assign(AValue);
1788 end;
1789 
1790 procedure TH2PasConverter.SetWindowBounds(const AValue: TRect);
1791 begin
1792   if CompareRect(@FWindowBounds,@AValue) then exit;
1793   FWindowBounds:=AValue;
1794   Modified:=true;
1795 end;
1796 
1797 procedure TH2PasConverter.Seth2pasFilename(const AValue: string);
1798 begin
1799   if Fh2pasFilename=AValue then exit;
1800   Fh2pasFilename:=AValue;
1801   Modified:=true;
1802 end;
1803 
1804 constructor TH2PasConverter.Create;
1805 begin
1806   FProjectHistory:=TStringList.Create;
1807   Clear;
1808 end;
1809 
1810 destructor TH2PasConverter.Destroy;
1811 begin
1812   FreeAndNil(FProject);
1813   Clear;
1814   FreeAndNil(FProjectHistory);
1815   inherited Destroy;
1816 end;
1817 
1818 procedure TH2PasConverter.Clear;
1819 begin
1820   FAutoOpenLastProject:=true;
1821   if FProject<>nil then FreeAndNil(FProject);
1822   FProjectHistory.Clear;
1823   FWindowBounds:=Rect(0,0,0,0);
1824   Fh2pasFilename:='h2pas';
1825   FModified:=false;
1826 end;
1827 
1828 procedure TH2PasConverter.Assign(Source: TPersistent);
1829 var
1830   Src: TH2PasConverter;
1831 begin
1832   if Source is TH2PasConverter then begin
1833     Src:=TH2PasConverter(Source);
1834     if not IsEqual(Src) then begin
1835       Clear;
1836       // Note: project is kept unchanged
1837       FProjectHistory.Assign(Src.FProjectHistory);
1838       FWindowBounds:=Src.FWindowBounds;
1839       Fh2pasFilename:=Src.Fh2pasFilename;
1840       Modified:=true;
1841     end;
1842   end else begin
1843     inherited Assign(Source);
1844   end;
1845 end;
1846 
TH2PasConverter.IsEqualnull1847 function TH2PasConverter.IsEqual(AConverter: TH2PasConverter): boolean;
1848 begin
1849   if (FAutoOpenLastProject<>AConverter.FAutoOpenLastProject)
1850   or (not CompareRect(@FWindowBounds,@AConverter.FWindowBounds))
1851   or (Fh2pasFilename<>AConverter.h2pasFilename)
1852   or (not FProjectHistory.Equals(AConverter.FProjectHistory))
1853   then
1854     exit(false);
1855   Result:=true;
1856 end;
1857 
1858 procedure TH2PasConverter.Load(Config: TConfigStorage);
1859 var
1860   i: Integer;
1861 begin
1862   FAutoOpenLastProject:=Config.GetValue('AutoOpenLastProject/Value',true);
1863   Fh2pasFilename:=Config.GetValue('h2pas/Filename','h2pas');
1864   Config.GetValue('WindowBounds/',FWindowBounds,Rect(0,0,0,0));
1865   Config.GetValue('ProjectHistory/',FProjectHistory);
1866   for i:=FProjectHistory.Count-1 downto 0 do
1867     if FProjectHistory[i]='' then FProjectHistory.Delete(i);
1868 
1869   // Note: project is saved in its own file
1870 end;
1871 
1872 procedure TH2PasConverter.Save(Config: TConfigStorage);
1873 begin
1874   Config.SetDeleteValue('AutoOpenLastProject/Value',FAutoOpenLastProject,true);
1875   Config.SetDeleteValue('h2pas/Filename',Fh2pasFilename,'h2pas');
1876   Config.SetDeleteValue('WindowBounds/',FWindowBounds,Rect(0,0,0,0));
1877   Config.SetValue('ProjectHistory/',FProjectHistory);
1878 end;
1879 
1880 procedure TH2PasConverter.LoadFromFile(const AFilename: string);
1881 var
1882   Config: TXMLConfigStorage;
1883 begin
1884   Config:=TXMLConfigStorage.Create(AFilename,true);
1885   try
1886     Load(Config);
1887   finally
1888     Config.Free;
1889   end;
1890 end;
1891 
1892 procedure TH2PasConverter.SaveToFile(const AFilename: string);
1893 var
1894   Config: TXMLConfigStorage;
1895 begin
1896   Config:=TXMLConfigStorage.Create(AFilename,false);
1897   try
1898     Save(Config);
1899     Config.WriteToDisk;
1900   finally
1901     Config.Free;
1902   end;
1903 end;
1904 
1905 procedure TH2PasConverter.LoadProject(const Filename: string);
1906 begin
1907   DebugLn(['TH2PasConverter.LoadProject ',Filename]);
1908   if FProject=nil then
1909     FProject:=TH2PasProject.Create;
1910   FProject.Filename:=Filename;
1911   FProject.LoadFromFile(Filename);
1912   CurrentProjectFilename:=Filename;
1913 end;
1914 
1915 procedure TH2PasConverter.SaveProject(const Filename: string);
1916 begin
1917   DebugLn(['TH2PasConverter.SaveProject ',Filename]);
1918   FProject.Filename:=Filename;
1919   FProject.SaveToFile(Filename);
1920   CurrentProjectFilename:=Filename;
1921 end;
1922 
Executenull1923 function TH2PasConverter.Execute: TModalResult;
1924 var
1925   i: Integer;
1926   AFile: TH2PasFile;
1927   CurResult: TModalResult;
1928 begin
1929   if FExecuting then begin
1930     DebugLn(['TH2PasConverter.Execute FAILED: Already executing']);
1931     exit(mrCancel);
1932   end;
1933 
1934   Result:=mrOK;
1935   FExecuting:=true;
1936   try
1937     FLastUsedFilename:='';
1938 
1939     CurResult:=CheckMergeDependencies;
1940     if CurResult=mrAbort then begin
1941       DebugLn(['TH2PasConverter.Execute aborted because merging not possible']);
1942       exit(mrAbort);
1943     end;
1944 
1945     // convert every c header file
1946     for i:=0 to Project.CHeaderFileCount-1 do begin
1947       AFile:=Project.CHeaderFiles[i];
1948       if not AFile.Enabled then continue;
1949       if AFile.Merge then continue;
1950       CurResult:=ConvertFile(AFile);
1951       if CurResult=mrAbort then begin
1952         DebugLn(['TH2PasConverter.Execute aborted on file ',AFile.Filename]);
1953         exit(mrAbort);
1954       end;
1955       if CurResult<>mrOK then Result:=mrCancel;
1956     end;
1957   finally
1958     FExecuting:=false;
1959   end;
1960 end;
1961 
TH2PasConverter.ConvertFilenull1962 function TH2PasConverter.ConvertFile(AFile: TH2PasFile): TModalResult;
1963 var
1964   TextConverter: TIDETextConverter;
1965 
1966   procedure CloseOrRevertEditorFile(const Filename: string);
1967   begin
1968     if FileExistsUTF8(Filename) then
1969       LazarusIDE.DoRevertEditorFile(Filename)
1970     else
1971       LazarusIDE.DoCloseEditorFile(Filename,[cfQuiet]);
1972   end;
1973 
ExecuteToolsnull1974   function ExecuteTools(List: TComponent; const DefaultFilename: string
1975     ): TModalResult;
1976   var
1977     ErrorComponent: TComponent;
1978     ErrorTool: TCustomTextConverterTool;
1979     ErrMsg: String;
1980     Line: Integer;
1981     Col: Integer;
1982     Filename: String;
1983     BaseDir: String;
1984   begin
1985     Result:=TextConverter.Execute(List,ErrorComponent);
1986     if Result=mrOk then exit;
1987     Line:=0;
1988     Col:=0;
1989     Filename:='';
1990     if ErrorComponent is TCustomTextConverterTool then begin
1991       ErrorTool:=TCustomTextConverterTool(ErrorComponent);
1992       Line:=ErrorTool.ErrorLine;
1993       Col:=ErrorTool.ErrorColumn;
1994       Filename:=ErrorTool.ErrorFilename;
1995     end;
1996     if Filename='' then
1997       Filename:=DefaultFilename;
1998     // create error message
1999     BaseDir:=ExtractFilePath(Project.BaseDir);
2000     ErrMsg:=CreateRelativePath(Filename,BaseDir);
2001 
2002     if Line>0 then begin
2003       ErrMsg:=ErrMsg+'('+IntToStr(Line)+',';
2004       if Col>0 then
2005         ErrMsg:=ErrMsg+IntToStr(Col)
2006       else
2007         ErrMsg:=ErrMsg+'1';
2008       ErrMsg:=ErrMsg+')';
2009     end;
2010     ErrMsg:=ErrMsg+' Error: '+ErrorTool.ErrorMsg+' ('+ErrorTool.Caption+')';
2011     DebugLn(['TH2PasConverter.ConvertFile Failed: ',ErrMsg]);
2012     IDEMessagesWindow.AddCustomMessage(mluError,ErrorTool.ErrorMsg,Filename,Line,Col,ErrorTool.Caption);
2013     LazarusIDE.DoJumpToCompilerMessage(true);
2014     Result:=mrAbort;
2015   end;
2016 
2017 var
2018   OutputFilename: String;
2019   TempCHeaderFilename: String;
2020   InputFilename: String;
2021   Tool: TH2PasTool;
2022 begin
2023   Result:=mrCancel;
2024   FLastUsedFilename:='';
2025 
2026   // check if file exists
2027   InputFilename:=AFile.Filename;
2028   if not FileExistsCached(InputFilename) then begin
2029     Result := IDEMessageDialog(h2pFileNotFound,
2030       Format(h2pCHeaderFileNotFound, [InputFilename]),
2031       mtError,[mbCancel,mbAbort],'');
2032     exit;
2033   end;
2034 
2035   OutputFilename:=AFile.GetOutputFilename;
2036   TempCHeaderFilename:=ChangeFileExt(OutputFilename,'.tmp.h');
2037   TextConverter:=TIDETextConverter.Create(nil);
2038   try
2039     if not CopyFile(InputFilename,TempCHeaderFilename) then begin
2040       Result := IDEMessageDialog(h2pCopyingFileFailed,
2041         Format(h2pUnableToCopyFileTo, [InputFilename, #13, TempCHeaderFilename]),
2042         mtError,[mbCancel,mbAbort],'');
2043       exit;
2044     end;
2045 
2046     TextConverter.Filename:=TempCHeaderFilename;
2047     FLastUsedFilename:=TextConverter.Filename;
2048     DebugLn(['TH2PasConverter.ConvertFile TempCHeaderFilename="',TempCHeaderFilename,'" CurrentType=',ord(TextConverter.CurrentType),' FileSize=',FileSize(TempCHeaderFilename)]);
2049 
2050     // merge files
2051     TextConverter.LoadFromFile(InputFilename);
2052     Result:=MergeIncludeFiles(AFile,TextConverter);
2053     if Result<>mrOk then begin
2054       DebugLn(['TH2PasConverter.ConvertFile Failed merging include files in ',TempCHeaderFilename]);
2055       exit;
2056     end;
2057 
2058     // run converters for .h file to make it compatible for h2pas
2059     Result:=ExecuteTools(Project.PreH2PasTools,TempCHeaderFilename);
2060     if Result<>mrOk then begin
2061       DebugLn(['TH2PasConverter.ConvertFile Failed running Project.PreH2PasTools on ',TempCHeaderFilename]);
2062       exit;
2063     end;
2064 
2065     //DebugLn(['TH2PasConverter.ConvertFile CCC1 ',TextConverter.Source]);
2066     // run h2pas
2067     Tool:=TH2PasTool.Create;
2068     try
2069       Tool.Title:='h2pas';
2070       Tool.H2PasFile:=AFile;
2071       Tool.TargetFilename:=TextConverter.Filename;
2072       Tool.Executable:=GetH2PasFilename;
2073       Tool.CmdLineParams:=AFile.GetH2PasParameters(Tool.TargetFilename);
2074       Tool.WorkingDirectory:=Project.BaseDir;
2075       DebugLn(['TH2PasConverter.ConvertFile Tool.Executable="',Tool.Executable,'" Tool.CmdLineParams="',Tool.CmdLineParams,'"']);
2076       Tool.Scanners.Add(SubToolH2Pas);
2077       if not RunExternalTool(Tool) then
2078         exit(mrAbort);
2079       if IDEMessagesWindow.SelectFirstUrgentMessage(mluError,false) then
2080         exit(mrAbort);
2081     finally
2082       Tool.Free;
2083     end;
2084 
2085     // run beautification tools for new pascal code
2086     TextConverter.InitWithFilename(OutputFilename);
2087     //DebugLn(['TH2PasConverter.ConvertFile Output: ',copy(TextConverter.Source,1,300)]);
2088     //DebugLn(['TH2PasConverter.ConvertFile CCC2 ',TextConverter.Source]);
2089     Result:=ExecuteTools(Project.PostH2PasTools,OutputFilename);
2090     if Result<>mrOk then begin
2091       DebugLn(['TH2PasConverter.ConvertFile Failed running Project.PostH2PasTools on ',OutputFilename]);
2092       exit;
2093     end;
2094     TextConverter.Filename:=OutputFilename;// save
2095 
2096     // clean up
2097     if FileExistsUTF8(TempCHeaderFilename) then
2098       DeleteFileUTF8(TempCHeaderFilename);
2099   finally
2100     TextConverter.Free;
2101     if (LazarusIDE<>nil) then begin
2102       // reload changed files, so that IDE does not report changed files
2103       CloseOrRevertEditorFile(TempCHeaderFilename);
2104       CloseOrRevertEditorFile(OutputFilename);
2105     end;
2106   end;
2107 
2108   Result:=mrOk;
2109 end;
2110 
TH2PasConverter.CheckMergeDependenciesnull2111 function TH2PasConverter.CheckMergeDependencies: TModalResult;
2112 var
2113   CheckedFiles: TFPList;
2114 
2115   procedure AddIncludedByFiles(IncludedByFiles: TFPList; CurFile: TH2PasFile);
2116   var
2117     i: Integer;
2118     IncludedBy: TH2PasFile;
2119   begin
2120     if CheckedFiles.IndexOf(CurFile)>=0 then exit;
2121     CheckedFiles.Add(CurFile);
2122     for i:=0 to CurFile.CIncludedByCount-1 do begin
2123       IncludedBy:=CurFile.CIncludedBy[i].Owner;
2124       if IncludedBy.Merge then
2125         AddIncludedByFiles(IncludedByFiles,IncludedBy)
2126       else
2127         if IncludedByFiles.IndexOf(IncludedBy)<0 then
2128           IncludedByFiles.Add(IncludedBy);
2129     end;
2130   end;
2131 
2132 var
2133   i: Integer;
2134   CurFile: TH2PasFile;
2135   j: Integer;
2136   IncludedByFiles: TFPList;
2137   Warning: String;
2138 begin
2139   // update graph
2140   Result:=Project.ReadAllCIncludes(true);
2141   if Result=mrAbort then begin
2142     DebugLn(['TH2PasConverter.CheckMergeDependencies aborted reading all include dependencies']);
2143     exit;
2144   end;
2145 
2146   Warning:='';
2147   for i:=0 to Project.CHeaderFileCount-1 do begin
2148     CurFile:=Project.CHeaderFiles[i];
2149     if CurFile.Merge then begin
2150       // this file should be merged
2151       // -> check if it is included only once
2152       IncludedByFiles:=TFPList.Create;
2153       CheckedFiles:=TFPList.Create;
2154       AddIncludedByFiles(IncludedByFiles,CurFile);
2155       if IncludedByFiles.Count>1 then begin
2156         // this merged file is included by more than one unit
2157         Warning := Format(h2pWarningTheFileWillBeMergedIntoMultipleFiles, [Warning, Project.ShortenFilename(CurFile.Filename), #13, #13]);
2158         for j:=0 to IncludedByFiles.Count-1 do begin
2159           if j>0 then
2160             Warning:=Warning+', ';
2161           Warning:=Warning
2162               +Project.ShortenFilename(TH2PasFile(IncludedByFiles[j]).Filename);
2163         end;
2164         Warning:=Warning+#13;
2165       end;
2166       CheckedFiles.Free;
2167       IncludedByFiles.Free;
2168     end;
2169   end;
2170 
2171   if Warning<>'' then begin
2172     Result := MessageDlg(h2pWarning,
2173       Format(h2pAmbiguousMerges, [#13, Warning]), mtWarning, [mbIgnore, mbAbort], 0);
2174     if Result<>mrIgnore then exit(mrCancel);
2175   end;
2176 
2177   Result:=mrOk;
2178 end;
2179 
MergeIncludeFilesnull2180 function TH2PasConverter.MergeIncludeFiles(AFile: TH2PasFile;
2181   TextConverter: TIDETextConverter): TModalResult;
2182 
2183   procedure GetIncludeMergeFiles(MergedFiles: TFPList; CurFile: TH2PasFile);
2184   var
2185     i: Integer;
2186     CInclude: TH2PasFileCInclude;
2187     IncFile: TH2PasFile;
2188   begin
2189     //DebugLn(['GetMergeFiles CurFile=',CurFile.Filename,' CurFile.CIncludeCount=',CurFile.CIncludeCount]);
2190     // merge include files
2191     for i:=0 to CurFile.CIncludeCount-1 do begin
2192       CInclude:=CurFile.CIncludes[i];
2193       IncFile:=CInclude.H2PasFile;
2194       if IncFile=nil then continue;
2195       //DebugLn(['GetMergeFiles AFile=',AFile.Filename,' CInclude=',CInclude.Filename,' IncFile.Merge=',IncFile.Merge,' ']);
2196       if not IncFile.Merge then continue;
2197       if not IncFile.Enabled then continue;
2198       if IncFile=AFile then continue;
2199       if MergedFiles.IndexOf(IncFile)<0 then begin
2200         MergedFiles.Add(IncFile);
2201         GetIncludeMergeFiles(MergedFiles,IncFile);
2202       end;
2203     end;
2204   end;
2205 
2206   procedure GetProjectMergeFiles(MergedFiles: TFPList; CurFile: TH2PasFile);
2207   var
2208     IncFile: TH2PasFile;
2209     i: Integer;
2210   begin
2211     // merge non include files
2212     if Project<>nil then begin
2213       for i:=0 to Project.CHeaderFileCount-1 do begin
2214         IncFile:=Project.CHeaderFiles[i];
2215         if not IncFile.Enabled then continue;
2216         if IncFile=CurFile then continue;
2217         if IncFile.MergedBy=CurFile then begin
2218           if MergedFiles.IndexOf(IncFile)<0 then begin
2219             MergedFiles.Add(IncFile);
2220             GetIncludeMergeFiles(MergedFiles,IncFile);
2221           end;
2222         end;
2223       end;
2224     end;
2225   end;
2226 
2227 var
2228   MergedFiles: TFPList;// list of TH2PasFile
2229   i: Integer;
2230   IncludeFile: TH2PasFile;
2231   fs: TFileStream;
2232   s: string;
2233 begin
2234   Result:=mrCancel;
2235   MergedFiles:=TFPList.Create;
2236   try
2237     GetIncludeMergeFiles(MergedFiles,AFile);
2238     GetProjectMergeFiles(MergedFiles,AFile);
2239     for i:=0 to MergedFiles.Count-1 do begin
2240       IncludeFile:=TH2PasFile(MergedFiles[i]);
2241       DebugLn(['TH2PasConverter.MergeIncludeFiles merging file '
2242          ,'"'+IncludeFile.Filename+'"'+' into "'+TextConverter.Filename+'"']);
2243       try
2244         fs:=TFileStreamUTF8.Create(IncludeFile.Filename,fmOpenRead);
2245         try
2246           SetLength(s,fs.Size);
2247           if s<>'' then begin
2248             fs.Read(s[1],length(s));
2249             TextConverter.Source:=TextConverter.Source+LineEnding+s;
2250           end;
2251         finally
2252           fs.Free;
2253         end;
2254       except
2255         on E: Exception do begin
2256           MessageDlg(h2pError, Format(h2pUnableToMergeFileInto, [IncludeFile.Filename, TextConverter.Filename]), mtError, [mbCancel], 0);
2257           exit;
2258         end;
2259       end;
2260     end;
2261     Result:=mrOk;
2262   finally
2263     MergedFiles.Free;
2264   end;
2265 end;
2266 
GetH2PasFilenamenull2267 function TH2PasConverter.GetH2PasFilename: string;
2268 begin
2269   Result:=FindDefaultExecutablePath(h2pasFilename);
2270 end;
2271 
TH2PasConverter.FileIsRelatednull2272 function TH2PasConverter.FileIsRelated(const aFilename: string): Boolean;
2273 begin
2274   Result:=(CompareFilenames(AFilename,LastUsedFilename)=0)
2275       or ((Project<>nil) and (Project.CHeaderFileWithFilename(aFilename)<>nil));
2276 end;
2277 
2278 { TRemoveCPlusPlusExternCTool }
2279 
TRemoveCPlusPlusExternCTool.ClassDescriptionnull2280 class function TRemoveCPlusPlusExternCTool.ClassDescription: string;
2281 begin
2282   Result := h2pRemoveCExternCLines;
2283 end;
2284 
Executenull2285 function TRemoveCPlusPlusExternCTool.Execute(aText: TIDETextConverter
2286   ): TModalResult;
2287 var
2288   i: Integer;
2289   Lines: TStrings;
2290   Line: string;
2291 begin
2292   Result:=mrCancel;
2293   if aText=nil then exit;
2294   Lines:=aText.Strings;
2295   i:=0;
2296   while i<=Lines.Count-1 do begin
2297     Line:=Trim(Lines[i]);
2298     if Line='extern "C" {' then begin
2299       Lines[i]:='';
2300     end
2301     else if (i>0) and (Line='}')
2302     and ((Lines[i-1]='#if defined(__cplusplus)')
2303       or (Lines[i-1]='#ifdef __cplusplus'))
2304     then begin
2305       Lines[i]:='';
2306     end;
2307     inc(i);
2308   end;
2309   Result:=mrOk;
2310 end;
2311 
2312 { TRemoveEmptyCMacrosTool }
2313 
TRemoveEmptyCMacrosTool.ClassDescriptionnull2314 class function TRemoveEmptyCMacrosTool.ClassDescription: string;
2315 begin
2316   Result := h2pRemoveEmptyCMacros;
2317 end;
2318 
Executenull2319 function TRemoveEmptyCMacrosTool.Execute(aText: TIDETextConverter
2320   ): TModalResult;
2321 var
2322   EmptyMacros: TAVLTree;// tree of PChar
2323 
2324   procedure AddEmptyMacro(const MacroName: string);
2325   var
2326     TempStr: String;
2327     Identifier: PChar;
2328   begin
2329     //DebugLn(['AddEmptyMacro MacroName="',MacroName,'"']);
2330     if EmptyMacros=nil then
2331       EmptyMacros:=TAVLTree.Create(TListSortCompare(@CompareIdentifiers));
2332     Identifier:=@MacroName[1];
2333     if EmptyMacros.Find(Identifier)<>nil then exit;
2334     TempStr:=MacroName; // increase refcount
2335     if TempStr<>'' then
2336       Pointer(TempStr):=nil;
2337     EmptyMacros.Add(Identifier);
2338   end;
2339 
2340   procedure DeleteEmptyMacro(const MacroName: string);
2341   var
2342     OldMacroName: String;
2343     Identifier: PChar;
2344     Node: TAVLTreeNode;
2345   begin
2346     //DebugLn(['DeleteEmptyMacro MacroName="',MacroName,'"']);
2347     if EmptyMacros=nil then exit;
2348     Identifier:=@MacroName[1];
2349     Node:=EmptyMacros.Find(Identifier);
2350     if Node=nil then exit;
2351     OldMacroName:='';
2352     Pointer(OldMacroName):=Node.Data;
2353     if OldMacroName<>'' then OldMacroName:=''; // decrease refcount
2354     EmptyMacros.Delete(Node);
2355   end;
2356 
2357   procedure FreeMacros;
2358   var
2359     CurMacroName: String;
2360     Node: TAVLTreeNode;
2361   begin
2362     if EmptyMacros=nil then exit;
2363     CurMacroName:='';
2364     Node:=EmptyMacros.FindLowest;
2365     while Node<>nil do begin
2366       Pointer(CurMacroName):=Node.Data;
2367       if CurMacroName<>'' then CurMacroName:=''; // decrease refcount
2368       Node:=EmptyMacros.FindSuccessor(Node);
2369     end;
2370     EmptyMacros.Free;
2371   end;
2372 
2373   procedure RemoveEmptyMacrosFromString(var s: string);
2374   var
2375     IdentEnd: Integer;
2376     IdentStart: LongInt;
2377     Identifier: PChar;
2378     IdentLen: LongInt;
2379   begin
2380     if EmptyMacros=nil then exit;
2381     IdentEnd:=1;
2382     repeat
2383       IdentStart:=FindNextIdentifier(s,IdentEnd,length(s));
2384       if IdentStart>length(s) then exit;
2385       Identifier:=@s[IdentStart];
2386       IdentLen:=GetIdentLen(Identifier);
2387       if EmptyMacros.Find(Identifier)<>nil then begin
2388         // empty macro found -> remove
2389         System.Delete(s,IdentStart,IdentLen);
2390         IdentEnd:=IdentStart;
2391       end else begin
2392         IdentEnd:=IdentStart+IdentLen;
2393       end;
2394     until false;
2395   end;
2396 
2397 var
2398   MacroStart, MacroLen: integer;
2399   Lines: TStrings;
2400   i: Integer;
2401   Line: string;
2402   MacroName: String;
2403 begin
2404   Result:=mrCancel;
2405   if aText=nil then exit;
2406   Lines:=aText.Strings;
2407   EmptyMacros:=nil;
2408   try
2409     i:=0;
2410     while i<=Lines.Count-1 do begin
2411       Line:=Lines[i];
2412       if REMatches(Line,'^#define\s+([a-zA-Z0-9_]+)\b(.*)$') then begin
2413         REVarPos(1,MacroStart,MacroLen);
2414         MacroName:=copy(Line,MacroStart,MacroLen);
2415         if Trim(copy(Line,MacroStart+MacroLen,length(Line)))='' then
2416           AddEmptyMacro(MacroName)
2417         else
2418           DeleteEmptyMacro(MacroName);
2419       end;
2420       if (Line<>'') and (Line[1]<>'#') then
2421         RemoveEmptyMacrosFromString(Line);
2422       Lines[i]:=Line;
2423       inc(i);
2424     end;
2425   finally
2426     FreeMacros;
2427   end;
2428   Result:=mrOk;
2429 end;
2430 
2431 { TReplaceMacro0PointerWithNULL }
2432 
TReplaceMacro0PointerWithNULL.ClassDescriptionnull2433 class function TReplaceMacro0PointerWithNULL.ClassDescription: string;
2434 begin
2435   Result := h2pReplaceMacroValues0PointerLikeChar0WithNULL;
2436 end;
2437 
TReplaceMacro0PointerWithNULL.Executenull2438 function TReplaceMacro0PointerWithNULL.Execute(aText: TIDETextConverter
2439   ): TModalResult;
2440 var
2441   Lines: TStrings;
2442   i: Integer;
2443   Line: string;
2444   MacroStart, MacroLen: integer;
2445 begin
2446   Result:=mrCancel;
2447   if aText=nil then exit;
2448   Lines:=aText.Strings;
2449   i:=0;
2450   while i<=Lines.Count-1 do begin
2451     Line:=Lines[i];
2452     // example: #define MPI_ARGV_NULL (char **)0
2453     if REMatches(Line,'^#define\s+([a-zA-Z0-9_]+)\s+(\(.*\*\)0)\s*($|//|/\*)')
2454     then begin
2455       REVarPos(2,MacroStart,MacroLen);
2456       Line:=copy(Line,1,MacroStart-1)+'NULL'
2457         +copy(Line,MacroStart+MacroLen,length(Line));
2458       Lines[i]:=Line;
2459     end
2460     else // example: #define MPI_NULL_COPY_FN   ((MPI_Copy_function *)0)
2461     if REMatches(Line,'^#define\s+([a-zA-Z0-9_]+)\s+(\(\(.*\*\)0\))\s*($|//|/\*)')
2462     then begin
2463       REVarPos(2,MacroStart,MacroLen);
2464       Line:=copy(Line,1,MacroStart-1)+'NULL'
2465         +copy(Line,MacroStart+MacroLen,length(Line));
2466       Lines[i]:=Line;
2467     end
2468     else // example: *)0)
2469     if REMatches(Line,'\*\)(0)\)')
2470     then begin
2471       REVarPos(1,MacroStart,MacroLen);
2472       Line:=copy(Line,1,MacroStart-1)+'NULL'
2473         +copy(Line,MacroStart+MacroLen,length(Line));
2474       Lines[i]:=Line;
2475     end;
2476     inc(i);
2477   end;
2478   Result:=mrOk;
2479 end;
2480 
2481 { TReplaceEdgedBracketPairWithStar }
2482 
TReplaceEdgedBracketPairWithStar.ClassDescriptionnull2483 class function TReplaceEdgedBracketPairWithStar.ClassDescription: string;
2484 begin
2485   Result := h2pReplaceWith;
2486 end;
2487 
2488 constructor TReplaceEdgedBracketPairWithStar.Create(TheOwner: TComponent);
2489 begin
2490   inherited Create(TheOwner);
2491   SearchFor:='[]';
2492   ReplaceWith:='*';
2493 end;
2494 
2495 { TReplaceUnitFilenameWithUnitName }
2496 
TReplaceUnitFilenameWithUnitName.ClassDescriptionnull2497 class function TReplaceUnitFilenameWithUnitName.ClassDescription: string;
2498 begin
2499   Result := h2pReplaceUnitFilenameWithUnitName;
2500 end;
2501 
2502 constructor TReplaceUnitFilenameWithUnitName.Create(TheOwner: TComponent);
2503 begin
2504   inherited Create(TheOwner);
2505   SearchFor:='^(unit\s).*(/|\\)([a-z_0-9]+;)';
2506   ReplaceWith:='$1$3';
2507   Options:=Options+[trtRegExpr];
2508 end;
2509 
2510 { TRemoveSystemTypes }
2511 
TRemoveSystemTypes.ClassDescriptionnull2512 class function TRemoveSystemTypes.ClassDescription: string;
2513 begin
2514   Result := h2pRemoveTypeRedefinitionsLikePLongint;
2515 end;
2516 
Executenull2517 function TRemoveSystemTypes.Execute(aText: TIDETextConverter): TModalResult;
2518 var
2519   Source: String;
2520   Flags: TSrcEditSearchOptions;
2521   Prompt: Boolean;
2522   SearchFor: string;
2523   i: Integer;
2524 begin
2525   Result:=mrCancel;
2526   if aText=nil then exit;
2527   Source:=aText.Source;
2528 
2529   Flags:=[sesoReplace,sesoReplaceAll,sesoRegExpr];
2530   Prompt:=false;
2531   SearchFor:='';
2532   for i:=Low(PreDefinedH2PasTypes) to High(PreDefinedH2PasTypes) do begin
2533     if SearchFor<>'' then
2534       SearchFor:=SearchFor+'|';
2535     SearchFor:=SearchFor
2536                +'P'+PreDefinedH2PasTypes[i]+'\s*=\s*\^'+PreDefinedH2PasTypes[i];
2537   end;
2538   SearchFor:='^\s*('+SearchFor+');\s*$';
2539   Result:=IDESearchInText('',Source,SearchFor,'',Flags,Prompt,nil);
2540   if Result<>mrOk then begin
2541     ErrorMsg := Format(h2pDeletionOfFailed, [SearchFor]);
2542     exit;
2543   end;
2544 
2545   // replace NULL with nil
2546   Flags:=[sesoReplace,sesoReplaceAll,sesoRegExpr,sesoMatchCase];
2547   Result:=IDESearchInText('',Source,'\bNULL\b','nil',Flags,Prompt,nil);
2548   if Result<>mrOk then begin
2549     ErrorMsg := h2pReplacingOfNULLWithNilFailed;
2550     exit;
2551   end;
2552 
2553   aText.Source:=Source;
2554 end;
2555 
2556 { TRemoveRedefinedPointerTypes }
2557 
TRemoveRedefinedPointerTypes.ClassDescriptionnull2558 class function TRemoveRedefinedPointerTypes.ClassDescription: string;
2559 begin
2560   Result := h2pRemoveRedefinedPointerTypes;
2561 end;
2562 
Executenull2563 function TRemoveRedefinedPointerTypes.Execute(aText: TIDETextConverter
2564   ): TModalResult;
2565 { search for
2566     Pname  = ^name;
2567   if PName has a redefinition, delete the second one
2568 }
2569 var
2570   Lines: TStrings;
2571   i: Integer;
2572   Line: string;
2573   PointerName: String;
2574   TypeName: String;
2575   j: Integer;
2576   Pattern: String;
2577 begin
2578   Result:=mrCancel;
2579   if aText=nil then exit;
2580   Lines:=aText.Strings;
2581   i:=0;
2582   while i<=Lines.Count-1 do begin
2583     Line:=Lines[i];
2584     if REMatches(Line,'^\s*([a-zA-Z_][a-zA-Z0-9_]*)\s*=\s*\^\s*([a-zA-Z_][a-zA-Z0-9_]*)\s*;\s*($|//|/\*)') then begin
2585       PointerName:=REVar(1);
2586       TypeName:=REVar(2);
2587       Pattern:='^\s*'+PointerName+'\s*=\s*\^\s*'+TypeName+'\s*;';
2588       j:=Lines.Count-1;
2589       while (j>i) do begin
2590         if REMatches(Lines[j],Pattern) then
2591           Lines.Delete(j);
2592         dec(j);
2593       end;
2594     end;
2595     inc(i);
2596   end;
2597   Result:=mrOk;
2598 end;
2599 
2600 { TRemoveEmptyTypeVarConstSections }
2601 
TRemoveEmptyTypeVarConstSections.ClassDescriptionnull2602 class function TRemoveEmptyTypeVarConstSections.ClassDescription: string;
2603 begin
2604   Result := h2pRemoveEmptyTypeVarConstSections;
2605 end;
2606 
TRemoveEmptyTypeVarConstSections.Executenull2607 function TRemoveEmptyTypeVarConstSections.Execute(aText: TIDETextConverter
2608   ): TModalResult;
2609 var
2610   Src: String;
2611   p: Integer;
2612   AtomStart: Integer;
2613   CurAtom, NextAtom: PChar;
2614   KeyWordStart: LongInt;
2615   KeyWordEnd: LongInt;
2616   DeleteSection: Boolean;
2617   Modified: Boolean;
2618 begin
2619   Result:=mrCancel;
2620   Src:=aText.Source;
2621   p:=1;
2622   AtomStart:=p;
2623   repeat
2624     ReadRawNextPascalAtom(Src,p,AtomStart);
2625     if p>length(Src) then break;
2626     CurAtom:=@Src[AtomStart];
2627     if (CompareIdentifiers(CurAtom,'type')=0)
2628     or (CompareIdentifiers(CurAtom,'var')=0)
2629     or (CompareIdentifiers(CurAtom,'const')=0)
2630     or (CompareIdentifiers(CurAtom,'threadvar')=0)
2631     or (CompareIdentifiers(CurAtom,'resourcestring')=0)
2632     then begin
2633       // start of a section found
2634       // read next atoms to check if they are identifier plus definition operator
2635       //   'name =' or 'name:' or 'name,'
2636       KeyWordStart:=AtomStart;
2637       KeyWordEnd:=p;
2638       ReadRawNextPascalAtom(Src,p,AtomStart);
2639       if p<length(Src) then begin
2640         NextAtom:=@Src[AtomStart];
2641         DeleteSection:=true;
2642         if GetIdentLen(NextAtom)>0 then begin
2643           ReadRawNextPascalAtom(Src,p,AtomStart);
2644           if (p<=length(Src)) and (p-AtomStart=1)
2645           and (Src[AtomStart] in ['=',':',',']) then
2646             DeleteSection:=false;
2647         end;
2648         if DeleteSection then begin
2649           // this section is empty -> delete it
2650           Src:=copy(Src,1,KeyWordStart-1)+copy(Src,KeyWordEnd,length(Src));
2651           Modified:=true;
2652           // adjust position
2653           p:=KeyWordStart;
2654         end;
2655       end;
2656     end;
2657   until false;
2658   if Modified then
2659     aText.Source:=Src;
2660 
2661   Result:=mrOk;
2662 end;
2663 
2664 type
2665   TImplicitType = class
2666   public
2667     Name: string;
2668     Code: string;
2669     MinPosition: integer;
2670     MaxPosition: integer;
2671     MinPositionNeedsTypeSection: boolean;
2672   end;
2673 
CompareImplicitTypeNamesnull2674 function CompareImplicitTypeNames(Type1, Type2: Pointer): integer;
2675 begin
2676   Result:=CompareIdentifiers(PChar(TImplicitType(Type1).Name),
2677                              PChar(TImplicitType(Type2).Name));
2678 end;
2679 
CompareImplicitTypeStringAndNamenull2680 function CompareImplicitTypeStringAndName(Identifier,
2681   ImplicitType: Pointer): integer;
2682 begin
2683   Result:=CompareIdentifiers(PChar(Identifier),
2684                              PChar(TImplicitType(ImplicitType).Name));
2685 end;
2686 
CompareImplicitTypeMinPositionsnull2687 function CompareImplicitTypeMinPositions(Type1, Type2: Pointer): integer;
2688 begin
2689   Result:=TImplicitType(Type1).MinPosition-TImplicitType(Type2).MinPosition;
2690 end;
2691 
2692 { TReplaceImplicitParameterTypes }
2693 
TReplaceImplicitTypes.ClassDescriptionnull2694 class function TReplaceImplicitTypes.ClassDescription: string;
2695 begin
2696   Result := Format(h2pReplaceImplicitTypesForExampleProcedureProcNameAAr, [#13, #13, #13, #13, #13, #13]);
2697 end;
2698 
FindNextImplicitTypenull2699 function TReplaceImplicitTypes.FindNextImplicitType(var Position: integer;
2700   out aTypeStart, aTypeEnd: integer): boolean;
2701 var
2702   AtomStart: LongInt;
2703 
ReadTilTypeEndnull2704   function ReadTilTypeEnd: boolean;
2705   var
2706     CurAtom: String;
2707   begin
2708     repeat
2709       CurAtom:=ReadNextPascalAtom(Src,Position,AtomStart);
2710       if CurAtom='' then exit(false);
2711       if (length(CurAtom)=1) and (CurAtom[1] in ['(','[']) then begin
2712         // skip brackets
2713         if not ReadTilPascalBracketClose(Src,Position) then exit(false);
2714       end else if (length(CurAtom)=1) and (CurAtom[1] in [';',')',']'])
2715       then begin
2716         // type end found
2717         aTypeEnd:=AtomStart;
2718         Result:=true;
2719         exit;
2720       end;
2721     until false;
2722   end;
2723 
2724 var
2725   CurAtom: string;
2726 begin
2727   Result:=false;
2728   aTypeStart:=0;
2729   aTypeEnd:=0;
2730   AtomStart:=Position;
2731   repeat
2732     CurAtom:=ReadNextPascalAtom(Src,Position,AtomStart);
2733     if CurAtom='' then break;
2734     //DebugLn(['TReplaceImplicitTypes.FindNextImplicitType atom ',CurAtom]);
2735     if CurAtom=':' then begin
2736       // var, const, out declaration
2737       CurAtom:=ReadNextPascalAtom(Src,Position,AtomStart);
2738       if CurAtom='' then break;
2739       aTypeStart:=AtomStart;
2740       if CompareIdentifiers(PChar(CurAtom),'array')=0 then begin
2741         // :array
2742         CurAtom:=ReadNextPascalAtom(Src,Position,AtomStart);
2743         if CurAtom='' then break;
2744         if CurAtom='[' then begin
2745           // :array[
2746           if not ReadTilPascalBracketClose(Src,Position) then break;
2747           // :array[..]
2748           Result:=ReadTilTypeEnd;
2749           exit;
2750         end;
2751       end
2752       else if CompareIdentifiers(PChar(CurAtom),'function')=0 then begin
2753         // :function
2754         // for example: function hci_for_each_dev(func:function (dd:longint):longint):longint;
2755         Result:=ReadTilTypeEnd;
2756         exit;
2757       end
2758       else if CompareIdentifiers(PChar(CurAtom),'procedure')=0 then begin
2759         // :procedure
2760         // for example: procedure hci_for_each_dev(func:function (dd:longint):longint);
2761         Result:=ReadTilTypeEnd;
2762         exit;
2763       end;
2764     end;
2765   until CurAtom='';
2766 end;
2767 
SearchImplicitParameterTypesnull2768 function TReplaceImplicitTypes.SearchImplicitParameterTypes(
2769   var ModalResult: TModalResult): boolean;
2770 var
2771   Position: Integer;
2772   StartPos, EndPos: integer;
2773   TypeCode: String;
2774   TypeName: String;
2775   NewType: TImplicitType;
2776 begin
2777   Result:=false;
2778   ModalResult:=mrCancel;
2779   Position:=1;
2780   while FindNextImplicitType(Position,StartPos,EndPos) do begin
2781     TypeCode:=copy(Src,StartPos,EndPos-StartPos);
2782     //DebugLn(['SearchImplicitParameterTypes ',StartPos,' TypeCode="',TypeCode,'"']);
2783     TypeName:=CodeToIdentifier(TypeCode);
2784     if TypeName='' then continue;
2785     if (ImplicitTypes<>nil)
2786     and (ImplicitTypes.FindKey(Pointer(TypeName),
2787                        @CompareImplicitTypeStringAndName)<>nil)
2788     then begin
2789       // type exists already
2790       continue;
2791     end;
2792     // add new type
2793     //DebugLn(['SearchImplicitParameterTypes Adding new type ',StartPos,' TypeName=',TypeName,' TypeCode="',TypeCode,'"']);
2794     NewType:=TImplicitType.Create;
2795     NewType.Name:=TypeName;
2796     NewType.Code:=TypeCode;
2797     NewType.MaxPosition:=StartPos;
2798     if ImplicitTypes=nil then
2799       ImplicitTypes:=TAVLTree.Create(@CompareImplicitTypeNames);
2800     ImplicitTypes.Add(NewType);
2801   end;
2802   ModalResult:=mrOk;
2803   Result:=true;
2804 end;
2805 
PosToStrnull2806 function TReplaceImplicitTypes.PosToStr(Position: integer): string;
2807 var
2808   Line, Col: integer;
2809 begin
2810   SrcPosToLineCol(Src,Position,Line,Col);
2811   Result:='(y='+IntToStr(Line)+',x='+IntToStr(Col)+')';
2812 end;
2813 
2814 procedure TReplaceImplicitTypes.AdjustMinPositions(const Identifier: string);
2815 var
2816   Node: TAVLTreeNode;
2817   Item: TImplicitType;
2818   Position: Integer;
2819   AtomStart: LongInt;
2820   CurAtom: String;
2821   MinPos: LongInt;
2822 begin
2823   if TypeEnd>0 then
2824     MinPos:=TypeEnd
2825   else if ConstSectionEnd>0 then
2826     MinPos:=ConstSectionEnd
2827   else
2828     exit;
2829   //DebugLn(['AdjustMinPositions Identifier=',Identifier]);
2830 
2831   // search Identifier in all implicit type definitions
2832   Node:=ImplicitTypes.FindLowest;
2833   while Node<>nil do begin
2834     Item:=TImplicitType(Node.Data);
2835     if Item.MaxPosition>=TypeEnd then begin
2836       // search Identifier in Item.Code
2837       Position:=1;
2838       AtomStart:=Position;
2839       repeat
2840         CurAtom:=ReadNextPascalAtom(Item.Code,Position,AtomStart);
2841         if CurAtom='' then break;
2842         //DebugLn(['AdjustMinPositions ',Item.Name,' ',CurAtom]);
2843         if CompareIdentifiers(PChar(Identifier),PChar(CurAtom))=0 then begin
2844           // this implicit type depends on an explicit type defined
2845           // prior in this source file
2846           {DebugLn(['AdjustMinPositions "',Item.Name,'=',Item.Code,'"',
2847             ' depends on ',Identifier,
2848             ' defined at ',PosToStr(MinPos),
2849             ' as "',copy(Src,MinPos,30),'"']);}
2850           if Item.MinPosition<MinPos then begin
2851             Item.MinPosition:=MinPos;
2852             Item.MinPositionNeedsTypeSection:=TypeEnd<1;
2853           end;
2854           break;
2855         end;
2856       until false;
2857     end;
2858     Node:=ImplicitTypes.FindSuccessor(Node);
2859   end;
2860 end;
2861 
ReadWordnull2862 function TReplaceImplicitTypes.ReadWord(var Position: integer): boolean;
2863 var
2864   AtomStart: LongInt;
2865   CurAtom: String;
2866 begin
2867   AtomStart:=Position;
2868   CurAtom:=ReadNextPascalAtom(Src,Position,AtomStart);
2869   if (CurAtom<>'') and IsIdentStartChar[CurAtom[1]] then
2870     Result:=true
2871   else begin
2872     DebugLn(['ReadWord word not found at ',PosToStr(AtomStart)]);
2873     Result:=false;
2874   end;
2875 end;
2876 
TReplaceImplicitTypes.ReadUntilAtomnull2877 function TReplaceImplicitTypes.ReadUntilAtom(var Position: integer;
2878   const StopAtom: string; SkipBrackets: boolean = true): boolean;
2879 var
2880   AtomStart: LongInt;
2881   CurAtom: String;
2882   StartPos: LongInt;
2883 begin
2884   Result:=false;
2885   StartPos:=Position;
2886   AtomStart:=Position;
2887   repeat
2888     CurAtom:=ReadNextPascalAtom(Src,Position,AtomStart);
2889     if CurAtom='' then begin
2890       DebugLn(['ReadUntilAtom atom not found: "',StopAtom,'" (starting at ',PosToStr(StartPos),')']);
2891       exit;
2892     end;
2893     if SkipBrackets then begin
2894       if CurAtom='(' then begin
2895         // skip round bracket open
2896         if not ReadUntilAtom(Position,')') then exit;
2897       end else if CurAtom='[' then begin
2898         // skip edged bracket open
2899         if not ReadUntilAtom(Position,']') then exit;
2900       end;
2901     end;
2902   until CurAtom=StopAtom;
2903   Result:=true;
2904 end;
2905 
ReadRecordnull2906 function TReplaceImplicitTypes.ReadRecord(var Position: integer): boolean;
2907 var
2908   AtomStart: LongInt;
2909   CurAtom: String;
2910 begin
2911   Result:=false;
2912   AtomStart:=Position;
2913   repeat
2914     CurAtom:=ReadNextPascalAtom(Src,Position,AtomStart);
2915     if CurAtom='' then begin
2916       DebugLn(['ReadRecord record end not found']);
2917       exit;
2918     end else if CurAtom='(' then begin
2919       // skip round bracket open
2920       if not ReadUntilAtom(Position,')') then exit;
2921     end else if CurAtom='[' then begin
2922       // skip edged bracket open
2923       if not ReadUntilAtom(Position,']') then exit;
2924     end else if CompareIdentifiers(PChar(CurAtom),'CASE')=0 then begin
2925       // read identifier
2926       if not ReadWord(Position) then exit;
2927       CurAtom:=ReadNextPascalAtom(Src,Position,AtomStart);
2928       //DebugLn(['ReadRecord CASE colon or "of" CurAtom="',CurAtom,'"']);
2929       if CurAtom=':' then begin
2930         // read case type
2931         if not ReadWord(Position) then begin
2932           DebugLn(['ReadRecord missing case type at ',PosToStr(Position)]);
2933           exit;
2934         end;
2935         // read 'of'
2936         CurAtom:=ReadNextPascalAtom(Src,Position,AtomStart);
2937         if CurAtom='' then begin
2938           DebugLn(['ReadRecord missing "of" at ',PosToStr(Position)]);
2939           exit;
2940         end;
2941       end;
2942       if CompareIdentifiers(PChar(CurAtom),'OF')<>0 then begin
2943         DebugLn(['ReadRecord record case "of" not found at ',PosToStr(AtomStart)]);
2944         exit;
2945       end;
2946     end else if CurAtom=':' then begin
2947       // skip type
2948       CurAtom:=ReadNextPascalAtom(Src,Position,AtomStart);
2949       if CurAtom='(' then begin
2950         // skip case brackets
2951         if not ReadUntilAtom(Position,')') then exit;
2952       end else begin
2953         // read normal type
2954         Position:=AtomStart;
2955         if not ReadTypeDefinition(Position) then exit;
2956       end;
2957     end;
2958   until CompareIdentifiers(PChar(CurAtom),'END')=0;
2959   Result:=true;
2960 end;
2961 
TReplaceImplicitTypes.ReadClassnull2962 function TReplaceImplicitTypes.ReadClass(var Position: integer): boolean;
2963 var
2964   AtomStart: LongInt;
2965   CurAtom: String;
2966 begin
2967   //DebugLn(['ReadClass at ',PosToStr(Position)]);
2968   Result:=false;
2969   AtomStart:=Position;
2970   CurAtom:=ReadNextPascalAtom(Src,Position,AtomStart);
2971   //DebugLn(['ReadClass first atom "',CurAtom,'"']);
2972   if CurAtom=';' then begin
2973     // this is a forward class definition
2974     //DebugLn(['ReadClass forward defined class found']);
2975     Result:=true;
2976     exit;
2977   end;
2978   repeat
2979     CurAtom:=ReadNextPascalAtom(Src,Position,AtomStart);
2980     //DebugLn(['ReadClass CurAtom="',CurAtom,'"']);
2981     if CurAtom='' then begin
2982       DebugLn(['ReadClass class end not found']);
2983       exit;
2984     end else if CurAtom='(' then begin
2985       // skip round bracket open
2986       if not ReadUntilAtom(Position,')') then exit;
2987     end else if CurAtom='[' then begin
2988       // skip edged bracket open
2989       if not ReadUntilAtom(Position,']') then exit;
2990     end else if CurAtom=':' then begin
2991       // skip type
2992       if not ReadTypeDefinition(Position) then exit;
2993     end;
2994   until CompareIdentifiers(PChar(CurAtom),'END')=0;
2995   Result:=true;
2996 end;
2997 
TReplaceImplicitTypes.ReadTypeDefinitionnull2998 function TReplaceImplicitTypes.ReadTypeDefinition(
2999   var Position: integer): boolean;
3000 // Position must be after the colon
3001 var
3002   AtomStart: LongInt;
3003   CurAtom: String;
3004   Enum: String;
3005 begin
3006   //DebugLn(['ReadTypeDefinition reading type definition at ',PosToStr(Position)]);
3007   Result:=false;
3008   AtomStart:=Position;
3009   CurAtom:=ReadNextPascalAtom(Src,Position,AtomStart);
3010   if CurAtom='(' then begin
3011     // enumeration constants
3012     //DebugLn(['ReadTypeDefinition enumeration found at ',PosToStr(AtomStart)]);
3013     repeat
3014       Enum:=ReadNextPascalAtom(Src,Position,AtomStart);
3015       if (Enum='') then exit;// missing bracket close
3016       if Enum=')' then exit(true);// type end found
3017       if (not IsIdentStartChar[Enum[1]]) then exit;// enum missing
3018       //DebugLn(['ReadTypeDefinition enum ',Enum,' found at ',PosToStr(AtomStart)]);
3019       AdjustMinPositions(Enum);
3020       CurAtom:=ReadNextPascalAtom(Src,Position,AtomStart);
3021       if CurAtom=')' then exit(true);// type end found
3022       if CurAtom<>',' then exit;// comma missing
3023     until false;
3024   end;
3025   repeat
3026     //DebugLn(['ReadTypeDefinition CurAtom="',CurAtom,'"']);
3027     if CurAtom='' then begin
3028       DebugLn(['ReadTypeDefinition type end not found']);
3029       exit;
3030     end;
3031     if IsIdentStartChar[CurAtom[1]] then begin
3032       if CompareIdentifiers(PChar(CurAtom),'RECORD')=0 then begin
3033         // skip record
3034         Result:=ReadRecord(Position);
3035         exit;
3036       end;
3037       if (CompareIdentifiers(PChar(CurAtom),'CLASS')=0)
3038       or (CompareIdentifiers(PChar(CurAtom),'OBJECT')=0)
3039       or (CompareIdentifiers(PChar(CurAtom),'INTERFACE')=0)
3040       or (CompareIdentifiers(PChar(CurAtom),'DISPINTERFACE')=0)
3041       then begin
3042         // skip record
3043         Result:=ReadClass(Position);
3044         exit;
3045       end;
3046     end else if CurAtom='(' then begin
3047       // skip round bracket open
3048       if not ReadUntilAtom(Position,')') then exit;
3049     end else if CurAtom='[' then begin
3050       // skip edged bracket open
3051       if not ReadUntilAtom(Position,']') then exit;
3052     end else if (length(CurAtom)=1) and (CurAtom[1] in [';',')',']']) then
3053       break;
3054     CurAtom:=ReadNextPascalAtom(Src,Position,AtomStart);
3055   until false;
3056   Result:=true;
3057 end;
3058 
TReplaceImplicitTypes.ReadConstSectionnull3059 function TReplaceImplicitTypes.ReadConstSection(var Position: integer): boolean;
3060 // Position must be after the 'const' keyword
3061 var
3062   AtomStart: LongInt;
3063   CurAtom: String;
3064   ConstStart: LongInt;
3065 begin
3066   Result:=false;
3067   AtomStart:=Position;
3068   repeat
3069     CurAtom:=ReadNextPascalAtom(Src,Position,AtomStart);
3070     if CurAtom='' then begin
3071       DebugLn(['ReadConstSection end not found']);
3072       exit;
3073     end;
3074     if IsIdentStartChar[CurAtom[1]] then begin
3075       // const identifier(s) or end of const section
3076       //DebugLn(['ReadConstSection Const name ',CurAtom,' at ',PosToStr(AtomStart)]);
3077       ConstStart:=AtomStart;
3078       // for example: a,b,c: integer = 1; d=1, e:integer=0;
3079       CurAtom:=ReadNextPascalAtom(Src,Position,AtomStart);
3080       if (length(CurAtom)<>1) or (not (CurAtom[1] in [',','=',':'])) then
3081       begin
3082         // end of const section
3083         Position:=ConstStart;
3084         Result:=true;
3085         exit;
3086       end;
3087       Position:=ConstStart;
3088       repeat
3089         CurAtom:=ReadNextPascalAtom(Src,Position,AtomStart);
3090         // read identifier
3091         if (CurAtom<>'') and IsIdentStartChar[CurAtom[1]] then begin
3092           // identifier
3093           AdjustMinPositions(CurAtom);
3094         end else begin
3095           DebugLn(['ReadConstSection end of section missing']);
3096           exit;
3097         end;
3098         CurAtom:=ReadNextPascalAtom(Src,Position,AtomStart);
3099         if (CurAtom='=') or (CurAtom=':') then begin
3100           // skip type and expression
3101           if not ReadUntilAtom(Position,';') then exit;
3102           break;
3103         end else if CurAtom=',' then begin
3104           // next const name
3105         end else begin
3106           DebugLn(['ReadConstSection end of section missing']);
3107           exit;
3108         end;
3109       until false;
3110     end else begin
3111       // end of const section
3112       break;
3113     end;
3114   until false;
3115   Result:=true;
3116 end;
3117 
TReplaceImplicitTypes.FindExplicitTypesAndConstantsnull3118 function TReplaceImplicitTypes.FindExplicitTypesAndConstants(
3119   var ModalResult: TModalResult): boolean;
3120 { every implicit type can contain references to explicit types and constants
3121   For example: array[0..3] of bogus
3122   If 'bogus' is defined in this source, then the new type must be defined
3123   after 'bogus'.
3124   => Search all explicit types
3125 }
3126 var
3127   Position: Integer;
3128   AtomStart: LongInt;
3129   CurAtom: String;
3130   Identifier: String;
3131   TypeDefStart: LongInt;
3132   ErrLine: integer;
3133   ErrCol: integer;
3134 begin
3135   Result:=false;
3136   ModalResult:=mrCancel;
3137 
3138   Position:=1;
3139   AtomStart:=Position;
3140   repeat
3141     CurAtom:=ReadNextPascalAtom(Src,Position,AtomStart);
3142     //DebugLn(['FindExplicitTypes CurAtom="',CurAtom,'"']);
3143     if CurAtom='' then break;
3144     if CompareIdentifiers(PChar(CurAtom),'type')=0 then begin
3145       // type section found
3146       //DebugLn(['FindExplicitTypes type section found at ',PosToStr(AtomStart)]);
3147       repeat
3148         Identifier:=ReadNextPascalAtom(Src,Position,AtomStart);
3149         if (Identifier<>'') and (IsIdentStartChar[Identifier[1]]) then begin
3150           // word found (can be an identifier or start of next section)
3151           TypeStart:=AtomStart;
3152           TypeEnd:=0;
3153           CurAtom:=ReadNextPascalAtom(Src,Position,AtomStart);
3154           if CurAtom<>'=' then begin
3155             //DebugLn(['FindExplicitTypes type section ended at ',PosToStr(AtomStart)]);
3156             break;
3157           end;
3158           // Identifier is a type => find end of type definition
3159           //DebugLn(['FindExplicitTypes type definition found: ',Identifier,' at ',PosToStr(TypeStart)]);
3160           TypeDefStart:=Position;
3161           Result:=ReadTypeDefinition(Position);
3162           if not Result then begin
3163             SrcPosToLineCol(Src,TypeStart,ErrLine,ErrCol);
3164             ErrorColumn:=ErrCol;
3165             ErrorLine:=ErrLine;
3166             ErrorMsg := Format(h2pFindExplicitTypesFAILEDReadingTypeDefinition, [Identifier]);
3167             DebugLn(['FindExplicitTypes FAILED reading type definition ',Identifier,' at ',PosToStr(TypeStart)]);
3168             exit;
3169           end;
3170           TypeEnd:=Position;
3171           // add the semicolon, if not already done
3172           CurAtom:=ReadNextPascalAtom(Src,Position,AtomStart);
3173           if CurAtom=';' then
3174             TypeEnd:=Position;
3175           // adjust implicit identifiers
3176           AdjustMinPositions(Identifier);
3177           // reread the type for the enums
3178           Position:=TypeDefStart;
3179           //DebugLn(['FindExplicitTypes Rereading type definition ',Identifier,' at ',PosToStr(TypeStart)]);
3180           Result:=ReadTypeDefinition(Position);
3181           if not Result then begin
3182             SrcPosToLineCol(Src,TypeStart,ErrLine,ErrCol);
3183             ErrorColumn:=ErrCol;
3184             ErrorLine:=ErrLine;
3185             ErrorMsg := Format(h2pFindExplicitTypesFAILEDRereadingTypeDefinition, [Identifier]);
3186             DebugLn(['FindExplicitTypes FAILED Rereading type definition ',Identifier,' at ',PosToStr(TypeStart)]);
3187             exit;
3188           end;
3189           // skip semicolon
3190           Position:=TypeEnd;
3191           TypeEnd:=0;
3192         end;
3193       until false;
3194     end
3195     else if CompareIdentifiers(PChar(CurAtom),'const')=0 then begin
3196       ConstSectionStart:=Position;
3197       ConstSectionEnd:=0;
3198       // find end of const section
3199       //DebugLn(['TReplaceImplicitTypes.FindExplicitTypesAndConstants finding end of const section ...']);
3200       Result:=ReadConstSection(Position);
3201       if not Result then begin
3202         SrcPosToLineCol(Src,ConstSectionStart,ErrLine,ErrCol);
3203         ErrorColumn:=ErrCol;
3204         ErrorLine:=ErrLine;
3205         ErrorMsg := h2pFindExplicitTypesFAILEDReadingConstSection;
3206         DebugLn(['FindExplicitTypes FAILED reading const section at ',PosToStr(ConstSectionStart)]);
3207         exit;
3208       end;
3209       ConstSectionEnd:=Position;
3210       // reread the section for the identifiers
3211       Position:=ConstSectionStart;
3212       //DebugLn(['TReplaceImplicitTypes.FindExplicitTypesAndConstants collecting const identifiers ...']);
3213       Result:=ReadConstSection(Position);
3214       if not Result then begin
3215         SrcPosToLineCol(Src,ConstSectionStart,ErrLine,ErrCol);
3216         ErrorColumn:=ErrCol;
3217         ErrorLine:=ErrLine;
3218         ErrorMsg := h2pFindExplicitTypesFAILEDReadingConstSection;
3219         DebugLn(['FindExplicitTypes FAILED reading const section at ',PosToStr(ConstSectionStart)]);
3220         exit;
3221       end;
3222       ConstSectionEnd:=0;
3223     end;
3224   until false;
3225 
3226   ModalResult:=mrOk;
3227   Result:=true;
3228 end;
3229 
InsertNewTypesnull3230 function TReplaceImplicitTypes.InsertNewTypes(var ModalResult: TModalResult
3231   ): boolean;
3232 
CreateCodenull3233   function CreateCode(Item: TImplicitType): string;
3234   begin
3235     Result:='  '+Item.Name+' = '+Item.Code+';';
3236   end;
3237 
3238 var
3239   Node: TAVLTreeNode;
3240   Item: TImplicitType;
3241   InsertPos: integer;
3242   NextItem: TImplicitType;
3243   NextInsertPos: integer;
3244   NewCode: String;
3245 begin
3246   Result:=false;
3247   ModalResult:=mrCancel;
3248   if (ImplicitTypes<>nil) then begin
3249     // re-sort the ImplicitTypes for MinPosition
3250     ImplicitTypes.OnCompare:=@CompareImplicitTypeMinPositions;
3251     try
3252       // Insert every type
3253       Node:=ImplicitTypes.FindHighest;
3254       while Node<>nil do begin
3255         Item:=TImplicitType(Node.Data);
3256         NewCode:=CreateCode(Item);
3257         if Item.MinPositionNeedsTypeSection or (Item.MinPosition=0) then
3258           NewCode:='type'+LineEnding+NewCode;
3259         InsertPos:=FindInsertPosition(Item.MinPosition);
3260         // add all items at the same position
3261         repeat
3262           Node:=ImplicitTypes.FindPrecessor(Node);
3263           if (Node=nil) then break;
3264           NextItem:=TImplicitType(Node.Data);
3265           NextInsertPos:=FindLineEndOrCodeAfterPosition(Src,NextItem.MinPosition,
3266                                                         length(Src)+1,false);
3267           if InsertPos>NextInsertPos then
3268             break;
3269           NewCode:=NewCode+LineEnding+CreateCode(NextItem);
3270         until false;
3271 
3272         // insert line ends
3273         if (InsertPos>1) and (InsertPos<length(Src))
3274         and (not (Src[InsertPos-1] in [#10,#13])) then
3275           NewCode:=LineEnding+NewCode;
3276         if (InsertPos<=length(Src)) and (not (Src[InsertPos] in [#10,#13])) then
3277           NewCode:=NewCode+LineEnding;
3278 
3279         // insert code
3280         DebugLn(['TReplaceImplicitTypes.InsertNewTypes Insert at ',PosToStr(InsertPos),' NewCode="',NewCode,'"']);
3281         Src:=copy(Src,1,InsertPos-1)+NewCode+copy(Src,InsertPos,length(Src));
3282       end;
3283     finally
3284       // re-sort the ImplicitTypes for Names
3285       ImplicitTypes.OnCompare:=@CompareImplicitTypeNames;
3286     end;
3287   end;
3288   ModalResult:=mrOk;
3289   Result:=true;
3290 end;
3291 
FindInsertPositionnull3292 function TReplaceImplicitTypes.FindInsertPosition(MinPos: integer): integer;
3293 var
3294   Position: Integer;
3295   AtomStart: LongInt;
3296   CurAtom: String;
3297 begin
3298   if MinPos>0 then begin
3299     Result:=FindLineEndOrCodeAfterPosition(Src,MinPos,length(Src)+1,false);
3300   end else begin
3301     // find insert position for a first type section
3302     Result:=1;
3303     Position:=1;
3304     AtomStart:=Position;
3305     repeat
3306       CurAtom:=ReadNextPascalAtom(Src,Position,AtomStart);
3307       if CurAtom='' then break;
3308       if (CompareIdentifiers(PChar(CurAtom),'UNIT')=0)
3309       or (CompareIdentifiers(PChar(CurAtom),'PROGRAM')=0)
3310       or (CompareIdentifiers(PChar(CurAtom),'LIBRARY')=0)
3311       or (CompareIdentifiers(PChar(CurAtom),'PACKAGE')=0)
3312       or (CompareIdentifiers(PChar(CurAtom),'USES')=0)
3313       then begin
3314         ReadUntilAtom(Position,';');
3315         Result:=Position;
3316       end
3317       else if (CompareIdentifiers(PChar(CurAtom),'INTERFACE')=0)
3318       or (CompareIdentifiers(PChar(CurAtom),'IMPLEMENTATION')=0)
3319       then begin
3320         Result:=Position;
3321         // skip uses section
3322         CurAtom:=ReadNextPascalAtom(Src,Position,AtomStart);
3323         if (CurAtom<>'')
3324         and (CompareIdentifiers(PChar(CurAtom),'USES')=0) then begin
3325           ReadUntilAtom(Position,';');
3326           Result:=Position;
3327         end;
3328         break;
3329       end else
3330         break;
3331     until false;
3332   end;
3333 end;
3334 
UseNewTypesnull3335 function TReplaceImplicitTypes.UseNewTypes(var ModalResult: TModalResult
3336   ): boolean;
3337 var
3338   Position: Integer;
3339   StartPos: Integer;
3340   EndPos: Integer;
3341   TypeCode: String;
3342   TypeName: String;
3343   Node: TAVLTreeNode;
3344   Item: TImplicitType;
3345 begin
3346   Result:=false;
3347   ModalResult:=mrCancel;
3348   if (ImplicitTypes<>nil) then begin
3349     Position:=1;
3350     StartPos:=1;
3351     EndPos:=1;
3352     while FindNextImplicitType(Position,StartPos,EndPos) do begin
3353       TypeCode:=copy(Src,StartPos,EndPos-StartPos);
3354       //DebugLn(['UseNewTypes ',StartPos,' TypeCode="',TypeCode,'"']);
3355       TypeName:=CodeToIdentifier(TypeCode);
3356       if TypeName='' then continue;
3357       Node:=ImplicitTypes.FindKey(Pointer(TypeName),
3358                          @CompareImplicitTypeStringAndName);
3359       if Node<>nil then begin
3360         // replace
3361         Item:=TImplicitType(Node.Data);
3362         Src:=copy(Src,1,StartPos-1)+Item.Name+copy(Src,EndPos,length(Src));
3363         Position:=StartPos+length(Item.Name);
3364       end;
3365     end;
3366   end;
3367   ModalResult:=mrOk;
3368   Result:=true;
3369 end;
3370 
Executenull3371 function TReplaceImplicitTypes.Execute(aText: TIDETextConverter
3372   ): TModalResult;
3373 begin
3374   Src:=aText.Source;
3375   if Src='' then exit(mrOk);
3376 
3377   ImplicitTypes:=nil;
3378   ExplicitTypes:=nil;
3379   TypeEnd:=0;
3380   ConstSectionEnd:=0;
3381   try
3382     if not SearchImplicitParameterTypes(Result) then exit;
3383     if (ImplicitTypes<>nil) then begin
3384       if not FindExplicitTypesAndConstants(Result) then exit;
3385       if not InsertNewTypes(Result) then exit;
3386       if not UseNewTypes(Result) then exit;
3387       aText.Source:=Src;
3388     end;
3389   finally
3390     if ImplicitTypes<>nil then begin
3391       ImplicitTypes.FreeAndClear;
3392       ImplicitTypes.Free;
3393     end;
3394     if ExplicitTypes<>nil then begin
3395       ExplicitTypes.FreeAndClear;
3396       ExplicitTypes.Free;
3397     end;
3398   end;
3399   Result:=mrOk;
3400 end;
3401 
CodeToIdentifiernull3402 function TReplaceImplicitTypes.CodeToIdentifier(const Code: string): string;
3403 // for example:
3404 //   array[0..3] of integer  -> TArray0to3OfInteger
3405 var
3406   Position: Integer;
3407   AtomStart: LongInt;
3408   CurAtom: String;
3409   i: Integer;
3410 begin
3411   Result:='T';
3412   Position:=1;
3413   AtomStart:=Position;
3414   repeat
3415     CurAtom:=ReadNextPascalAtom(Code,Position,AtomStart);
3416     if CurAtom='' then exit;
3417     if CurAtom='..' then
3418       // range
3419       Result:=Result+'to'
3420     else if IsIdentStartChar[CurAtom[1]] then
3421       // word
3422       Result:=Result+upCase(CurAtom[1])+copy(CurAtom,2,length(CurAtom))
3423     else begin
3424       // otherwise: add word and number characters
3425       for i:=1 to length(CurAtom) do begin
3426         case CurAtom[i] of
3427         '0'..'9','_','a'..'z','A'..'Z': Result:=Result+CurAtom[i];
3428         '.': Result:=Result+'.';
3429         end;
3430       end;
3431     end;
3432     if length(Result)>200 then begin
3433       Result:=copy(Result,1,200);
3434       exit;
3435     end;
3436   until false;
3437 end;
3438 
3439 { TFixArrayOfParameterType }
3440 
TFixArrayOfParameterType.ClassDescriptionnull3441 class function TFixArrayOfParameterType.ClassDescription: string;
3442 begin
3443   Result := Format(h2pFixOpenArraysReplaceArrayOfWithArrayOfConst, [#13]);
3444 end;
3445 
TFixArrayOfParameterType.Executenull3446 function TFixArrayOfParameterType.Execute(aText: TIDETextConverter
3447   ): TModalResult;
3448 { search for
3449     array of )
3450   and replace it with
3451     array of const)
3452 }
3453 var
3454   Lines: TStrings;
3455   i: Integer;
3456   Line: string;
3457   MatchPos: integer;
3458   MatchLen: integer;
3459 begin
3460   Result:=mrCancel;
3461   if aText=nil then exit;
3462   Lines:=aText.Strings;
3463   i:=0;
3464   while i<=Lines.Count-1 do begin
3465     Line:=Lines[i];
3466     if REMatches(Line,'array of *\)','I') then begin
3467       REVarPos(0,MatchPos,MatchLen);
3468       Lines[i]:=copy(Line,1,MatchPos-1)+'array of const)'
3469                 +copy(Line,MatchPos+MatchLen,length(Line));
3470     end;
3471     inc(i);
3472   end;
3473   Result:=mrOk;
3474 end;
3475 
3476 { TH2PasFileCInclude }
3477 
3478 procedure TH2PasFileCInclude.SetFilename(const AValue: string);
3479 begin
3480   if FFilename=AValue then exit;
3481   FFilename:=AValue;
3482 end;
3483 
3484 procedure TH2PasFileCInclude.SetH2PasFile(const AValue: TH2PasFile);
3485 begin
3486   if FH2PasFile=AValue then exit;
3487   if (FH2PasFile<>nil) then
3488     FH2PasFile.InternalRemoveCIncludedBy(Self);
3489   FH2PasFile:=AValue;
3490   if (FH2PasFile<>nil) then
3491     FH2PasFile.InternalAddCIncludedBy(Self);
3492 end;
3493 
3494 procedure TH2PasFileCInclude.SetSrcFilename(const AValue: string);
3495 begin
3496   if FSrcFilename=AValue then exit;
3497   FSrcFilename:=AValue;
3498   FFilename:='';
3499 end;
3500 
3501 procedure TH2PasFileCInclude.SetSrcPos(const AValue: TPoint);
3502 begin
3503   FSrcPos:=AValue;
3504 end;
3505 
3506 constructor TH2PasFileCInclude.Create(TheOwner: TH2PasFile);
3507 begin
3508   FOwner:=TheOwner;
3509 end;
3510 
3511 destructor TH2PasFileCInclude.Destroy;
3512 begin
3513   H2PasFile:=nil;
3514   inherited Destroy;
3515 end;
3516 
3517 { TRemoveRedefinitionsInUnit }
3518 
TRemoveRedefinitionsInUnit.ClassDescriptionnull3519 class function TRemoveRedefinitionsInUnit.ClassDescription: string;
3520 begin
3521   Result := h2pRemoveRedefinitionsInPascalUnit;
3522 end;
3523 
Executenull3524 function TRemoveRedefinitionsInUnit.Execute(aText: TIDETextConverter
3525   ): TModalResult;
3526 begin
3527   Result:=mrCancel;
3528   //DebugLn(['TRemoveRedefinitionsInUnit.Execute START ',aText.Source]);
3529   if (not FilenameIsPascalUnit(aText.Filename)) then begin
3530     DebugLn(['TRemoveRedefinitionsInUnit.Execute file is not pascal: ',aText.Filename]);
3531     exit(mrOk);// ignore
3532   end;
3533   if not CodeToolBoss.RemoveAllRedefinitions(TCodeBuffer(aText.CodeBuffer)) then begin
3534     AssignCodeToolBossError;
3535     DebugLn(['TRemoveRedefinitionsInUnit.Execute RemoveAllRedefinitions failed ',CodeToolBoss.ErrorMessage]);
3536     exit;
3537   end;
3538   //DebugLn(['TRemoveRedefinitionsInUnit.Execute END ',aText.Source]);
3539   Result:=mrOk;
3540 end;
3541 
3542 { TFixAliasDefinitionsInUnit }
3543 
TFixAliasDefinitionsInUnit.ClassDescriptionnull3544 class function TFixAliasDefinitionsInUnit.ClassDescription: string;
3545 begin
3546   Result := Format(h2pFixesSectionTypeOfAliasDefinitionsInPascalUnitChec, [#13, #13, #13]);
3547 end;
3548 
Executenull3549 function TFixAliasDefinitionsInUnit.Execute(aText: TIDETextConverter
3550   ): TModalResult;
3551 begin
3552   Result:=mrCancel;
3553   if aText=nil then exit;
3554   if (not FilenameIsPascalUnit(aText.Filename)) then begin
3555     DebugLn(['TFixAliasDefinitionsInUnit.Execute file is not pascal: ',aText.Filename]);
3556     exit(mrOk);// ignore
3557   end;
3558   if not CodeToolBoss.FixAllAliasDefinitions(TCodeBuffer(aText.CodeBuffer)) then begin
3559     AssignCodeToolBossError;
3560     DebugLn(['TFixAliasDefinitionsInUnit.Execute FixAllAliasDefinitions failed ',CodeToolBoss.ErrorMessage]);
3561     exit;
3562   end;
3563   Result:=mrOk;
3564 end;
3565 
3566 { TFixH2PasMissingIFDEFsInUnit }
3567 
TFixH2PasMissingIFDEFsInUnit.ClassDescriptionnull3568 class function TFixH2PasMissingIFDEFsInUnit.ClassDescription: string;
3569 begin
3570   Result := h2pAddMissingH2pasIFDEFsForFunctionBodies;
3571 end;
3572 
Executenull3573 function TFixH2PasMissingIFDEFsInUnit.Execute(aText: TIDETextConverter
3574   ): TModalResult;
3575 var
3576   Code: TCodeBuffer;
3577   Changed: Boolean;
3578 begin
3579   Result:=mrCancel;
3580   Changed:=false;
3581   Code:=TCodeBuffer(aText.CodeBuffer);
3582   if not CodeToolBoss.FixMissingH2PasDirectives(Code,Changed) then begin
3583     AssignCodeToolBossError;
3584     DebugLn(['TFixH2PasMissingIFDEFsInUnit.Execute failed ',CodeToolBoss.ErrorMessage]);
3585     exit;
3586   end;
3587   Result:=mrOk;
3588 end;
3589 
3590 { TReduceCompilerDirectivesInUnit }
3591 
3592 procedure TReduceCompilerDirectivesInUnit.SetDefines(const AValue: TStrings);
3593 begin
3594   if FDefines=AValue then exit;
3595   FDefines.Assign(AValue);
3596 end;
3597 
3598 procedure TReduceCompilerDirectivesInUnit.SetUndefines(const AValue: TStrings);
3599 begin
3600   if FUndefines=AValue then exit;
3601   FUndefines.Assign(AValue);
3602 end;
3603 
3604 constructor TReduceCompilerDirectivesInUnit.Create(TheOwner: TComponent);
3605 begin
3606   inherited Create(TheOwner);
3607   FUndefines:=TStringList.Create;
3608   FDefines:=TStringList.Create;
3609 end;
3610 
3611 destructor TReduceCompilerDirectivesInUnit.Destroy;
3612 begin
3613   FreeAndNil(FUndefines);
3614   FreeAndNil(FDefines);
3615   inherited Destroy;
3616 end;
3617 
TReduceCompilerDirectivesInUnit.ClassDescriptionnull3618 class function TReduceCompilerDirectivesInUnit.ClassDescription: string;
3619 begin
3620   Result := Format(h2pReduceCompilerDirectivesInPascalFileShortensExpres, [#13, #13]);
3621 end;
3622 
Executenull3623 function TReduceCompilerDirectivesInUnit.Execute(aText: TIDETextConverter
3624   ): TModalResult;
3625 var
3626   Changed: Boolean;
3627   Code: TCodeBuffer;
3628 begin
3629   Result:=mrCancel;
3630   Changed:=false;
3631   Code:=TCodeBuffer(aText.CodeBuffer);
3632   if not CodeToolBoss.ReduceCompilerDirectives(Code,Undefines,Defines,Changed)
3633   then begin
3634     AssignCodeToolBossError;
3635     DebugLn(['TReduceCompilerDirectivesInUnit.Execute failed ',ErrorMsg]);
3636     exit;
3637   end;
3638   Result:=mrOk;
3639 end;
3640 
3641 { TReplaceConstFunctionsInUnit }
3642 
TReplaceConstFunctionsInUnit.ClassDescriptionnull3643 class function TReplaceConstFunctionsInUnit.ClassDescription: string;
3644 begin
3645   Result := h2pReplaceSimpleFunctionsWithConstants;
3646 end;
3647 
Executenull3648 function TReplaceConstFunctionsInUnit.Execute(aText: TIDETextConverter
3649   ): TModalResult;
3650 begin
3651   Result:=mrCancel;
3652   if (not FilenameIsPascalUnit(aText.Filename)) then begin
3653     DebugLn(['TReplaceConstFunctionsInUnit.Execute file is not pascal: ',aText.Filename]);
3654     exit(mrOk);// ignore
3655   end;
3656   if not CodeToolBoss.ReplaceAllConstFunctions(TCodeBuffer(aText.CodeBuffer)) then begin
3657     AssignCodeToolBossError;
3658     DebugLn(['TReplaceConstFunctionsInUnit.Execute ReplaceAllConstFunctions failed ',CodeToolBoss.ErrorMessage]);
3659     exit;
3660   end;
3661   Result:=mrOk;
3662 end;
3663 
3664 { TReplaceTypeCastFunctionsInUnit }
3665 
TReplaceTypeCastFunctionsInUnit.ClassDescriptionnull3666 class function TReplaceTypeCastFunctionsInUnit.ClassDescription: string;
3667 begin
3668   Result := h2pReplaceSimpleFunctionsWithTypeCasts;
3669 end;
3670 
Executenull3671 function TReplaceTypeCastFunctionsInUnit.Execute(aText: TIDETextConverter
3672   ): TModalResult;
3673 begin
3674   Result:=mrCancel;
3675   if (not FilenameIsPascalUnit(aText.Filename)) then begin
3676     DebugLn(['TReplaceTypeCastFunctionsInUnit.Execute file is not pascal: ',aText.Filename]);
3677     exit(mrOk);// ignore
3678   end;
3679   if not CodeToolBoss.ReplaceAllTypeCastFunctions(TCodeBuffer(aText.CodeBuffer)) then begin
3680     AssignCodeToolBossError;
3681     DebugLn(['TReplaceTypeCastFunctionsInUnit.Execute ReplaceAllTypeCastFunctions failed ',CodeToolBoss.ErrorMessage]);
3682     exit;
3683   end;
3684   Result:=mrOk;
3685 end;
3686 
3687 { TPreH2PasTools }
3688 
3689 constructor TPreH2PasTools.Create(TheOwner: TComponent);
3690 begin
3691   inherited Create(TheOwner);
3692   FOptions:=DefaultPreH2PasToolsOptions;
3693 end;
3694 
TPreH2PasTools.ClassDescriptionnull3695 class function TPreH2PasTools.ClassDescription: string;
3696 begin
3697   Result := Format(h2pPreH2PasASetOfCommonToolsToRunBeforeH2pasPhRemoveC, [#13, #13, #13, #13, #13, #13, #13, #13, #13])
3698     ;
3699 end;
3700 
Executenull3701 function TPreH2PasTools.Execute(aText: TIDETextConverter): TModalResult;
3702 
Runnull3703   function Run(Option: TPreH2PasToolsOption;
3704     ToolClass: TCustomTextConverterToolClass;
3705     out aResult: TModalResult): boolean;
3706   var
3707     Tool: TCustomTextConverterTool;
3708   begin
3709     Result:=true;
3710     aResult:=mrOk;
3711     if not (Option in Options) then exit;
3712     DebugLn(['TPreH2PasTools.Execute.Run ',ToolClass.ClassName]);
3713     Tool:=ToolClass.Create(nil);
3714     try
3715       Tool.ClearError;
3716       aResult:=Tool.Execute(aText);
3717       if aResult<>mrOk then begin
3718         AssignError(Tool);
3719         DebugLn(['TPreH2PasTools.Execute.Run failed: ',ToolClass.ClassName]);
3720         exit(false);
3721       end;
3722     finally
3723       Tool.Free;
3724     end;
3725   end;
3726 
3727 begin
3728   if not Run(phRemoveCPlusPlusExternCTool,
3729              TRemoveCPlusPlusExternCTool,Result) then exit;
3730   if not Run(phRemoveEmptyCMacrosTool,
3731              TRemoveEmptyCMacrosTool,Result) then exit;
3732   if not Run(phReplaceEdgedBracketPairWithStar,
3733              TReplaceEdgedBracketPairWithStar,Result) then exit;
3734   if not Run(phReplaceMacro0PointerWithNULL,
3735              TReplaceMacro0PointerWithNULL,Result) then exit;
3736   if not Run(phConvertFunctionTypesToPointers,
3737              TConvertFunctionTypesToPointers,Result) then exit;
3738   if not Run(phConvertEnumsToTypeDef,
3739              TConvertEnumsToTypeDef,Result) then exit;
3740   if not Run(phCommentComplexCMacros,
3741              TCommentComplexCMacros,Result) then exit;
3742   if not Run(phCommentComplexCFunctions,
3743              TCommentComplexCFunctions,Result) then exit;
3744   if not Run(phAddMissingMacroBrackets,
3745              TAddMissingMacroBrackets,Result) then exit;
3746   Result:=mrOk;
3747 end;
3748 
3749 { TPostH2PasTools }
3750 
3751 procedure TPostH2PasTools.SetDefines(const AValue: TStrings);
3752 begin
3753   if FDefines=AValue then exit;
3754   FDefines.Assign(AValue);
3755 end;
3756 
3757 procedure TPostH2PasTools.SetUndefines(const AValue: TStrings);
3758 begin
3759   if FUndefines=AValue then exit;
3760   FUndefines.Assign(AValue);
3761 end;
3762 
3763 procedure TPostH2PasTools.SetUseUnits(const AValue: TStrings);
3764 begin
3765   if FUseUnits=AValue then exit;
3766   FUseUnits.Assign(FUseUnits);
3767 end;
3768 
3769 constructor TPostH2PasTools.Create(TheOwner: TComponent);
3770 begin
3771   inherited Create(TheOwner);
3772   FDefines:=TStringList.Create;
3773   FUndefines:=TStringList.Create;
3774   FUseUnits:=TStringList.Create;
3775   FOptions:=DefaultPostH2PasToolsOptions;
3776 end;
3777 
3778 destructor TPostH2PasTools.Destroy;
3779 begin
3780   FreeAndNil(FDefines);
3781   FreeAndNil(FUndefines);
3782   FreeAndNil(FUseUnits);
3783   inherited Destroy;
3784 end;
3785 
TPostH2PasTools.ClassDescriptionnull3786 class function TPostH2PasTools.ClassDescription: string;
3787 begin
3788   Result := Format(h2pPostH2PasASetOfCommonToolsToRunAfterH2pasPhReplace, [#13, #13, #13, #13, #13, #13, #13, #13, #13, #13, #13, #13, #13, #13, #13, #13])
3789     ;
3790 end;
3791 
Executenull3792 function TPostH2PasTools.Execute(aText: TIDETextConverter): TModalResult;
3793 
Runnull3794   function Run(Option: TPostH2PasToolsOption;
3795     ToolClass: TCustomTextConverterToolClass;
3796     var aResult: TModalResult): boolean;
3797   var
3798     Tool: TCustomTextConverterTool;
3799   begin
3800     Result:=true;
3801     aResult:=mrOk;
3802     if not (Option in Options) then exit;
3803     DebugLn(['TPostH2PasTools.Execute.Run ',ToolClass.ClassName]);
3804     Tool:=ToolClass.Create(nil);
3805     try
3806       Tool.ClearError;
3807       aResult:=Tool.Execute(aText);
3808       if aResult<>mrOk then begin
3809         AssignError(Tool);
3810         DebugLn(['TPostH2PasTools.Execute.Run failed: ',ToolClass.ClassName]);
3811         exit(false);
3812       end;
3813     finally
3814       Tool.Free;
3815     end;
3816   end;
3817 
ReduceCompilerDirectivesnull3818   function ReduceCompilerDirectives(var Changed: boolean;
3819     var aResult: TModalResult): boolean;
3820   var
3821     Code: TCodeBuffer;
3822   begin
3823     aResult:=mrOk;
3824     if not (phReduceCompilerDirectivesInUnit in Options) then exit;
3825     DebugLn(['TPostH2PasTools.Execute.ReduceCompilerDirectives ']);
3826     Code:=TCodeBuffer(aText.CodeBuffer);
3827     if not CodeToolBoss.ReduceCompilerDirectives(Code,Undefines,Defines,Changed)
3828     then begin
3829       DebugLn(['TPostH2PasTools.Execute.ReduceCompilerDirectives failed']);
3830       AssignCodeToolBossError;
3831       aResult:=mrCancel;
3832       exit(false);
3833     end;
3834     aResult:=mrOk;
3835     Result:=true;
3836   end;
3837 
AddToUsesSectionnull3838   function AddToUsesSection(var Changed: boolean;
3839     var aResult: TModalResult): boolean;
3840   var
3841     i: Integer;
3842     UnitName: string;
3843   begin
3844     aResult:=mrOk;
3845     if not (phAddUnitsToUsesSection in Options) then exit;
3846     DebugLn(['TPostH2PasTools.Execute.AddToUsesSection ']);
3847     for i:=0 to FUseUnits.Count-1 do begin
3848       UnitName:=FUseUnits[i];
3849       if (UnitName='') then continue;
3850       if not IsValidIdent(UnitName) then
3851         raise Exception.Create(Format(h2pTPostH2PasToolsExecuteAddToUsesSectionInvalidUnitn, [UnitName]));
3852       Changed:=true;
3853       if not CodeToolBoss.AddUnitToMainUsesSection(TCodeBuffer(aText.CodeBuffer),UnitName,'')
3854       then begin
3855         AssignCodeToolBossError;
3856         DebugLn(['TPostH2PasTools.Execute.AddToUsesSection failed ',CodeToolBoss.ErrorMessage]);
3857         aResult:=mrCancel;
3858         exit(false);
3859       end;
3860     end;
3861     aResult:=mrOk;
3862     Result:=true;
3863   end;
3864 
ConvertSimpleFunctionsnull3865   function ConvertSimpleFunctions(var Changed: boolean;
3866     var aResult: TModalResult): boolean;
3867   var
3868     Code: TCodeBuffer;
3869     OldChangeStep: LongInt;
3870   begin
3871     aResult:=mrOk;
3872     OldChangeStep:=CodeToolBoss.ChangeStep;
3873     if (phReplaceConstFunctionsInUnit in Options) then begin
3874       DebugLn(['TPostH2PasTools.Execute ReplaceAllConstFunctions ']);
3875       Code:=TCodeBuffer(aText.CodeBuffer);
3876       if not CodeToolBoss.ReplaceAllConstFunctions(Code) then begin
3877         DebugLn(['ReplaceAllConstFunctions failed']);
3878         AssignCodeToolBossError;
3879         aResult:=mrCancel;
3880         exit(false);
3881       end;
3882     end;
3883     if (phReplaceTypeCastFunctionsInUnit in Options) then begin
3884       Code:=TCodeBuffer(aText.CodeBuffer);
3885       DebugLn(['TPostH2PasTools.Execute ReplaceAllTypeCastFunctions ']);
3886       if not CodeToolBoss.ReplaceAllTypeCastFunctions(Code) then begin
3887         DebugLn(['ReplaceAllTypeCastFunctions failed']);
3888         AssignCodeToolBossError;
3889         aResult:=mrCancel;
3890         exit(false);
3891       end;
3892     end;
3893     if OldChangeStep<>CodeToolBoss.ChangeStep then
3894       Changed:=true;
3895     aResult:=mrOk;
3896     Result:=true;
3897   end;
3898 
FixAliasDefinitionsnull3899   function FixAliasDefinitions(var Changed: boolean;
3900     var aResult: TModalResult): boolean;
3901   var
3902     Code: TCodeBuffer;
3903     OldChangeStep: LongInt;
3904   begin
3905     aResult:=mrOk;
3906     OldChangeStep:=CodeToolBoss.ChangeStep;
3907     if (phFixAliasDefinitionsInUnit in Options) then begin
3908       DebugLn(['TPostH2PasTools.Execute FixAllAliasDefinitions ']);
3909       Code:=TCodeBuffer(aText.CodeBuffer);
3910       if not CodeToolBoss.FixAllAliasDefinitions(Code) then begin
3911         DebugLn(['FixAliasDefinitions failed']);
3912         AssignCodeToolBossError;
3913         aResult:=mrCancel;
3914         exit(false);
3915       end;
3916     end;
3917     if OldChangeStep<>CodeToolBoss.ChangeStep then
3918       Changed:=true;
3919     aResult:=mrOk;
3920     Result:=true;
3921   end;
3922 
3923 var
3924   Changed: boolean;
3925 begin
3926   Result:=mrOk;
3927   Changed:=false;
3928   // basic h2pas fixes (unit name, system types, missing IFDEFs)
3929   if not Run(phReplaceUnitFilenameWithUnitName,
3930              TReplaceUnitFilenameWithUnitName,Result) then exit;
3931   if not Run(phRemoveIncludeDirectives,
3932              TRemoveIncludeDirectives,Result) then exit;
3933   if not Run(phRemoveDoubleSemicolons,
3934              TRemoveDoubleSemicolons,Result) then exit;
3935   if not Run(phRemoveSystemTypes,
3936              TRemoveSystemTypes,Result) then exit;
3937   if not Run(phFixH2PasMissingIFDEFsInUnit,
3938              TFixH2PasMissingIFDEFsInUnit,Result) then exit;
3939   // reduce compiler directives so that other tools can work with less double data
3940   if not ReduceCompilerDirectives(Changed,Result) then exit;
3941   // remove h2pas redefinitions to get unambiguous types
3942   if not Run(phRemoveRedefinedPointerTypes,
3943              TRemoveRedefinedPointerTypes,Result) then exit;
3944   if not Run(phRemoveEmptyTypeVarConstSections,
3945              TRemoveEmptyTypeVarConstSections,Result) then exit;
3946   // add / replace implicit types, not converted by h2pas
3947   if not Run(phReplaceImplicitTypes,
3948              TReplaceImplicitTypes,Result) then exit;
3949   if not Run(phFixArrayOfParameterType,
3950              TFixArrayOfParameterType,Result) then exit;
3951   if not Run(phAddMissingPointerTypes,
3952              TAddMissingPointerTypes,Result) then exit;
3953   // remove redefinitions, to get unambiguous types
3954   if not Run(phRemoveRedefinitionsInUnit,
3955              TRemoveRedefinitionsInUnit,Result) then exit;
3956 
3957   // optimization
3958   repeat
3959     Changed:=false;
3960     if not ReduceCompilerDirectives(Changed,Result) then exit;
3961     if not FixAliasDefinitions(Changed,Result) then exit;
3962     if not ConvertSimpleFunctions(Changed,Result) then exit;
3963   until Changed=false;
3964 
3965   // fix forward definitions
3966   if not Run(phFixForwardDefinitions,
3967              TFixForwardDefinitions,Result) then exit;
3968   // add units to uses section
3969   if not AddToUsesSection(Changed,Result) then exit;
3970 end;
3971 
3972 { TRemoveIncludeDirectives }
3973 
TRemoveIncludeDirectives.ClassDescriptionnull3974 class function TRemoveIncludeDirectives.ClassDescription: string;
3975 begin
3976   Result := h2pRemoveAllIncludeDirectives;
3977 end;
3978 
3979 constructor TRemoveIncludeDirectives.Create(TheOwner: TComponent);
3980 begin
3981   inherited Create(TheOwner);
3982   SearchFor:='\{\$(include|i)\b.*\}';
3983   ReplaceWith:='';
3984   Options:=Options+[trtRegExpr];
3985 end;
3986 
3987 { TConvertFunctionTypesToPointers }
3988 
TConvertFunctionTypesToPointers.ClassDescriptionnull3989 class function TConvertFunctionTypesToPointers.ClassDescription: string;
3990 begin
3991   Result := h2pConvertFunctionTypesToPointers;
3992 end;
3993 
Executenull3994 function TConvertFunctionTypesToPointers.Execute(aText: TIDETextConverter
3995   ): TModalResult;
3996 var
3997   Src: String;
3998   SrcLen: Integer;
3999   FuncTypes: TAVLTree; // tree of TImplicitType
4000 
4001   procedure CheckTypeDef(var p: integer);
4002   // Check if it is:  typedef identifier ( funcname ) (
4003   var
4004     StartPos: LongInt;
4005     EndPos: LongInt;
4006     NewType: TImplicitType;
4007   begin
4008     // typedef found
4009     inc(p,length('typedef'));
4010     // skip space
4011     while (p<SrcLen) and IsSpaceChar[Src[p]] do inc(p);
4012     // skip identifier
4013     if not IsIdentStartChar[Src[p]] then exit;
4014     while (p<SrcLen) and IsIdentChar[Src[p]] do inc(p);
4015     // skip space
4016     while (p<SrcLen) and IsSpaceChar[Src[p]] do inc(p);
4017     // skip (
4018     if Src[p]<>'(' then exit;
4019     inc(p);
4020     // skip space
4021     while (p<SrcLen) and IsSpaceChar[Src[p]] do inc(p);
4022     if p>=SrcLen then exit;
typenull4023     // read name of function type
4024     StartPos:=p;
4025     if not IsIdentStartChar[Src[p]] then exit;
4026     while (p<SrcLen) and IsIdentChar[Src[p]] do inc(p);
4027     EndPos:=p;
4028     // skip space
4029     while (p<SrcLen) and IsSpaceChar[Src[p]] do inc(p);
4030     if p>=SrcLen then exit;
4031     // skip )
4032     if Src[p]<>')' then exit;
4033     inc(p);
4034     // skip space
4035     while (p<SrcLen) and IsSpaceChar[Src[p]] do inc(p);
4036     if p>=SrcLen then exit;
4037     // skip (
4038     if Src[p]<>'(' then exit;
typenull4039     // function type found
4040     NewType:=TImplicitType.Create;
4041     NewType.Name:=copy(Src,StartPos,EndPos-StartPos);
4042     writeln('TConvertFunctionTypesToPointers.Execute.CheckType function type found  Name=',NewType.Name);
4043     if FuncTypes=nil then
4044       FuncTypes:=TAVLTree.Create(@CompareImplicitTypeNames);
4045     FuncTypes.Add(NewType);
4046     // add * in front of name
4047     System.Insert('*',Src,StartPos);
4048     SrcLen:=length(Src);
4049   end;
4050 
4051   procedure CheckIdentifier(var p: integer);
4052   var
4053     IdentPos: LongInt;
4054     IdentEnd: LongInt;
4055   begin
4056     IdentPos:=p;
4057     // skip identifier
4058     while (p<=SrcLen) and IsIdentChar[Src[p]] do inc(p);
4059     if FuncTypes.FindKey(@Src[IdentPos],@CompareImplicitTypeStringAndName)=nil
4060     then
4061       exit;
typenull4062     // this identifier is a function type
4063     IdentEnd:=p;
4064     // skip space
4065     while (p<SrcLen) and IsSpaceChar[Src[p]] do inc(p);
4066     if p>=SrcLen then exit;
4067     // remove * behind identifier
4068     if Src[p]<>'*' then exit;
4069     writeln('TConvertFunctionTypesToPointers.Execute.CheckIdentifier removing * behind reference to ',GetIdentifier(@Src[IdentPos]));
4070     System.Delete(Src,IdentEnd,p-IdentEnd+1);
4071     SrcLen:=length(Src);
4072     p:=IdentEnd;
4073   end;
4074 
4075 var
4076   p: Integer;
4077 begin
4078   Result:=mrCancel;
4079   if aText=nil then exit;
4080   FuncTypes:=nil;
4081   try
4082     Src:=aText.Source;
4083     SrcLen:=length(Src);
4084     // Search all  typedef identifier ( funcname ) (
4085     // and insert a * in front of the funcname
4086     p:=1;
4087     while (p<SrcLen) do begin
4088       if (Src[p]='t') and ((p=1) or (not IsIdentChar[Src[p-1]]))
4089       and (CompareIdentifiers('typedef',@Src[p])=0) then begin
4090         CheckTypeDef(p);
4091       end else
4092         inc(p);
4093     end;
4094     if FuncTypes<>nil then begin
4095       // remove the * behind all references
4096       p:=1;
4097       while (p<SrcLen) do begin
4098         if (IsIdentStartChar[Src[p]]) and ((p=1) or (not IsIdentChar[Src[p-1]]))
4099         then begin
4100           CheckIdentifier(p);
4101         end else
4102           inc(p);
4103       end;
4104     end;
4105   finally
4106     if FuncTypes<>nil then begin
4107       FuncTypes.FreeAndClear;
4108       FuncTypes.Free;
4109       aText.Source:=Src;
4110     end;
4111   end;
4112 
4113   Result:=mrOk;
4114 end;
4115 
4116 { TFixForwardDefinitions }
4117 
TFixForwardDefinitions.ClassDescriptionnull4118 class function TFixForwardDefinitions.ClassDescription: string;
4119 begin
4120   Result := h2pFixForwardDefinitionsByReordering;
4121 end;
4122 
Executenull4123 function TFixForwardDefinitions.Execute(aText: TIDETextConverter
4124   ): TModalResult;
4125 begin
4126   Result:=mrCancel;
4127   if (not FilenameIsPascalUnit(aText.Filename)) then begin
4128     DebugLn(['TFixForwardDefinitions.Execute file is not pascal: ',aText.Filename]);
4129     exit(mrOk);// ignore
4130   end;
4131   if not CodeToolBoss.FixForwardDefinitions(TCodeBuffer(aText.CodeBuffer)) then begin
4132     AssignCodeToolBossError;
4133     DebugLn(['TFixForwardDefinitions.Execute failed ',CodeToolBoss.ErrorMessage]);
4134     exit;
4135   end;
4136   Result:=mrOk;
4137 end;
4138 
4139 { TRemoveDoubleSemicolons }
4140 
TRemoveDoubleSemicolons.ClassDescriptionnull4141 class function TRemoveDoubleSemicolons.ClassDescription: string;
4142 begin
4143   Result := h2pRemoveDoubleSemicolons;
4144 end;
4145 
Executenull4146 function TRemoveDoubleSemicolons.Execute(aText: TIDETextConverter
4147   ): TModalResult;
4148 var
4149   Position: Integer;
4150   Source, NewSrc: String;
4151   AtomStart: integer;
4152   LastAtomWasSemicolon: Boolean;
4153   SemicolonPositions: array of integer;
4154   SemicolonCount: Integer;
4155   i: Integer;
4156 begin
4157   Result:=mrCancel;
4158   if aText=nil then exit;
4159   Source:=aText.Source;
4160   //DebugLn(['TRemoveDoubleSemicolons.Execute START ',Source]);
4161 
4162   // find all double semicolons
4163   Position:=1;
4164   LastAtomWasSemicolon:=false;
4165   Setlength(SemicolonPositions,0);
4166   SemicolonCount:=0;
4167   repeat
4168     ReadRawNextPascalAtom(Source,Position,AtomStart,true);
4169     if AtomStart>length(Source) then break;
4170     if Source[AtomStart]=';' then begin
4171       if LastAtomWasSemicolon then begin
4172         if length(SemicolonPositions)<=SemicolonCount then
4173           SetLength(SemicolonPositions,length(SemicolonPositions)*2+2);
4174         SemicolonPositions[SemicolonCount]:=AtomStart;
4175         inc(SemicolonCount);
4176       end;
4177       LastAtomWasSemicolon:=true;
4178     end else begin
4179       LastAtomWasSemicolon:=false;
4180     end;
4181   until false;
4182 
4183   // build new source without semicolons
4184   if SemicolonCount>0 then begin
4185     SetLength(NewSrc,length(Source)-SemicolonCount);
4186     AtomStart:=1;
4187     i:=0;
4188     while i<SemicolonCount do begin
4189       Position:=SemicolonPositions[i];
4190       if Position>AtomStart then
4191         System.Move(Source[AtomStart],NewSrc[AtomStart-i],Position-AtomStart);
4192       AtomStart:=Position+1;
4193       inc(i);
4194     end;
4195     Position:=length(Source)+1;
4196     if Position>AtomStart then
4197       System.Move(Source[AtomStart],NewSrc[AtomStart-i],Position-AtomStart);
4198     aText.Source:=NewSrc;
4199   end;
4200 
4201   // clean up
4202   Setlength(SemicolonPositions,0);
4203   Result:=mrOk;
4204 end;
4205 
4206 { TAddMissingPointerTypes }
4207 
TAddMissingPointerTypes.ClassDescriptionnull4208 class function TAddMissingPointerTypes.ClassDescription: string;
4209 begin
4210   Result := h2pAddMissingPointerTypesLikePPPChar;
4211 end;
4212 
TAddMissingPointerTypes.Executenull4213 function TAddMissingPointerTypes.Execute(aText: TIDETextConverter
4214   ): TModalResult;
4215 { h2pas converts implicit pointer types like 'Identifier ***' to PPPIdentifier,
4216   but it only adds PIdentifier = ^Identifier.
4217   This tool adds the missing
4218     PPIdentifier = ^PIdentifier;
4219     PPPIdentifier = ^PPIdentifier;
4220 }
4221 var
4222   Tool: TCodeTool;
4223   Definitions: TAVLTree;// tree of TCodeTreeNodeExtension
4224   NeededPointerTypes: TAVLTree; // tree of TImplicitType
4225   DefaultTypeSectionPos: integer;
4226 
IdentifierIsDefinednull4227   function IdentifierIsDefined(Identifier: PChar): boolean;
4228   var
4229     i: Integer;
4230   begin
4231     if WordIsKeyWord.DoItCaseInsensitive(Identifier) then exit(true);
4232     if WordIsPredefinedFPCIdentifier.DoItCaseInsensitive(Identifier) then exit(true);
4233     if (Definitions<>nil)
4234     and (Definitions.FindKey(Identifier,@CompareIdentifierWithCodeTreeNodeExt)<>nil)
4235     then exit(true);
4236     for i:=Low(PreDefinedH2PasTypes) to High(PreDefinedH2PasTypes) do begin
4237       if CompareIdentifierPtrs(Identifier,Pointer(PreDefinedH2PasTypes[i]))=0 then
4238         exit(true);
4239       // check for predefined pointer types
4240       if (Identifier^ in ['p','P'])
4241       and (IsIdentChar[Identifier[1]])
4242       and (CompareIdentifierPtrs(@Identifier[1],Pointer(PreDefinedH2PasTypes[i]))=0)
4243       then
4244         exit(true);
4245     end;
4246     //DebugLn(['IdentifierIsDefined not found: ',GetIdentifier(Identifier)]);
4247     Result:=false;
4248   end;
4249 
4250   procedure AddNeededPointerType(Position, Count: integer);
4251   var
4252     Item: TImplicitType;
4253     Identifier: PChar;
4254     AVLNode: TAVLTreeNode;
4255   begin
4256     if NeededPointerTypes=nil then
4257       NeededPointerTypes:=TAVLTree.Create(@CompareImplicitTypeNames);
4258     Identifier:=@Tool.Src[Position+Count];
4259     AVLNode:=NeededPointerTypes.FindKey(Identifier,
4260                                         @CompareImplicitTypeStringAndName);
4261     DebugLn(['AddNeededPointerType Identifier ',GetIdentifier(Identifier),' Position=',Position,' Count=',Count]);
4262     DebugLn(['AddNeededPointerType Position ',copy(Tool.Src,Position,100)]);
4263     if AVLNode<>nil then begin
4264       Item:=TImplicitType(AVLNode.Data);
4265       if Item.MaxPosition<Count then
4266         Item.MaxPosition:=Count;
4267     end else begin
4268       Item:=TImplicitType.Create;
4269       Item.Name:=GetIdentifier(Identifier);
4270       Item.MinPosition:=Position;
4271       Item.MaxPosition:=Count;
4272       NeededPointerTypes.Add(Item);
4273     end;
4274   end;
4275 
4276   procedure CheckIdentifier(Position: integer);
4277   var
4278     Identifier: PChar;
4279     Level: Integer;
4280   begin
4281     Identifier:=@Tool.Src[Position];
4282     Level:=0;
4283     while (Identifier[Level] in ['p','P']) do begin
4284       // this identifier starts with a P, so it can be a pointer type
4285       if IdentifierIsDefined(@Tool.Src[Position+Level]) then break;
4286       inc(Level);
4287     end;
4288     //DebugLn(['CheckIdentifier ',GetIdentifier(Identifier),' Level=',Level]);
4289     if Level=0 then begin
4290       // the identifier is defined
4291       exit;
4292     end;
4293     if (not (Identifier[Level] in ['p','P']))
4294     and (IsIdentChar[Identifier[Level]])
4295     and not (IdentifierIsDefined(@Identifier[Level])) then begin
4296       // the base type is not defined
4297       // => this is not a pointer type
4298       exit;
4299     end;
4300     AddNeededPointerType(Position,Level);
4301   end;
4302 
AddNeededPointerTypesToSourcenull4303   function AddNeededPointerTypesToSource(Item: TImplicitType): boolean;
4304   var
4305     AVLNode: TAVLTreeNode;
4306     NodeExt: TCodeTreeNodeExtension;
4307     Node: TCodeTreeNode;
4308     i: Integer;
4309     NewTxt: String;
4310     InsertPos: LongInt;
4311     Indent: LongInt;
4312     Identifier: String;
4313   begin
4314     Result:=false;
4315 
4316     CodeToolBoss.SourceChangeCache.MainScanner:=Tool.Scanner;
4317 
4318     // find definition
4319     InsertPos:=0;
4320     if (Definitions<>nil) then begin
4321       AVLNode:=Definitions.FindKey(Pointer(Item.Name),
4322                                    @CompareIdentifierWithCodeTreeNodeExt);
4323       if AVLNode<>nil then begin
4324         NodeExt:=TCodeTreeNodeExtension(AVLNode.Data);
4325         Node:=NodeExt.Node;
4326         InsertPos:=Tool.FindLineEndOrCodeAfterPosition(Node.EndPos);
4327         Indent:=GetLineIndent(Tool.Src,Node.StartPos);
4328       end;
4329     end;
4330     if (InsertPos<1) then begin
4331       if DefaultTypeSectionPos<1 then begin
4332         // start a type section at the beginning
4333         Node:=Tool.FindMainUsesNode(false);
4334         if Node<>nil then begin
4335           if Node.NextBrother<>nil then
4336             Node:=Node.NextBrother;
4337         end else begin
4338           Node:=Tool.FindInterfaceNode;
4339           if Node<>nil then begin
4340             if Node.FirstChild<>nil then
4341               Node:=Node.FirstChild;
4342           end;
4343         end;
4344         if Node<>nil then begin
4345           if Node.Desc=ctnUsesSection then begin
4346             // insert behind node
4347             DefaultTypeSectionPos:=
4348                     Tool.FindLineEndOrCodeAfterPosition(Node.EndPos);
4349           end else if Node.Desc=ctnInterface then begin
4350             // insert at end of node
4351             DefaultTypeSectionPos:=Node.EndPos;
4352           end else begin
4353             // insert in front of node
4354             DefaultTypeSectionPos:=
4355                     Tool.FindLineEndOrCodeInFrontOfPosition(Node.StartPos,true);
4356           end;
4357         end else begin
4358           DefaultTypeSectionPos:=1;
4359         end;
4360         DebugLn(['AddNeededPointerTypesToSource start type section']);
4361         if not CodeToolBoss.SourceChangeCache.Replace(gtEmptyLine,gtNewLine,
4362           DefaultTypeSectionPos,DefaultTypeSectionPos,'type') then exit;
4363       end;
4364       InsertPos:=DefaultTypeSectionPos;
4365       Indent:=CodeToolBoss.SourceChangeCache.BeautifyCodeOptions.Indent;
4366     end;
4367 
4368     // add pointer types
4369     Identifier:=Item.Name;
4370     NewTxt:='';
4371     for i:=Item.MaxPosition downto 1 do begin
4372       if NewTxt<>'' then
4373         NewTxt:=NewTxt+CodeToolBoss.SourceChangeCache.BeautifyCodeOptions.LineEnd;
4374       NewTxt:=NewTxt+GetIndentStr(Indent)+'P'+Identifier+'=^'+Identifier+';';
4375       Identifier:='P'+Identifier;
4376     end;
4377     DebugLn(['AddNeededPointerTypesToSource Add pointer types: "',NewTxt,'"']);
4378     Result:=CodeToolBoss.SourceChangeCache.Replace(gtNewLine,gtNewLine,
4379       InsertPos,InsertPos,NewTxt);
4380   end;
4381 
CheckTypesnull4382   function CheckTypes: boolean;
4383   var
4384     Node: TCodeTreeNode;
4385   begin
4386     Node:=Tool.Tree.Root;
4387     while Node<>nil do begin
4388       if (Node.Desc in [ctnIdentifier,ctnOpenArrayType,
4389         ctnRangedArrayType,ctnTypeType,ctnPointerType,ctnConstant])
4390       and (Node.FirstChild=nil)
4391       then begin
4392         Tool.MoveCursorToCleanPos(Node.StartPos);
4393         while Tool.CurPos.StartPos<Node.EndPos do begin
4394           Tool.ReadNextAtom;
4395           if Tool.CurPos.StartPos>=Node.EndPos then break;
4396           if (Tool.CurPos.Flag=cafWord) then
4397             CheckIdentifier(Tool.CurPos.StartPos);
4398         end;
4399         Node:=Node.NextSkipChilds;
4400       end else
4401         Node:=Node.Next;
4402     end;
4403     Result:=true;
4404   end;
4405 
AddNeededPointerTypesToSourcenull4406   function AddNeededPointerTypesToSource: boolean;
4407   var
4408     AVLNode: TAVLTreeNode;
4409     Item: TImplicitType;
4410   begin
4411     Result:=true;
4412     if NeededPointerTypes<>nil then begin
4413       AVLNode:=NeededPointerTypes.FindLowest;
4414       while AVLNode<>nil do begin
4415         Item:=TImplicitType(AVLNode.Data);
4416         if not AddNeededPointerTypesToSource(Item) then exit;
4417         AVLNode:=NeededPointerTypes.FindSuccessor(AVLNode);
4418       end;
4419       Result:=CodeToolBoss.SourceChangeCache.Apply;
4420     end;
4421   end;
4422 
4423 begin
4424   Result:=mrCancel;
4425   if aText=nil then exit;
4426   DebugLn(['TAddMissingPointerTypes.Execute START ',aText.Source]);
4427   if (not FilenameIsPascalUnit(aText.Filename)) then begin
4428     DebugLn(['TAddMissingPointerTypes.Execute file is not pascal: ',aText.Filename]);
4429     exit(mrOk);// ignore
4430   end;
4431   if not CodeToolBoss.Explore(TCodeBuffer(aText.CodeBuffer),Tool,true,false)
4432   then begin
4433     AssignCodeToolBossError;
4434     DebugLn(['TAddMissingPointerTypes.Execute Explore failed ',CodeToolBoss.ErrorMessage]);
4435     exit;
4436   end;
4437   DebugLn(['TAddMissingPointerTypes.Execute ']);
4438   Definitions:=nil;
4439   NeededPointerTypes:=nil;
4440   DefaultTypeSectionPos:=0;
4441   try
4442     // collect definitions
4443     if not Tool.GatherUnitDefinitions(Definitions,true,false) then begin
4444       AssignCodeToolBossError;
4445       DebugLn(['TAddMissingPointerTypes.Execute GatherUnitDefinitions failed ',CodeToolBoss.ErrorMessage]);
4446       exit;
4447     end;
4448     // check all used identifiers
4449     if not CheckTypes then exit;
4450     // add all needed pointer types
4451     if not AddNeededPointerTypesToSource then exit;
4452   finally
4453     if Definitions<>nil then begin
4454       DisposeAVLTree(Definitions);
4455       Definitions:=nil;
4456     end;
4457     if NeededPointerTypes<>nil then begin
4458       NeededPointerTypes.FreeAndClear;
4459       NeededPointerTypes.Free;
4460     end;
4461   end;
4462   DebugLn(['TAddMissingPointerTypes.Execute END ',aText.Source]);
4463   Result:=mrOk;
4464 end;
4465 
4466 { TConvertEnumsToTypeDef }
4467 
TConvertEnumsToTypeDef.ClassDescriptionnull4468 class function TConvertEnumsToTypeDef.ClassDescription: string;
4469 begin
4470   Result := h2pGiveAnonymousCEnumsATypedefName;
4471 end;
4472 
Executenull4473 function TConvertEnumsToTypeDef.Execute(aText: TIDETextConverter
4474   ): TModalResult;
4475 var
4476   Src: String;
4477   SrcLen: Integer;
4478 
CreateEnumNamenull4479   function CreateEnumName(StartPos, EndPos: integer): string;
4480   var
4481     AtomStart: LongInt;
4482   begin
4483     Result:='';
4484     AtomStart:=StartPos;
4485     while StartPos<=EndPos do begin
4486       ReadNextCAtom(Src,StartPos,AtomStart);
4487       if AtomStart>SrcLen then exit;
4488       if IsIdentStartChar[Src[AtomStart]] then begin
4489         Result:=Result+copy(Src,AtomStart,StartPos-AtomStart);
4490         if length(Result)>60 then exit;
4491       end;
4492     end;
4493   end;
4494 
4495 var
4496   p: Integer;
4497   AtomStart: Integer;
4498   LastAtomStart: LongInt;
4499   Changed: Boolean;
4500 
4501   procedure AdjustAfterReplace(var APosition: integer;
4502     FromPos, ToPos, NewLength: integer);
4503   begin
4504     if APosition<FromPos then
4505       exit
4506     else if APosition<ToPos then
4507       APosition:=FromPos
4508     else
4509       inc(APosition,NewLength-(FromPos-ToPos));
4510   end;
4511 
4512   procedure Replace(FromPos, ToPos: integer; const NewSrc: string);
4513   begin
4514     DebugLn(['TConvertEnumsToTypeDef.Execute.Replace ',FromPos,'-',ToPos,' NewSrc="',NewSrc,'"']);
4515     Src:=copy(Src,1,FromPos-1)+NewSrc+copy(Src,ToPos,length(Src));
4516     AdjustAfterReplace(p,FromPos,ToPos,length(NewSrc));
4517     AdjustAfterReplace(AtomStart,FromPos,ToPos,length(NewSrc));
4518     AdjustAfterReplace(LastAtomStart,FromPos,ToPos,length(NewSrc));
4519     Changed:=true;
4520   end;
4521 
4522 var
4523   EnumStart: LongInt;
4524   EnumEnd: LongInt;
4525   EnumName: String;
4526   BracketStart: LongInt;
4527 begin
4528   Result:=mrCancel;
4529   if aText=nil then exit;
4530   Changed:=false;
4531   Src:=aText.Source;
4532   SrcLen:=length(Src);
4533   p:=1;
4534   AtomStart:=1;
4535   LastAtomStart:=-1;
4536   repeat
4537     ReadNextCAtom(Src,p,AtomStart);
4538     if p>SrcLen then break;
4539     //DebugLn(['TConvertEnumsToTypeDef.Execute ',AtomStart,' "',dbgstr(copy(Src,AtomStart,p-AtomStart)),'"']);
4540     case Src[AtomStart] of
4541     'a'..'z','A'..'Z','_':
4542       begin
4543         // identifier
4544         if (CompareCIdentifiers(@Src[AtomStart],'enum')=0)
4545         and ((LastAtomStart<1)
4546              or (CompareCIdentifiers(@Src[AtomStart],'typedef')<>0)) then
4547         begin
4548           // enum without typedef
4549           DebugLn(['TConvertEnumsToTypeDef.Execute enum without typedef found']);
4550           EnumStart:=AtomStart;
4551           // read curly bracket open
4552           ReadNextCAtom(Src,p,AtomStart);
4553           if (AtomStart>SrcLen) or (Src[AtomStart]<>'{') then break;
4554           BracketStart:=AtomStart;
4555           // read til curly bracket close
4556           if not ReadTilCBracketClose(Src,AtomStart) then break;
4557           p:=AtomStart;
4558           // read semicolon
4559           ReadNextCAtom(Src,p,AtomStart);
4560           if (AtomStart>SrcLen) or (Src[AtomStart]<>';') then break;
4561           EnumEnd:=AtomStart;
4562           DebugLn(['TConvertEnumsToTypeDef.Execute Enum block: ',copy(Src,EnumStart,EnumEnd-EnumStart)]);
4563           // read enums to create a unique name
4564           EnumName:=CreateEnumName(BracketStart,EnumEnd);
4565           if EnumName='' then begin
4566             // empty enum => remove
4567             Replace(EnumStart,EnumEnd,'');
4568           end else begin
4569             // insert 'typedef' and name
4570             // IMPORTANT: insert in reverse order
4571             Replace(EnumEnd,EnumEnd,EnumName);
4572             Replace(EnumStart,EnumStart,'typedef ');
4573           end;
4574         end;
4575       end;
4576     end;
4577     LastAtomStart:=AtomStart;
4578   until false;
4579 
4580   if Changed then
4581     aText.Source:=Src;
4582   Result:=mrOk;
4583 end;
4584 
4585 { TCommentComplexCMacros }
4586 
TCommentComplexCMacros.ClassDescriptionnull4587 class function TCommentComplexCMacros.ClassDescription: string;
4588 begin
4589   Result := h2pCommentMacrosThatAreTooComplexForH2pas;
4590 end;
4591 
Executenull4592 function TCommentComplexCMacros.Execute(aText: TIDETextConverter
4593   ): TModalResult;
4594 var
4595   Src: String;
4596   SrcLen: Integer;
4597 
DefineIsTooComplexnull4598   function DefineIsTooComplex(StartPos, EndPos: integer): boolean;
4599   // h2pas has problems with
4600   // - backslash + newline
4601   // - whole functions { }
4602   var
4603     p: LongInt;
4604     AtomStart: integer;
4605   begin
4606     p:=StartPos;
4607     repeat
4608       ReadRawNextCAtom(Src,p,AtomStart);
4609       if (AtomStart>=EndPos) or (AtomStart>length(Src)) then break;
4610       if Src[AtomStart]='{' then begin
4611         // this macro is a whole function => too complex
4612         exit(true);
4613       end;
4614       if (Src[AtomStart] in [#10,#13]) then begin
4615         // this macro uses multiple lines => too complex
4616         exit(true);
4617       end;
4618     until false;
4619     Result:=false;
4620   end;
4621 
4622 var
4623   Changed: Boolean;
4624   p: Integer;
4625   AtomStart: Integer;
4626 
4627   procedure AdjustAfterReplace(var APosition: integer;
4628     FromPos, ToPos, NewLength: integer);
4629   begin
4630     if APosition<FromPos then
4631       exit
4632     else if APosition<ToPos then
4633       APosition:=FromPos
4634     else
4635       inc(APosition,NewLength-(FromPos-ToPos));
4636   end;
4637 
4638   procedure Replace(FromPos, ToPos: integer; const NewSrc: string);
4639   begin
4640     //DebugLn(['TCommentComplexCMacros.Execute.Replace ',FromPos,'-',ToPos,' NewSrc="',NewSrc,'"']);
4641     Src:=copy(Src,1,FromPos-1)+NewSrc+copy(Src,ToPos,length(Src));
4642     AdjustAfterReplace(p,FromPos,ToPos,length(NewSrc));
4643     AdjustAfterReplace(AtomStart,FromPos,ToPos,length(NewSrc));
4644     Changed:=true;
4645   end;
4646 
4647   procedure Comment(StartPos, EndPos: integer);
4648   begin
4649     // replace sub comments
4650     while (StartPos<EndPos-1) do begin
4651       if (Src[StartPos]='/') and (Src[StartPos+1]='*') then begin
4652         // sub comment found -> disable
4653         // IMPORTANT: replacement must be the same size to keep the positions
4654         Replace(StartPos,StartPos+1,'(');
4655       end;
4656       if (Src[StartPos]='*') and (Src[StartPos+1]='/') then begin
4657         // sub comment found -> disable
4658         // IMPORTANT: replacement must be the same size to keep the positions
4659         Replace(StartPos+1,StartPos+2,')');
4660       end;
4661       inc(StartPos);
4662     end;
4663 
4664     // IMPORTANT: insert in reverse order
4665     Replace(EndPos,EndPos,'*/');
4666     Replace(StartPos,StartPos,'/*');
4667   end;
4668 
4669 var
4670   DefineStart: LongInt;
4671   DefineEnd: LongInt;
4672   ValueStart: LongInt;
4673 begin
4674   Result:=mrCancel;
4675   if aText=nil then exit;
4676   Changed:=false;
4677   Src:=aText.Source;
4678   SrcLen:=length(Src);
4679   p:=1;
4680   AtomStart:=1;
4681   repeat
4682     ReadRawNextCAtom(Src,p,AtomStart);
4683     if p>SrcLen then break;
4684     if (Src[AtomStart]='#') and (AtomStart<SrcLen) then begin
4685       // pragma found
4686       if CompareCIdentifiers(@Src[AtomStart+1],'define')=0 then begin
4687         // #define found
4688         DefineStart:=AtomStart;
4689         inc(p,length('define'));
4690         ValueStart:=p;
4691         ReadTilCLineEnd(Src,p);
4692         DefineEnd:=p;
4693         if DefineIsTooComplex(ValueStart,DefineEnd) then begin
4694           DebugLn(['TCommentComplexCMacros.Execute commenting macro "',dbgstr(copy(Src,DefineStart,DefineEnd-DefineStart)),'"']);
4695           Comment(DefineStart,DefineEnd);
4696         end;
4697       end;
4698     end;
4699   until false;
4700 
4701   if Changed then
4702     aText.Source:=Src;
4703   Result:=mrOk;
4704 end;
4705 
4706 { TCommentComplexCFunctions }
4707 
TCommentComplexCFunctions.ClassDescriptionnull4708 class function TCommentComplexCFunctions.ClassDescription: string;
4709 begin
4710   Result := h2pCommentFunctionsThatAreTooComplexForH2pas;
4711 end;
4712 
Executenull4713 function TCommentComplexCFunctions.Execute(aText: TIDETextConverter
4714   ): TModalResult;
4715 var
4716   Src: String;
4717   SrcLen: Integer;
4718 
DefineIsTooComplexnull4719   function DefineIsTooComplex(StartPos, EndPos: integer): boolean;
4720   // h2pas has problems with
4721   // - backslash + newline
4722   // - whole functions { }
4723   begin
4724     while (StartPos<EndPos) do begin
4725       if Src[StartPos]='{' then begin
4726         // this macro is a whole function => too complex
4727         exit(true);
4728       end;
4729       if (Src[StartPos] in [#10,#13]) then begin
4730         // this macro uses multiple lines => too complex
4731         exit(true);
4732       end;
4733       inc(StartPos);
4734     end;
4735     Result:=false;
4736   end;
4737 
4738 var
4739   Changed: Boolean;
4740   p: Integer;
4741   AtomStart: Integer;
4742   DefinitionStart: Integer;
4743 
4744   procedure AdjustAfterReplace(var APosition: integer;
4745     FromPos, ToPos, NewLength: integer);
4746   begin
4747     if APosition<FromPos then
4748       exit
4749     else if APosition<ToPos then
4750       APosition:=FromPos
4751     else
4752       inc(APosition,NewLength-(FromPos-ToPos));
4753   end;
4754 
4755   procedure Replace(FromPos, ToPos: integer; const NewSrc: string);
4756   begin
4757     Src:=copy(Src,1,FromPos-1)+NewSrc+copy(Src,ToPos,length(Src));
4758     AdjustAfterReplace(p,FromPos,ToPos,length(NewSrc));
4759     AdjustAfterReplace(AtomStart,FromPos,ToPos,length(NewSrc));
4760     AdjustAfterReplace(DefinitionStart,FromPos,ToPos,length(NewSrc));
4761     Changed:=true;
4762   end;
4763 
4764   procedure Comment(StartPos, EndPos: integer);
4765   begin
4766     // replace sub comments
4767     while (StartPos<EndPos-1) do begin
4768       if (Src[StartPos]='/') and (Src[StartPos+1]='*') then begin
4769         // sub comment found -> disable
4770         // IMPORTANT: replacement must be the same size to keep the positions
4771         Replace(StartPos,StartPos+1,'(');
4772       end;
4773       if (Src[StartPos]='*') and (Src[StartPos+1]='/') then begin
4774         // sub comment found -> disable
4775         // IMPORTANT: replacement must be the same size to keep the positions
4776         Replace(StartPos+1,StartPos+2,')');
4777       end;
4778       inc(StartPos);
4779     end;
4780 
4781     // IMPORTANT: insert in reverse order
4782     Replace(EndPos,EndPos,'*/');
4783     Replace(StartPos,StartPos,'/*');
4784   end;
4785 
ReadFunctionnull4786   function ReadFunction: boolean;
4787   var
4788     FuncEnd: LongInt;
4789   begin
4790     Result:=false;
4791     //DebugLn(['ReadFunction START "',copy(Src,AtomStart,p-AtomStart),'"']);
worksnull4792     // a C function works like this:
4793     // [modifiers, macros] type name(param list){ statements }
4794     // 'type' can be an identifier or identifier* or something with brackets
4795 
4796     // read name
4797     if not IsIdentStartChar[Src[AtomStart]] then exit;
4798     ReadNextCAtom(Src,p,AtomStart);
4799     if p>SrcLen then exit;
4800     // read round bracket open
4801     if Src[AtomStart]<>'(' then exit;
4802     p:=AtomStart;
4803     if not ReadTilCBracketClose(Src,p) then exit;
4804     // read curly bracket open
4805     ReadNextCAtom(Src,p,AtomStart);
4806     if p>SrcLen then exit;
4807     if Src[AtomStart]<>'{' then exit;
4808     p:=AtomStart;
4809     if not ReadTilCBracketClose(Src,p) then exit;
foundnull4810     // function found
4811     FuncEnd:=p;
4812     Result:=true;
4813     DebugLn(['TCommentComplexCFunctions.Execute.ReadFunction Function="',copy(Src,DefinitionStart,FuncEnd-DefinitionStart),'"']);
4814     Comment(DefinitionStart,FuncEnd);
4815   end;
4816 
4817 var
4818   OldP: LongInt;
4819 begin
4820   Result:=mrCancel;
4821   if aText=nil then exit;
4822   Changed:=false;
4823   Src:=aText.Source;
4824   SrcLen:=length(Src);
4825   p:=1;
4826   AtomStart:=1;
4827   DefinitionStart:=0;
4828   repeat
4829     // read next definition
4830     ReadNextCAtom(Src,p,AtomStart);
4831     if p>SrcLen then break;
4832     if Src[AtomStart]=';' then begin
4833       // definition end found
4834       DefinitionStart:=0;
4835       continue;
4836     end else if Src[AtomStart]='{' then begin
4837       // block found = definition end found
4838       DefinitionStart:=0;
4839       p:=AtomStart;
4840       if not ReadTilCBracketClose(Src,p) then break;
4841       continue;
4842     end else begin
4843       // in definition
4844       if DefinitionStart<1 then
4845         DefinitionStart:=AtomStart;
4846       if Src[AtomStart] in ['(','['] then begin
4847         // skip bracket
4848         p:=AtomStart;
4849         if not ReadTilCBracketClose(Src,p) then break;
4850       end else if IsIdentStartChar[Src[AtomStart]] then begin
4851         // identifier found => check if function
OldPnull4852         OldP:=p;
thennull4853         if ReadFunction then begin
4854           DefinitionStart:=0;
4855         end else begin
4856           p:=OldP;
4857         end;
4858       end;
4859     end;
4860   until false;
4861 
4862   if Changed then
4863     aText.Source:=Src;
4864   Result:=mrOk;
4865 end;
4866 
4867 { TAddToUsesSection }
4868 
4869 procedure TAddToUsesSection.SetUseUnits(const AValue: TStrings);
4870 begin
4871   if FUseUnits=AValue then exit;
4872   FUseUnits.Assign(AValue);
4873 end;
4874 
4875 constructor TAddToUsesSection.Create(TheOwner: TComponent);
4876 begin
4877   inherited Create(TheOwner);
4878   FUseUnits:=TStringList.Create;
4879 end;
4880 
4881 destructor TAddToUsesSection.Destroy;
4882 begin
4883   FreeAndNil(FUseUnits);
4884   inherited Destroy;
4885 end;
4886 
TAddToUsesSection.ClassDescriptionnull4887 class function TAddToUsesSection.ClassDescription: string;
4888 begin
4889   Result := h2pAddUnitsToUsesSection;
4890 end;
4891 
Executenull4892 function TAddToUsesSection.Execute(aText: TIDETextConverter): TModalResult;
4893 var
4894   AUnitName: string;
4895   i: Integer;
4896 begin
4897   Result:=mrCancel;
4898   if (not FilenameIsPascalUnit(aText.Filename)) then begin
4899     DebugLn(['TAddToUsesSection.Execute file is not pascal: ',aText.Filename]);
4900     exit(mrOk);// ignore
4901   end;
4902   for i:=0 to FUseUnits.Count-1 do begin
4903     AUnitName:=FUseUnits[i];
4904     if (AUnitName='') then continue;
4905     if not IsValidIdent(AUnitName) then
4906       raise Exception.Create(Format(h2pTAddToUsesSectionExecuteInvalidUnitname, [AUnitName]));
4907     if not CodeToolBoss.AddUnitToMainUsesSection(TCodeBuffer(aText.CodeBuffer),AUnitName,'')
4908     then begin
4909       AssignCodeToolBossError;
4910       DebugLn(['TAddToUsesSection.Execute failed ',CodeToolBoss.ErrorMessage]);
4911       exit;
4912     end;
4913   end;
4914   Result:=mrOk;
4915 end;
4916 
4917 { TAddMissingMacroBrackets }
4918 
TAddMissingMacroBrackets.ClassDescriptionnull4919 class function TAddMissingMacroBrackets.ClassDescription: string;
4920 begin
4921   Result := h2pAddMissingBracketsAroundMacroValues;
4922 end;
4923 
Executenull4924 function TAddMissingMacroBrackets.Execute(aText: TIDETextConverter
4925   ): TModalResult;
4926 var
4927   Macro: String;
4928   Lines: TStrings;
4929   i: Integer;
4930   Line: string;
4931   Value: String;
4932 begin
4933   Result:=mrCancel;
4934   if aText=nil then exit;
4935   Lines:=aText.Strings;
4936   i:=0;
4937   while i<=Lines.Count-1 do begin
4938     Line:=Lines[i];
4939     // example: #define READ_CURRENT_IAC_LAP_RP_SIZE 2+3*MAX_IAC_LAP
4940     if REMatches(Line,'^(#define\s+[a-zA-Z0-9_]+\s+)(.+)')
4941     then begin
4942       Macro:=REVar(1);
4943       Value:=REVar(2);
4944       if (Value<>'') and (Value[1]<>'(')
4945       and (REMatches(Value,'[^a-zA-Z0-9_()]')) then begin
4946         // macro needs values
4947         Line:=Macro+'('+Value+')';
4948         Lines[i]:=Line;
4949       end;
4950     end;
4951     inc(i);
4952   end;
4953   Result:=mrOk;
4954 end;
4955 
4956 end.
4957