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