1 { $Id$ }
2 {
3 /***************************************************************************
4 MissingPropertiesDlg.pas
5 ------------------------
6
7 ***************************************************************************/
8
9 ***************************************************************************
10 * *
11 * This source is free software; you can redistribute it and/or modify *
12 * it under the terms of the GNU General Public License as published by *
13 * the Free Software Foundation; either version 2 of the License, or *
14 * (at your option) any later version. *
15 * *
16 * This code is distributed in the hope that it will be useful, but *
17 * WITHOUT ANY WARRANTY; without even the implied warranty of *
18 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *
19 * General Public License for more details. *
20 * *
21 * A copy of the GNU General Public License is available on the World *
22 * Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also *
23 * obtain it by writing to the Free Software Foundation, *
24 * Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA. *
25 * *
26 ***************************************************************************
27 }
28 unit MissingPropertiesDlg;
29
30 {$mode objfpc}{$H+}
31
32 interface
33
34 uses
35 // FCL+LCL
36 Classes, SysUtils, contnrs,
37 LCLProc, Forms, Controls, Grids, LResources, Dialogs, Buttons, StdCtrls, ExtCtrls,
38 // LazUtils
39 LazFileUtils, LazUTF8Classes, LazUTF8, AvgLvlTree,
40 // components
41 SynHighlighterLFM, SynEdit, SynEditMiscClasses,
42 // codetools
43 CodeCache, CodeToolManager, CodeCompletionTool, LFMTrees,
44 // IdeIntf
45 IDEExternToolIntf, ComponentReg, IDEImagesIntf,
46 // IDE
47 LazarusIDEStrConsts, EditorOptions, CheckLFMDlg, Project, SourceMarks,
48 // Converter
49 ConverterTypes, ConvertSettings, ReplaceNamesUnit,
50 ConvCodeTool, FormFileConv, UsedUnits;
51
52 type
53
54 { TDFMConverter }
55
56 // Encapsulates some basic form file conversions.
57 TDFMConverter = class
58 private
59 fSettings: TConvertSettings;
60 fOrigFormat: TLRSStreamOriginalFormat;
FixWideStringnull61 function FixWideString(aInStream, aOutStream: TMemoryStream): TModalResult;
GetLFMFilenamenull62 function GetLFMFilename(const DfmFilename: string; KeepCase: boolean): string;
63 public
64 constructor Create;
65 destructor Destroy; override;
ConvertDfmToLfmnull66 function ConvertDfmToLfm(const aFilename: string): TModalResult;
Convertnull67 function Convert(const DfmFilename: string): TModalResult;
68 public
69 property Settings: TConvertSettings read fSettings write fSettings;
70 end;
71
72 { TLfmFixer }
73
74 TLFMFixer = class(TLFMChecker)
75 private
76 fCTLink: TCodeToolLink;
77 fSettings: TConvertSettings;
78 fUsedUnitsTool: TUsedUnitsTool;
79 // List of property values which need to be adjusted.
80 fHasMissingProperties: Boolean; // LFM file has unknown properties.
81 fHasMissingObjectTypes: Boolean; // LFM file has unknown object types.
82 // References to controls in UI:
83 fPropReplaceGrid: TStringGrid;
84 fTypeReplaceGrid: TStringGrid;
ReplaceAndRemoveAllnull85 function ReplaceAndRemoveAll: TModalResult;
ReplaceTopOffsetsnull86 function ReplaceTopOffsets(aSrcOffsets: TList): TModalResult;
AddNewPropsnull87 function AddNewProps(aNewProps: TList): TModalResult;
88 // Fill StringGrids with missing properties and types from fLFMTree.
89 procedure FillReplaceGrids;
ShowConvertLFMWizardnull90 function ShowConvertLFMWizard: TModalResult;
91 protected
FixMissingComponentClassesnull92 function FixMissingComponentClasses(aMissingTypes: TStringList): TModalResult; override;
93 procedure LoadLFM;
94 public
95 constructor Create(ACTLink: TCodeToolLink; ALFMBuffer: TCodeBuffer);
96 destructor Destroy; override;
ConvertAndRepairnull97 function ConvertAndRepair: TModalResult;
98 public
99 property Settings: TConvertSettings read fSettings write fSettings;
100 property UsedUnitsTool: TUsedUnitsTool read fUsedUnitsTool write fUsedUnitsTool;
101 end;
102
103
104 { TFixLFMDialog }
105
106 TFixLFMDialog = class(TForm)
107 CancelButton: TBitBtn;
108 ErrorsGroupBox: TGroupBox;
109 ErrorsListBox: TListBox;
110 TypeReplaceGrid: TStringGrid;
111 PropertyReplaceGroupBox: TGroupBox;
112 NoteLabel: TLabel;
113 LFMGroupBox: TGroupBox;
114 LFMSynEdit: TSynEdit;
115 BtnPanel: TPanel;
116 ReplaceAllButton: TBitBtn;
117 Splitter1: TSplitter;
118 PropReplaceGrid: TStringGrid;
119 Splitter2: TSplitter;
120 Splitter3: TSplitter;
121 PropertiesText: TStaticText;
122 TypesText: TStaticText;
123 SynLFMSyn1: TSynLFMSyn;
124 procedure ErrorsListBoxClick(Sender: TObject);
125 procedure ReplaceAllButtonClick(Sender: TObject);
126 procedure LFMSynEditSpecialLineMarkup(Sender: TObject;
127 Line: integer; var Special: boolean; AMarkup: TSynSelectedColor);
128 procedure CheckLFMDialogCREATE(Sender: TObject);
129 private
130 fLfmFixer: TLFMFixer;
131 public
132 constructor Create(AOwner: TComponent; ALfmFixer: TLFMFixer); reintroduce;
133 destructor Destroy; override;
134 end;
135
136
137 implementation
138
139
140 {$R *.lfm}
141
IsMissingTypenull142 function IsMissingType(LFMError: TLFMError): boolean;
143 begin
144 with LFMError do
145 Result:=(ErrorType in [lfmeIdentifierNotFound,lfmeMissingRoot])
146 and (Node is TLFMObjectNode)
147 and (TLFMObjectNode(Node).TypeName<>'');
148 end;
149
150 { TDFMConverter }
151
152 constructor TDFMConverter.Create;
153 begin
154 inherited Create;
155 end;
156
157 destructor TDFMConverter.Destroy;
158 begin
159 inherited Destroy;
160 end;
161
Convertnull162 function TDFMConverter.Convert(const DfmFilename: string): TModalResult;
163 var
164 s: String;
165 Urgency: TMessageLineUrgency;
166 begin
167 Result:=ConvertDfmToLfm(DfmFilename);
168 if Result=mrOK then begin
169 if fOrigFormat=sofBinary then begin
170 s:=Format(lisFileSIsConvertedToTextFormat, [DfmFilename]);
171 Urgency:=mluHint;
172 end
173 else begin
174 s:=Format(lisFileSHasIncorrectSyntax, [DfmFilename]);
175 Urgency:=mluError;
176 end;
177 if Assigned(fSettings) then
178 fSettings.AddLogLine(Urgency, s, DfmFilename)
179 else
180 ShowMessage(s);
181 end;
182 end;
183
GetLFMFilenamenull184 function TDFMConverter.GetLFMFilename(const DfmFilename: string;
185 KeepCase: boolean): string;
186 begin
187 if DfmFilename<>'' then begin
188 // platform and fpc independent unitnames are lowercase, so are the lfm files
189 Result:=lowercase(ExtractFilenameOnly(DfmFilename));
190 if KeepCase then
191 Result:=ExtractFilenameOnly(DfmFilename);
192 Result:=ExtractFilePath(DfmFilename)+Result+'.lfm';
193 end else
194 Result:='';
195 end;
196
FixWideStringnull197 function TDFMConverter.FixWideString(aInStream, aOutStream: TMemoryStream): TModalResult;
198 // Convert Windows WideString syntax (#xxx) to UTF8
199
UnicodeNumbernull200 function UnicodeNumber(const InS: string; var Ind: integer): string;
201 // Convert the number to UTF8
202 var
203 Start, c: Integer;
204 begin
205 Inc(Ind); // Skip '#'
206 Start:=Ind;
207 while InS[Ind] in ['0'..'9'] do
208 Inc(Ind); // Collect numbers
209 c:=StrToInt(Copy(InS, Start, Ind-Start));
210 if c>255 then
211 Result:=UnicodeToUTF8(c)
212 else
213 Result:=SysToUTF8(chr(c));
214 end;
215
FixControlCharsnull216 function FixControlChars(const s:string): string;
217 var
218 i: Integer;
219 InControl: boolean;
220 begin
221 Result := '';
222 InControl := false;
223 for i:=1 to Length(s) do begin
224 if s[i] < #32 then begin
225 if not InControl then
226 result := result + '''';
227 result := result + '#' + IntToStr(ord(s[i]));
228 InControl := true;
229 end else begin
230 if InControl then begin
231 result := result + '''';
232 InControl := false;
233 end;
234 Result := Result + s[i];
235 end;
236 end;
237 end;
238
CollectStringnull239 function CollectString(const InS: string; var Ind: integer): string;
240 // Collect a string composed of quoted strings and unicode numbers like #xxx
241 var
242 InQuote: Boolean;
243 ch: Char;
244 begin
245 Result:='';
246 InQuote:=False;
247 repeat
248 ch:=InS[Ind];
249 if ch in [#13,#10] then Break;
250 if ch = '''' then begin
251 InQuote:=not InQuote; // Toggle quote
252 Inc(Ind);
253 end
254 else if InQuote then begin
255 Result:=Result+ch; // Inside quotes copy characters as is.
256 Inc(Ind);
257 end
258 else if ch = '#' then
259 Result:=Result+UnicodeNumber(InS, Ind)
260 else
261 Break;
262 until False;
263 Result:=FixControlChars(QuotedStr(Result));
264 end;
265
266 var
267 InS, OutS: string;
268 i: Integer;
269 begin
270 Result:=mrOk;
271 OutS:='';
272 aInStream.Position:=0;
273 SetLength(InS, aInStream.Size);
274 aInStream.Read(InS[1],length(InS));
275 i := 1;
276 while i <= Length(InS) do begin
277 if InS[i] in ['''', '#'] then
278 OutS:=OutS+CollectString(InS, i)
279 else begin
280 OutS:=OutS+InS[i];
281 Inc(i);
282 end;
283 end;
284 // Write data to a new stream.
285 aOutStream.Write(OutS[1], Length(OutS));
286 end;
287
TDFMConverter.ConvertDfmToLfmnull288 function TDFMConverter.ConvertDfmToLfm(const aFilename: string): TModalResult;
289 var
290 DFMStream, LFMStream, Utf8LFMStream: TMemoryStreamUTF8;
291 begin
292 Result:=mrOk;
293 DFMStream:=TMemoryStreamUTF8.Create;
294 LFMStream:=TMemoryStreamUTF8.Create;
295 Utf8LFMStream:=TMemoryStreamUTF8.Create;
296 try
297 // Note: The file is copied from DFM file earlier. Load it.
298 try
299 DFMStream.LoadFromFile(aFilename);
300 except
301 on E: Exception do begin
302 Result:=QuestionDlg(lisCodeToolsDefsReadError, Format(
303 lisUnableToReadFileError, [aFilename, LineEnding, E.Message]),
304 mtError,[mrIgnore,mrAbort],0);
305 if Result=mrIgnore then // The caller will continue like nothing happened.
306 Result:=mrOk;
307 exit;
308 end;
309 end;
310 fOrigFormat:=TestFormStreamFormat(DFMStream);
311 // converting dfm file, without renaming unit -> keep case...
312 try
313 FormDataToText(DFMStream, LFMStream, fOrigFormat);
314 except
315 on E: Exception do begin
316 Result:=QuestionDlg(lisFormatError,
317 Format(lisUnableToConvertFileError, [aFilename, LineEnding, E.Message]),
318 mtError,[mrIgnore,mrAbort],0);
319 if Result=mrIgnore then
320 Result:=mrOk;
321 exit;
322 end;
323 end;
324 // Convert Windows WideString syntax (#xxx) to UTF8
325 FixWideString(LFMStream, Utf8LFMStream);
326 // Save the converted file.
327 try
328 Utf8LFMStream.SaveToFile(ChangeFileExt(aFilename, '.lfm'));
329 except
330 on E: Exception do begin
331 Result:=MessageDlg(lisCodeToolsDefsWriteError,
332 Format(lisUnableToWriteFileError, [aFilename, LineEnding, E.Message]),
333 mtError,[mbIgnore,mbAbort],0);
334 if Result=mrIgnore then
335 Result:=mrOk;
336 exit;
337 end;
338 end;
339 finally
340 Utf8LFMStream.Free;
341 LFMSTream.Free;
342 DFMStream.Free;
343 end;
344 end;
345
346
347 { TLFMFixer }
348
349 constructor TLFMFixer.Create(ACTLink: TCodeToolLink; ALFMBuffer: TCodeBuffer);
350 begin
351 inherited Create(ACTLink.Code, ALFMBuffer);
352 fCTLink:=ACTLink;
353 fHasMissingProperties:=false;
354 fHasMissingObjectTypes:=false;
355 end;
356
357 destructor TLFMFixer.Destroy;
358 begin
359 inherited Destroy;
360 end;
361
ReplaceAndRemoveAllnull362 function TLFMFixer.ReplaceAndRemoveAll: TModalResult;
363 // Replace or remove properties and types based on values in grid.
364 // Returns mrRetry if some types were changed and a new scan is needed,
365 // mrOK if no types were changed, and mrCancel if there was an error.
366 var
367 AutoInc: integer;
368
SolveAutoIncnull369 function SolveAutoInc(AIdent: string): string;
370 begin
371 if Pos('$autoinc', AIdent)>0 then begin
372 Inc(AutoInc);
373 Result:=StringReplace(AIdent, '$autoinc', IntToStr(AutoInc), [rfReplaceAll]);
374 end
375 else
376 Result:=AIdent;
377 end;
378
379 procedure InitClassCompletion;
380 begin
381 with fCTLink.CodeTool do
382 if not Assigned(CodeCompleteClassNode) then begin // Do only at first time.
383 CodeCompleteClassNode:=FindClassNodeInInterface(
384 TLFMObjectNode(fLFMTree.Root).TypeName,true,false,true);
385 CodeCompleteSrcChgCache:=fCTLink.SrcCache;
386 end;
387 end;
388
389 var
390 CurError: TLFMError;
391 TheNode: TLFMTreeNode;
392 ObjNode: TLFMObjectNode;
393 // Property / Type name --> replacement name.
394 PropReplacements: TStringToStringTree;
395 TypeReplacements: TStringToStringTree;
396 // List of TLFMChangeEntry objects.
397 ChgEntryRepl: TObjectList;
398 OldIdent, NewIdent: string;
399 StartPos, EndPos: integer;
400 begin
401 Result:=mrOK;
402 AutoInc:=0;
403 fCTLink.CodeTool.CodeCompleteClassNode:=Nil;
404 ChgEntryRepl:=TObjectList.Create;
405 PropReplacements:=TStringToStringTree.Create(false);
406 TypeReplacements:=TStringToStringTree.Create(false);
407 try
408 // Collect (maybe edited) properties from StringGrid to map.
409 FromGridToMap(PropReplacements, fPropReplaceGrid);
410 FromGridToMap(TypeReplacements, fTypeReplaceGrid, false);
411 // Replace each missing property / type or delete it if no replacement.
412 CurError:=fLFMTree.LastError;
413 while CurError<>nil do begin
414 TheNode:=CurError.FindContextNode;
415 if (TheNode<>nil) and (TheNode.Parent<>nil) then
416 begin
417 if CurError.ErrorType=lfmeIdentifierMissingInCode then
418 begin
419 // Missing component variable, must be added to pascal sources
420 ObjNode:=CurError.Node as TLFMObjectNode;
421 InitClassCompletion;
422 NewIdent:=ObjNode.Name+':'+ObjNode.TypeName;
423 fCTLink.CodeTool.AddClassInsertion(UpperCase(ObjNode.Name),
424 NewIdent+';', ObjNode.Name, ncpPublishedVars);
425 fSettings.AddLogLine(mluNote,
426 Format(lisAddedMissingObjectSToPascalSource, [NewIdent]),
427 fUsedUnitsTool.Filename);
428 end
429 else if IsMissingType(CurError) then
430 begin
431 // Object type
432 ObjNode:=CurError.Node as TLFMObjectNode;
433 OldIdent:=ObjNode.TypeName;
434 NewIdent:=SolveAutoInc(TypeReplacements[OldIdent]);
435 // Keep the old class name if no replacement.
436 if NewIdent<>'' then begin
437 StartPos:=ObjNode.TypeNamePosition;
438 EndPos:=StartPos+Length(OldIdent);
439 fSettings.AddLogLine(mluNote,
440 Format(lisReplacedTypeSWithS, [OldIdent, NewIdent]),
441 fUsedUnitsTool.Filename);
442 AddReplacement(ChgEntryRepl,StartPos,EndPos,NewIdent);
443 Result:=mrRetry;
444 end;
445 end
446 else begin
447 // Property
448 TheNode.FindIdentifier(StartPos,EndPos);
449 if StartPos>0 then begin
450 OldIdent:=copy(fLFMBuffer.Source,StartPos,EndPos-StartPos);
451 NewIdent:=SolveAutoInc(PropReplacements[OldIdent]);
452 // Delete the whole property line if no replacement.
453 if NewIdent='' then begin
454 FindNiceNodeBounds(TheNode,StartPos,EndPos);
455 fSettings.AddLogLine(mluNote, Format(lisRemovedPropertyS, [OldIdent]),
456 fUsedUnitsTool.Filename);
457 end
458 else
459 fSettings.AddLogLine(mluNote,
460 Format(lisReplacedPropertySWithS, [OldIdent, NewIdent]));
461 AddReplacement(ChgEntryRepl,StartPos,EndPos,NewIdent);
462 Result:=mrRetry;
463 end;
464 end;
465 end;
466 CurError:=CurError.PrevError;
467 end;
468 // Apply replacements to LFM.
469 if not ApplyReplacements(ChgEntryRepl) then
470 exit(mrCancel);
471 // Apply added variables to pascal class definition.
472 with fCTLink.CodeTool do
473 if Assigned(CodeCompleteClassNode) then
474 if not ApplyClassCompletion(false) then
475 exit(mrCancel);
476 // Apply replacement types also to pascal source.
477 if TypeReplacements.Tree.Count>0 then
478 if not CodeToolBoss.RetypeClassVariables(fPascalBuffer,
479 TLFMObjectNode(fLFMTree.Root).TypeName, TypeReplacements, false, true) then
480 Result:=mrCancel;
481 finally
482 TypeReplacements.Free;
483 PropReplacements.Free;
484 ChgEntryRepl.Free;
485 end;
486 end;
487
ReplaceTopOffsetsnull488 function TLFMFixer.ReplaceTopOffsets(aSrcOffsets: TList): TModalResult;
489 // Replace top coordinates of controls in visual containers.
490 var
491 TopOffs: TSrcPropOffset;
492 VisOffs: TVisualOffset;
493 OldNum, NewNum, Len, ind, i: integer;
494 begin
495 Result:=mrOK;
496 // Add offset to top coordinates.
497 for i:=aSrcOffsets.Count-1 downto 0 do begin
498 TopOffs:=TSrcPropOffset(aSrcOffsets[i]);
499 if fSettings.CoordOffsets.Find(TopOffs.ParentType, ind) then begin
500 VisOffs:=fSettings.CoordOffsets[ind];
501 Len:=0;
502 while fLFMBuffer.Source[TopOffs.StartPos+Len] in ['-', '0'..'9'] do
503 Inc(Len);
504 try
505 OldNum:=StrToInt(Copy(fLFMBuffer.Source, TopOffs.StartPos, Len));
506 except on EConvertError do
507 OldNum:=0;
508 end;
509 NewNum:=OldNum-VisOffs.ByProperty(TopOffs.PropName);
510 if NewNum<0 then
511 NewNum:=0;
512 fLFMBuffer.Replace(TopOffs.StartPos, Len, IntToStr(NewNum));
513 fSettings.AddLogLine(mluNote, Format(lisChangedSCoordOfSFromDToDInsideS,
514 [TopOffs.PropName, TopOffs.ChildType, OldNum, NewNum, TopOffs.ParentType]),
515 fUsedUnitsTool.Filename);
516 end;
517 end;
518 end;
519
TLFMFixer.AddNewPropsnull520 function TLFMFixer.AddNewProps(aNewProps: TList): TModalResult;
521 // Add new property to the lfm file.
522 var
523 Entry: TAddPropEntry;
524 i: integer;
525 begin
526 Result:=mrOK;
527 for i:=aNewProps.Count-1 downto 0 do begin
528 Entry:=TAddPropEntry(aNewProps[i]);
529 fLFMBuffer.Replace(Entry.StartPos, Entry.EndPos-Entry.StartPos,
530 Entry.NewPrefix+Entry.NewText);
531 fSettings.AddLogLine(mluNote,
532 Format(lisAddedPropertySForS, [Entry.NewText, Entry.ParentType]),
533 fUsedUnitsTool.Filename);
534 end;
535 end;
536
537 procedure TLFMFixer.FillReplaceGrids;
538 var
539 PropUpdater: TGridUpdater;
540 TypeUpdater: TGridUpdater;
541 CurError: TLFMError;
542 OldIdent, NewIdent: string;
543 begin
544 fHasMissingProperties:=false;
545 fHasMissingObjectTypes:=false;
546 // ReplaceTypes is used for properties just in case it will provide some.
547 PropUpdater:=TGridUpdater.Create(fSettings.ReplaceTypes, fPropReplaceGrid);
548 TypeUpdater:=TGridUpdater.Create(fSettings.ReplaceTypes, fTypeReplaceGrid);
549 try
550 if fLFMTree<>nil then begin
551 CurError:=fLFMTree.FirstError;
552 while CurError<>nil do begin
553 if IsMissingType(CurError) then begin
554 OldIdent:=(CurError.Node as TLFMObjectNode).TypeName;
555 NewIdent:=TypeUpdater.AddUnique(OldIdent); // Add each type only once.
556 if NewIdent<>'' then
557 fHasMissingObjectTypes:=true;
558 end
559 else if fSettings.PropReplaceMode<>rlDisabled then begin
560 OldIdent:=CurError.Node.GetIdentifier;
561 PropUpdater.AddUnique(OldIdent); // Add each property only once.
562 fHasMissingProperties:=true;
563 end;
564 CurError:=CurError.NextError;
565 end;
566 end;
567 finally
568 TypeUpdater.Free;
569 PropUpdater.Free;
570 end;
571 end;
572
TLFMFixer.ShowConvertLFMWizardnull573 function TLFMFixer.ShowConvertLFMWizard: TModalResult;
574 var
575 FixLFMDialog: TFixLFMDialog;
576 PrevCursor: TCursor;
577 begin
578 Result:=mrCancel;
579 FixLFMDialog:=TFixLFMDialog.Create(nil, self);
580 try
581 fLFMSynEdit:=FixLFMDialog.LFMSynEdit;
582 fErrorsListBox:=FixLFMDialog.ErrorsListBox;
583 fPropReplaceGrid:=FixLFMDialog.PropReplaceGrid;
584 fTypeReplaceGrid:=FixLFMDialog.TypeReplaceGrid;
585 LoadLFM;
586 if ((fSettings.PropReplaceMode=rlAutomatic) or not fHasMissingProperties)
587 and ((fSettings.TypeReplaceMode=raAutomatic) or not fHasMissingObjectTypes) then
588 Result:=ReplaceAndRemoveAll // Can return mrRetry.
589 else begin
590 // Cursor is earlier set to HourGlass. Show normal cursor while in dialog.
591 PrevCursor:=Screen.Cursor;
592 Screen.Cursor:=crDefault;
593 try
594 Result:=FixLFMDialog.ShowModal;
595 finally
596 Screen.Cursor:=PrevCursor;
597 end;
598 end;
599 finally
600 FixLFMDialog.Free;
601 end;
602 end;
603
TLFMFixer.FixMissingComponentClassesnull604 function TLFMFixer.FixMissingComponentClasses(aMissingTypes: TStringList): TModalResult;
605 // This is called from TLFMChecker.FindAndFixMissingComponentClasses.
606 // Add needed units to uses section using methods already defined in fUsedUnitsTool.
607 var
608 RegComp: TRegisteredComponent;
609 ClassUnitInfo: TUnitInfo;
610 i: Integer;
611 NeededUnitName: String;
612 begin
613 Result:=mrOK;
614 if not Assigned(fUsedUnitsTool) then Exit;
615 for i := 0 to aMissingTypes.Count-1 do
616 begin
617 RegComp:=IDEComponentPalette.FindComponent(aMissingTypes[i]);
618 NeededUnitName:='';
619 if (RegComp<>nil) then begin
620 if RegComp.ComponentClass<>nil then begin
621 NeededUnitName:=RegComp.ComponentClass.UnitName;
622 if NeededUnitName='' then
623 NeededUnitName:=RegComp.GetUnitName;
624 end;
625 end
626 else begin
627 ClassUnitInfo:=Project1.UnitWithComponentClassName(aMissingTypes[i]);
628 if ClassUnitInfo<>nil then
629 NeededUnitName:=ClassUnitInfo.GetUsesUnitName;
630 end;
631 if (NeededUnitName<>'')
632 and fUsedUnitsTool.AddUnitImmediately(NeededUnitName) then
633 begin
634 Result:=mrRetry; // Caller must check LFM validity again
635 fUsedUnitsTool.MaybeAddPackageDep(NeededUnitName);
636 end;
637 end;
638 end;
639
640 procedure TLFMFixer.LoadLFM;
641 begin
642 inherited LoadLFM;
643 FillReplaceGrids; // Fill both ReplaceGrids.
644 end;
645
ConvertAndRepairnull646 function TLFMFixer.ConvertAndRepair: TModalResult;
647 const
648 MaxLoopCount = 50;
649 var
650 ConvTool: TConvDelphiCodeTool;
651 FormFileTool: TFormFileConverter;
652 SrcCoordOffs: TObjectList;
653 SrcNewProps: TObjectList;
654 LoopCount: integer;
655 begin
656 Result:=mrCancel;
657 fLFMTree:=DefaultLFMTrees.GetLFMTree(fLFMBuffer, true);
658 if not fLFMTree.ParseIfNeeded then exit;
659 // Change a type that main form inherits from to a fall-back type if needed.
660 ConvTool:=TConvDelphiCodeTool.Create(fCTLink);
661 try
662 if not ConvTool.FixMainClassAncestor(TLFMObjectNode(fLFMTree.Root).TypeName,
663 fSettings.ReplaceTypes) then exit;
664 finally
665 ConvTool.Free;
666 end;
667 LoopCount:=0; // Prevent possible eternal loops with a counter
668 repeat
669 repeat
670 DebugLn('TLFMFixer.ConvertAndRepair: Checking LFM for '+fPascalBuffer.Filename);
671 if not fLFMTree.ParseIfNeeded then exit;
672 if CodeToolBoss.CheckLFM(fPascalBuffer, fLFMBuffer, fLFMTree,
673 fRootMustBeClassInUnit, fRootMustBeClassInIntf, fObjectsMustExist) then
674 Result:=mrOk
675 else // Rename/remove properties and types interactively.
676 Result:=ShowConvertLFMWizard; // Can return mrRetry.
677 Inc(LoopCount); // Increment counter in inner loop
678 until (Result in [mrOK, mrCancel]) or (LoopCount>MaxLoopCount);
679
680 // Check for missing object types and add units as needed.
681 if not fLFMTree.ParseIfNeeded then
682 Exit(mrCancel);
683 if CodeToolBoss.CheckLFM(fPascalBuffer, fLFMBuffer, fLFMTree,
684 fRootMustBeClassInUnit, fRootMustBeClassInIntf, fObjectsMustExist)
685 then
686 Result:=mrOk
687 else begin
688 Result:=FindAndFixMissingComponentClasses; // Can return mrRetry.
689 if Result=mrRetry then
690 DebugLn('TLFMFixer.ConvertAndRepair: Added unit to uses section -> another loop');
691 end;
692 Inc(LoopCount); // Increment also in outer loop
693 until (Result in [mrOK, mrAbort]) or (LoopCount>MaxLoopCount);
694
695 // Fix top offsets of some components in visual containers
696 if (Result=mrOK) and (fSettings.CoordOffsMode=rsEnabled) then
697 begin
698 FormFileTool:=TFormFileConverter.Create(fCTLink, fLFMBuffer);
699 SrcCoordOffs:=TObjectList.Create;
700 SrcNewProps:=TObjectList.Create;
701 try
702 FormFileTool.VisOffsets:=fSettings.CoordOffsets;
703 FormFileTool.SrcCoordOffs:=SrcCoordOffs;
704 FormFileTool.SrcNewProps:=SrcNewProps;
705 Result:=FormFileTool.Convert;
706 if Result=mrOK then begin
707 Result:=ReplaceTopOffsets(SrcCoordOffs);
708 if Result=mrOK then
709 Result:=AddNewProps(SrcNewProps);
710 end;
711 finally
712 SrcNewProps.Free;
713 SrcCoordOffs.Free;
714 FormFileTool.Free;
715 end;
716 end;
717 end;
718
719
720 { TFixLFMDialog }
721
722 constructor TFixLFMDialog.Create(AOwner: TComponent; ALfmFixer: TLFMFixer);
723 begin
724 inherited Create(AOwner);
725 fLfmFixer:=ALfmFixer;
726 end;
727
728 destructor TFixLFMDialog.Destroy;
729 begin
730 inherited Destroy;
731 end;
732
733 procedure TFixLFMDialog.CheckLFMDialogCREATE(Sender: TObject);
734 begin
735 Caption:=lisFixLFMFile;
736 Position:=poScreenCenter;
737 NoteLabel.Caption:=lisLFMFileContainsInvalidProperties;
738 ErrorsGroupBox.Caption:=lisErrors;
739 LFMGroupBox.Caption:=lisLFMFile;
740 PropertyReplaceGroupBox.Caption:=lisReplacements;
741 PropertiesText.Caption:=lisProperties;
742 TypesText.Caption:=lisTypes;
743 ReplaceAllButton.Caption:=lisReplaceRemoveUnknown;
744 IDEImages.AssignImage(ReplaceAllButton, 'laz_refresh');
745 EditorOpts.GetHighlighterSettings(SynLFMSyn1);
746 EditorOpts.GetSynEditSettings(LFMSynEdit);
747 end;
748
749 procedure TFixLFMDialog.ReplaceAllButtonClick(Sender: TObject);
750 begin
751 ModalResult:=fLfmFixer.ReplaceAndRemoveAll;
752 end;
753
754 procedure TFixLFMDialog.ErrorsListBoxClick(Sender: TObject);
755 begin
756 fLfmFixer.JumpToError(fLfmFixer.FindListBoxError);
757 end;
758
759 procedure TFixLFMDialog.LFMSynEditSpecialLineMarkup(Sender: TObject;
760 Line: integer; var Special: boolean; AMarkup: TSynSelectedColor);
761 var
762 CurError: TLFMError;
763 begin
764 CurError:=fLfmFixer.fLFMTree.FindErrorAtLine(Line);
765 if CurError = nil then Exit;
766 Special := True;
767 EditorOpts.SetMarkupColor(SynLFMSyn1, ahaErrorLine, AMarkup);
768 end;
769
770
771 end.
772
773