1 {
2 ***************************************************************************
3 * *
4 * This source is free software; you can redistribute it and/or modify *
5 * it under the terms of the GNU General Public License as published by *
6 * the Free Software Foundation; either version 2 of the License, or *
7 * (at your option) any later version. *
8 * *
9 * This code is distributed in the hope that it will be useful, but *
10 * WITHOUT ANY WARRANTY; without even the implied warranty of *
11 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *
12 * General Public License for more details. *
13 * *
14 * A copy of the GNU General Public License is available on the World *
15 * Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also *
16 * obtain it by writing to the Free Software Foundation, *
17 * Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA. *
18 * *
19 ***************************************************************************
20
21 Abstract:
22 Functions to deal with different kinds of source files like
23 units, projects, packages and their related IDE features.
24 The code is copied and refactored from the huge main.pp. The goal was to not
25 call methods defined in TMainIDE but there are still some calls doing it.
26 }
27 unit SourceFileManager;
28
29 {$mode objfpc}{$H+}
30 {$MODESWITCH ADVANCEDRECORDS}
31
32 interface
33
34 uses
35 Classes, SysUtils, typinfo, math, fpjson, Laz_AVL_Tree,
36 // LCL
37 Controls, Forms, Dialogs, LCLIntf, LCLType, LclStrConsts,
38 LResources, LCLMemManager,
39 // LazUtils
40 LConvEncoding, LazFileCache, FileUtil, LazFileUtils, LazLoggerBase,
41 LazUtilities, LazStringUtils, LazUTF8, LazTracer, AvgLvlTree,
42 // Codetools
43 {$IFDEF IDE_MEM_CHECK}
44 MemCheck,
45 {$ENDIF}
46 BasicCodeTools, CodeToolsStructs, CodeToolManager, FileProcs, DefineTemplates,
47 CodeCache, CodeTree, FindDeclarationTool, KeywordFuncLists,
48 // BuildIntf
49 NewItemIntf, ProjectIntf, PackageIntf, PackageDependencyIntf, IDEExternToolIntf,
50 // IdeIntf
51 IDEDialogs, PropEdits, IDEMsgIntf, LazIDEIntf, MenuIntf, IDEWindowIntf, FormEditingIntf,
52 ObjectInspector, ComponentReg, SrcEditorIntf, EditorSyntaxHighlighterDef, UnitResources,
53 // IDE
54 IDEProcs, DialogProcs, IDEProtocol, LazarusIDEStrConsts, NewDialog, NewProjectDlg,
55 MainBase, MainBar, MainIntf, Project, ProjectDefs, ProjectInspector, CompilerOptions,
56 SourceSynEditor, SourceEditor, EditorOptions, EnvironmentOpts, CustomFormEditor,
57 ControlSelection, FormEditor, EmptyMethodsDlg, BaseDebugManager, TransferMacros,
58 BuildManager, EditorMacroListViewer, FindRenameIdentifier, BuildModesManager,
59 ViewUnit_Dlg, InputHistory, CheckLFMDlg, etMessagesWnd,
60 ConvCodeTool, BasePkgManager, PackageDefs, PackageSystem, Designer, DesignerProcs;
61
62 type
63
64 TBookmarkCommandsStamp = record
65 private
66 FBookmarksStamp: Int64;
67 public
Changednull68 function Changed(ABookmarksStamp: Int64): Boolean;
69 end;
70
71 TFileCommandsStamp = record
72 private
73 FSrcEdit: TSourceEditor;
74 public
Changednull75 function Changed(ASrcEdit: TSourceEditor): Boolean;
76 end;
77
78 TProjectCommandsStamp = record
79 private
80 FUnitInfo: TUnitInfo;
81 FProjectChangeStamp: Int64;
82 FProjectSessionChangeStamp: Int64;
83 FCompilerParseStamp: integer;
84 FBuildMacroChangeStamp: integer;
85 public
Changednull86 function Changed(AUnitInfo: TUnitInfo): Boolean;
87 end;
88
89 TPackageCommandsStamp = record
90 private
91 FUnitInfo: TUnitInfo;
92 FPackagesChangeStamp: Int64;
93 public
Changednull94 function Changed(AUnitInfo: TUnitInfo): Boolean;
95 end;
96
97 TSourceEditorTabCommandsStamp = record
98 private
99 FSrcEdit: TSourceEditor;
100 FSrcEditLocked: Boolean;
101 FSourceNotebook: TSourceNotebook;
102 FPageIndex, FPageCount: Integer;
103 public
Changednull104 function Changed(ASrcEdit: TSourceEditor): Boolean;
105 end;
106
107 TSourceEditorCommandsStamp = record
108 private
109 FSrcEdit: TSourceEditor;
110 FDisplayState: TDisplayState;
111 FEditorComponentStamp: int64;
112 FEditorCaretStamp: int64;
113
114 FDesigner: TDesigner;
115 FDesignerSelectionStamp: int64;
116 FDesignerStamp: int64;
117 public
Changednull118 function Changed(ASrcEdit: TSourceEditor; ADesigner: TDesigner;
119 ADisplayState: TDisplayState): Boolean;
120 end;
121
122 { TFileOpener }
123
124 TFileOpener = class
125 private
126 FFileName: string;
127 FUseWindowID: Boolean;
128 FPageIndex: integer;
129 FWindowIndex: integer;
130 // Used by OpenEditorFile
131 FUnitIndex: integer;
132 FEditorInfo: TUnitEditorInfo;
133 FNewEditorInfo: TUnitEditorInfo;
134 FFlags: TOpenFlags;
135 FUnknownFile: boolean;
136 FNewUnitInfo: TUnitInfo;
137 // Used by OpenFileAtCursor
138 FActiveSrcEdit: TSourceEditor;
139 FActiveUnitInfo: TUnitInfo;
140 FIsIncludeDirective: boolean;
OpenFileInSourceEditornull141 function OpenFileInSourceEditor(AnEditorInfo: TUnitEditorInfo): TModalResult;
142 // Used by GetAvailableUnitEditorInfo
AvailSrcWindowIndexnull143 function AvailSrcWindowIndex(AnUnitInfo: TUnitInfo): Integer;
144 // Used by OpenEditorFile
OpenResourcenull145 function OpenResource: TModalResult;
ChangeEditorPagenull146 function ChangeEditorPage: TModalResult;
147 procedure CheckInternalFile;
CheckRevertnull148 function CheckRevert: TModalResult;
OpenKnownnull149 function OpenKnown: TModalResult;
OpenUnknownnull150 function OpenUnknown: TModalResult;
OpenUnknownFilenull151 function OpenUnknownFile: TModalResult;
OpenNotExistingFilenull152 function OpenNotExistingFile: TModalResult;
PrepareFilenull153 function PrepareFile: TModalResult;
PrepareRevertnull154 function PrepareRevert(DiskFilename: String): TModalResult;
ResolvePossibleSymlinknull155 function ResolvePossibleSymlink: TModalResult;
156 // Used by OpenFileAtCursor
CheckIfIncludeDirectiveInFrontnull157 function CheckIfIncludeDirectiveInFront(const Line: string; X: integer): boolean;
FindFilenull158 function FindFile(SearchPath: String): Boolean;
GetFilenameAtRowColnull159 function GetFilenameAtRowCol(XY: TPoint): string;
160 public
161 // These methods have a global wrapper
GetAvailableUnitEditorInfonull162 function GetAvailableUnitEditorInfo(AnUnitInfo: TUnitInfo;
163 ACaretPoint: TPoint; WantedTopLine: integer = -1): TUnitEditorInfo;
OpenEditorFilenull164 function OpenEditorFile(APageIndex, AWindowIndex: integer;
165 AEditorInfo: TUnitEditorInfo; AFlags: TOpenFlags): TModalResult;
OpenFileAtCursornull166 function OpenFileAtCursor: TModalResult;
OpenMainUnitnull167 function OpenMainUnit: TModalResult;
RevertMainUnitnull168 function RevertMainUnit: TModalResult;
169 end;
170
171
CreateSrcEditPageNamenull172 function CreateSrcEditPageName(const AnUnitName, AFilename: string;
173 IgnoreEditor: TSourceEditor): string;
174 procedure UpdateDefaultPasFileExt;
175
176 // Wrappers for TFileOpener methods.
177 // WindowIndex is WindowID
GetAvailableUnitEditorInfonull178 function GetAvailableUnitEditorInfo(AnUnitInfo: TUnitInfo;
179 ACaretPoint: TPoint; WantedTopLine: integer = -1): TUnitEditorInfo;
OpenEditorFilenull180 function OpenEditorFile(AFileName: string; PageIndex, WindowIndex: integer;
181 AEditorInfo: TUnitEditorInfo; Flags: TOpenFlags; UseWindowID: Boolean = False): TModalResult;
OpenFileAtCursornull182 function OpenFileAtCursor(ActiveSrcEdit: TSourceEditor;
183 ActiveUnitInfo: TUnitInfo): TModalResult;
OpenMainUnitnull184 function OpenMainUnit(PageIndex, WindowIndex: integer;
185 Flags: TOpenFlags; UseWindowID: Boolean = False): TModalResult;
RevertMainUnitnull186 function RevertMainUnit: TModalResult;
187 // recent
188 procedure AddRecentProjectFile(const AFilename: string);
189 procedure RemoveRecentProjectFile(const AFilename: string);
190 procedure UpdateSourceNames;
CheckEditorNeedsSavenull191 function CheckEditorNeedsSave(AEditor: TSourceEditorInterface;
192 IgnoreSharedEdits: Boolean): Boolean;
193 procedure ArrangeSourceEditorAndMessageView(PutOnTop: boolean);
194 // files/units/projects
SomethingOfProjectIsModifiednull195 function SomethingOfProjectIsModified(Verbose: boolean = false): boolean;
NewFilenull196 function NewFile(NewFileDescriptor: TProjectFileDescriptor;
197 var NewFilename: string; NewSource: string;
198 NewFlags: TNewFlags; NewOwner: TObject): TModalResult;
NewOthernull199 function NewOther: TModalResult;
NewUnitOrFormnull200 function NewUnitOrForm(Template: TNewIDEItemTemplate;
201 DefaultDesc: TProjectFileDescriptor): TModalResult;
202 procedure CreateFileDialogFilterForSourceEditorFiles(Filter: string;
203 out AllEditorMask, AllMask: string);
SaveEditorFilenull204 function SaveEditorFile(AEditor: TSourceEditorInterface; Flags: TSaveFlags): TModalResult;
SaveEditorFilenull205 function SaveEditorFile(const Filename: string; Flags: TSaveFlags): TModalResult;
CloseEditorFilenull206 function CloseEditorFile(AEditor: TSourceEditorInterface; Flags: TCloseFlags):TModalResult;
CloseEditorFilenull207 function CloseEditorFile(const Filename: string; Flags: TCloseFlags): TModalResult;
208 // interactive unit selection
SelectProjectItemsnull209 function SelectProjectItems(ItemList: TViewUnitEntries; ItemType: TIDEProjectItem): TModalResult;
SelectUnitComponentsnull210 function SelectUnitComponents(DlgCaption: string; ItemType: TIDEProjectItem;
211 Files: TStringList): TModalResult;
212 // unit search
FindUnitFileImplnull213 function FindUnitFileImpl(const AFilename: string; TheOwner: TObject = nil;
214 Flags: TFindUnitFileFlags = []): string;
FindSourceFileImplnull215 function FindSourceFileImpl(const AFilename, BaseDirectory: string;
216 Flags: TFindSourceFlags): string;
FindUnitsOfOwnerImplnull217 function FindUnitsOfOwnerImpl(TheOwner: TObject; Flags: TFindUnitsOfOwnerFlags): TStrings;
218 // project
AddActiveUnitToProjectnull219 function AddActiveUnitToProject: TModalResult;
AddUnitToProjectnull220 function AddUnitToProject(const AEditor: TSourceEditorInterface): TModalResult;
RemoveFromProjectDialognull221 function RemoveFromProjectDialog: TModalResult;
InitNewProjectnull222 function InitNewProject(ProjectDesc: TProjectDescriptor): TModalResult;
InitOpenedProjectFilenull223 function InitOpenedProjectFile(AFileName: string; Flags: TOpenFlags): TModalResult;
224 procedure NewProjectFromFile;
CreateProjectForProgramnull225 function CreateProjectForProgram(ProgramBuf: TCodeBuffer): TModalResult;
InitProjectForProgramnull226 function InitProjectForProgram(ProgramBuf: TCodeBuffer): TModalResult;
SaveProjectnull227 function SaveProject(Flags: TSaveFlags): TModalResult;
SaveProjectIfChangednull228 function SaveProjectIfChanged: TModalResult;
CloseProjectnull229 function CloseProject: TModalResult;
230 procedure OpenProject(aMenuItem: TIDEMenuItem);
CompleteLoadingProjectInfonull231 function CompleteLoadingProjectInfo: TModalResult;
232 procedure CloseAll;
233 procedure InvertedFileClose(PageIndex: LongInt; SrcNoteBook: TSourceNotebook; CloseOnRightSideOnly: Boolean = False);
UpdateAppTitleInSourcenull234 function UpdateAppTitleInSource: Boolean;
UpdateAppScaledInSourcenull235 function UpdateAppScaledInSource: Boolean;
UpdateAppAutoCreateFormsnull236 function UpdateAppAutoCreateForms: boolean;
237 // designer
DesignerUnitIsVirtualnull238 function DesignerUnitIsVirtual(aLookupRoot: TComponent): Boolean;
CheckLFMInEditornull239 function CheckLFMInEditor(LFMUnitInfo: TUnitInfo; Quiet: boolean): TModalResult;
LoadLFMnull240 function LoadLFM(AnUnitInfo: TUnitInfo; OpenFlags: TOpenFlags;
241 CloseFlags: TCloseFlags): TModalResult;
LoadLFMnull242 function LoadLFM(AnUnitInfo: TUnitInfo; LFMBuf: TCodeBuffer;
243 OpenFlags: TOpenFlags;
244 CloseFlags: TCloseFlags): TModalResult;
OpenComponentnull245 function OpenComponent(const UnitFilename: string; OpenFlags: TOpenFlags;
246 CloseFlags: TCloseFlags; out Component: TComponent): TModalResult;
CloseUnitComponentnull247 function CloseUnitComponent(AnUnitInfo: TUnitInfo; Flags: TCloseFlags): TModalResult;
CloseDependingUnitComponentsnull248 function CloseDependingUnitComponents(AnUnitInfo: TUnitInfo;
249 Flags: TCloseFlags): TModalResult;
UnitComponentIsUsednull250 function UnitComponentIsUsed(AnUnitInfo: TUnitInfo;
251 CheckHasDesigner: boolean): boolean;
RemoveFilesFromProjectnull252 function RemoveFilesFromProject(UnitInfos: TFPList): TModalResult;
AskSaveProjectnull253 function AskSaveProject(const ContinueText, ContinueBtn: string): TModalResult;
SaveEditorChangesToCodeCachenull254 function SaveEditorChangesToCodeCache(AEditor: TSourceEditorInterface): boolean;
255
256
257 // These are local functions. Forward reference is needed for most of them.
AskToSaveEditorsnull258 // function AskToSaveEditors(EditorList: TList): TModalResult;
259 // function CheckMainSrcLCLInterfaces(Silent: boolean): TModalResult;
260 // function FileExistsInIDE(const Filename: string;
261 // SearchFlags: TProjectFileSearchFlags): boolean;
262 //new unit
263 function CreateNewCodeBuffer(Descriptor: TProjectFileDescriptor;
264 NewOwner: TObject; NewFilename: string; var NewCodeBuffer: TCodeBuffer;
265 var NewUnitName: string): TModalResult;
CreateNewFormnull266 function CreateNewForm(NewUnitInfo: TUnitInfo;
267 AncestorType: TPersistentClass; ResourceCode: TCodeBuffer;
268 UseCreateFormStatements, DisableAutoSize: Boolean): TModalResult;
NewUniqueComponentNamenull269 function NewUniqueComponentName(Prefix: string): string;
270 //save unit
ShowSaveFileAsDialognull271 function ShowSaveFileAsDialog(var AFilename: string; AnUnitInfo: TUnitInfo;
272 var LFMCode, LRSCode: TCodeBuffer; CanAbort: boolean): TModalResult;
SaveUnitComponentnull273 function SaveUnitComponent(AnUnitInfo: TUnitInfo;
274 LRSCode, LFMCode: TCodeBuffer; Flags: TSaveFlags): TModalResult;
RemoveLooseEventsnull275 function RemoveLooseEvents(AnUnitInfo: TUnitInfo): TModalResult;
RenameUnitnull276 function RenameUnit(AnUnitInfo: TUnitInfo; NewFilename, NewUnitName: string;
277 var LFMCode, LRSCode: TCodeBuffer): TModalResult;
RenameUnitLowerCasenull278 function RenameUnitLowerCase(AnUnitInfo: TUnitInfo; AskUser: boolean): TModalresult;
ReplaceUnitUsenull279 function ReplaceUnitUse(OldFilename, OldUnitName, NewFilename, NewUnitName: string;
280 IgnoreErrors, Quiet, Confirm: boolean): TModalResult;
281 //designer
LoadResourceFilenull282 function LoadResourceFile(AnUnitInfo: TUnitInfo; var LFMCode, LRSCode: TCodeBuffer;
283 AutoCreateResourceCode, ShowAbort: boolean): TModalResult;
FindBaseComponentClassnull284 // function FindBaseComponentClass(AnUnitInfo: TUnitInfo; const AComponentClassName,
285 // DescendantClassName: string; out AComponentClass: TComponentClass): boolean;
286 function LoadAncestorDependencyHidden(AnUnitInfo: TUnitInfo;
287 const aComponentClassName: string; OpenFlags: TOpenFlags;
288 out AncestorClass: TComponentClass; out AncestorUnitInfo: TUnitInfo): TModalResult;
FindComponentClassnull289 // function FindComponentClass(AnUnitInfo: TUnitInfo; const AComponentClassName: string;
290 // Quiet: boolean; out ComponentUnitInfo: TUnitInfo; out AComponentClass: TComponentClass;
291 // out LFMFilename: string; out AncestorClass: TComponentClass): TModalResult;
292 function LoadComponentDependencyHidden(AnUnitInfo: TUnitInfo;
293 const AComponentClassName: string; Flags: TOpenFlags; MustHaveLFM: boolean;
294 out AComponentClass: TComponentClass; out ComponentUnitInfo: TUnitInfo;
295 out AncestorClass: TComponentClass; const IgnoreBtnText: string = ''): TModalResult;
LoadIDECodeBuffernull296 function LoadIDECodeBuffer(var ACodeBuffer: TCodeBuffer;
297 const AFilename: string; Flags: TLoadBufferFlags; ShowAbort: boolean): TModalResult;
298 //save project
ShowSaveProjectAsDialognull299 function ShowSaveProjectAsDialog(UseMainSourceFile: boolean): TModalResult;
SaveProjectInfonull300 function SaveProjectInfo(var Flags: TSaveFlags): TModalResult;
301 procedure GetMainUnit(out MainUnitInfo: TUnitInfo; out MainUnitSrcEdit: TSourceEditor);
302 procedure SaveSrcEditorProjectSpecificSettings(AnEditorInfo: TUnitEditorInfo);
303 procedure SaveSourceEditorProjectSpecificSettings;
304 procedure UpdateProjectResourceInfo;
305
306
307 implementation
308
CreateSrcEditPageNamenull309 function CreateSrcEditPageName(const AnUnitName, AFilename: string;
310 IgnoreEditor: TSourceEditor): string;
311 begin
312 Result:=AnUnitName;
313 if Result='' then
314 Result:=ExtractFileName(AFilename);
315 Result:=SourceEditorManager.FindUniquePageName(Result,IgnoreEditor);
316 end;
317
318 procedure UpdateDefaultPasFileExt;
319 var
320 DefPasExt: string;
321 begin
322 // change default pascal file extensions
323 DefPasExt:=PascalExtension[EnvironmentOptions.PascalFileExtension];
324 if LazProjectFileDescriptors<>nil then
325 LazProjectFileDescriptors.DefaultPascalFileExt:=DefPasExt;
326 end;
327
328 // Wrappers for TFileOpener methods.
329
GetAvailableUnitEditorInfonull330 function GetAvailableUnitEditorInfo(AnUnitInfo: TUnitInfo;
331 ACaretPoint: TPoint; WantedTopLine: integer = -1): TUnitEditorInfo;
332 var
333 Opener: TFileOpener;
334 begin
335 Opener := TFileOpener.Create;
336 try
337 Result := Opener.GetAvailableUnitEditorInfo(AnUnitInfo,ACaretPoint,WantedTopLine);
338 finally
339 Opener.Free;
340 end;
341 end;
342
OpenEditorFilenull343 function OpenEditorFile(AFileName: string; PageIndex, WindowIndex: integer;
344 AEditorInfo: TUnitEditorInfo; Flags: TOpenFlags; UseWindowID: Boolean = False): TModalResult;
345 var
346 Opener: TFileOpener;
347 begin
348 Opener := TFileOpener.Create;
349 try
350 Opener.FFileName := AFileName;
351 Opener.FUseWindowID := UseWindowID;
352 Result := Opener.OpenEditorFile(PageIndex,WindowIndex,AEditorInfo,Flags);
353 finally
354 Opener.Free;
355 end;
356 end;
357
OpenFileAtCursornull358 function OpenFileAtCursor(ActiveSrcEdit: TSourceEditor; ActiveUnitInfo: TUnitInfo): TModalResult;
359 var
360 Opener: TFileOpener;
361 begin
362 Opener := TFileOpener.Create;
363 try
364 Opener.FActiveSrcEdit := ActiveSrcEdit;
365 Opener.FActiveUnitInfo := ActiveUnitInfo;
366 Result := Opener.OpenFileAtCursor;
367 finally
368 Opener.Free;
369 end;
370 end;
371
OpenMainUnitnull372 function OpenMainUnit(PageIndex, WindowIndex: integer;
373 Flags: TOpenFlags; UseWindowID: Boolean): TModalResult;
374 var
375 Opener: TFileOpener;
376 begin
377 Opener := TFileOpener.Create;
378 try
379 Opener.FPageIndex := PageIndex;
380 Opener.FWindowIndex := WindowIndex;
381 Opener.FFlags := Flags;
382 Opener.FUseWindowID := UseWindowID;
383 Result := Opener.OpenMainUnit;
384 finally
385 Opener.Free;
386 end;
387 end;
388
RevertMainUnitnull389 function RevertMainUnit: TModalResult;
390 var
391 Opener: TFileOpener;
392 begin
393 Opener := TFileOpener.Create;
394 try
395 Result := Opener.RevertMainUnit;
396 finally
397 Opener.Free;
398 end;
399 end;
400
401 { TBookmarkCommandsStamp }
402
TBookmarkCommandsStamp.Changednull403 function TBookmarkCommandsStamp.Changed(ABookmarksStamp: Int64): Boolean;
404 begin
405 Result := (FBookmarksStamp <> ABookmarksStamp);
406 if Result then
407 FBookmarksStamp := ABookmarksStamp;
408 end;
409
410 { TFileCommandsStamp }
411
TFileCommandsStamp.Changednull412 function TFileCommandsStamp.Changed(ASrcEdit: TSourceEditor): Boolean;
413 begin
414 Result := not(
415 (FSrcEdit = ASrcEdit)
416 );
417
418 if not Result then Exit;
419
420 FSrcEdit := ASrcEdit;
421 end;
422
423 { TProjectCommandsStamp }
424
Changednull425 function TProjectCommandsStamp.Changed(AUnitInfo: TUnitInfo): Boolean;
426 var
427 CurProjectChangeStamp, CurProjectSessionChangeStamp: Integer;
428 begin
429 if Project1=nil then
430 begin
431 CurProjectChangeStamp := LUInvalidChangeStamp;
432 CurProjectSessionChangeStamp := LUInvalidChangeStamp;
433 end else
434 begin
435 CurProjectChangeStamp := Project1.ChangeStamp;
436 CurProjectSessionChangeStamp := Project1.SessionChangeStamp;
437 end;
438 Result := not(
439 (FUnitInfo = AUnitInfo)
440 and (FProjectChangeStamp = CurProjectChangeStamp)
441 and (FProjectSessionChangeStamp = CurProjectSessionChangeStamp)
442 and (FCompilerParseStamp = CompilerParseStamp)
443 and (FBuildMacroChangeStamp = BuildMacroChangeStamp)
444 );
445
446 if not Result then Exit;
447
448 FUnitInfo := AUnitInfo;
449 FProjectChangeStamp := CurProjectChangeStamp;
450 FProjectSessionChangeStamp := CurProjectSessionChangeStamp;
451 FCompilerParseStamp := CompilerParseStamp;
452 FBuildMacroChangeStamp := BuildMacroChangeStamp;
453 end;
454
455 { TPackageCommandsStamp }
456
TPackageCommandsStamp.Changednull457 function TPackageCommandsStamp.Changed(AUnitInfo: TUnitInfo): Boolean;
458 begin
459 Result := not(
460 (FUnitInfo = AUnitInfo)
461 and (FPackagesChangeStamp = PackageGraph.ChangeStamp)
462 );
463
464 if not Result then Exit;
465
466 FUnitInfo := AUnitInfo;
467 FPackagesChangeStamp := PackageGraph.ChangeStamp;
468 end;
469
470 { TSourceEditorTabCommandsStamp }
471
Changednull472 function TSourceEditorTabCommandsStamp.Changed(ASrcEdit: TSourceEditor): Boolean;
473 begin
474 Result := not(
475 (FSrcEdit = ASrcEdit)
476 and ((ASrcEdit = nil) or (
477 (FSrcEditLocked = ASrcEdit.IsLocked)
478 and (FSourceNotebook = ASrcEdit.SourceNotebook)
479 and (FPageIndex = ASrcEdit.SourceNotebook.PageIndex)
480 and (FPageCount = ASrcEdit.SourceNotebook.PageCount)))
481 );
482
483 if not Result then Exit;
484
485 FSrcEdit := ASrcEdit;
486 if ASrcEdit<>nil then
487 begin
488 FSrcEditLocked := ASrcEdit.IsLocked;
489 FSourceNotebook := ASrcEdit.SourceNotebook;
490 FPageIndex := ASrcEdit.SourceNotebook.PageIndex;
491 FPageCount := ASrcEdit.SourceNotebook.PageCount;
492 end;
493 end;
494
495 { TSourceEditorCommandsStamp }
496
TSourceEditorCommandsStamp.Changednull497 function TSourceEditorCommandsStamp.Changed(ASrcEdit: TSourceEditor;
498 ADesigner: TDesigner; ADisplayState: TDisplayState): Boolean;
499 begin
500 Result := not(
501 (FSrcEdit = ASrcEdit)
502 and (FDesigner = ADesigner)
503 and (FDisplayState = ADisplayState)
504 and ((ASrcEdit = nil) or (
505 (FEditorComponentStamp = ASrcEdit.EditorComponent.ChangeStamp)
506 and (FEditorCaretStamp = ASrcEdit.EditorComponent.CaretStamp)))
507 and ((ADesigner = nil) or (
508 (FDesignerSelectionStamp = ADesigner.Selection.ChangeStamp)
509 and (FDesignerStamp = ADesigner.ChangeStamp)))
510 );
511
512 if not Result then Exit;
513
514 FSrcEdit := ASrcEdit;
515 FDesigner := ADesigner;
516 FDisplayState := ADisplayState;
517 if ASrcEdit<>nil then
518 begin
519 FEditorComponentStamp := ASrcEdit.EditorComponent.ChangeStamp;
520 FEditorCaretStamp := ASrcEdit.EditorComponent.CaretStamp;
521 end;
522 if ADesigner<>nil then
523 begin
524 FDesignerSelectionStamp := ADesigner.Selection.ChangeStamp;
525 FDesignerStamp := ADesigner.ChangeStamp;
526 end;
527 end;
528
529 //==============================================================================
530
531 { TFileOpener }
532
TFileOpener.OpenFileInSourceEditornull533 function TFileOpener.OpenFileInSourceEditor(AnEditorInfo: TUnitEditorInfo): TModalResult;
534 var
535 NewSrcEdit: TSourceEditor;
536 AFilename: string;
537 NewCaretXY: TPoint;
538 NewTopLine: LongInt;
539 NewLeftChar: LongInt;
540 NewErrorLine: LongInt;
541 NewExecutionLine: LongInt;
542 FoldState: String;
543 SrcNotebook: TSourceNotebook;
544 AnUnitInfo: TUnitInfo;
545 AShareEditor: TSourceEditor;
546 begin
547 //debugln(['TFileOpener.OpenFileInSourceEditor ',AnEditorInfo.UnitInfo.Filename,' Window=',WindowIndex,'/',SourceEditorManager.SourceWindowCount,' Page=',PageIndex]);
548 AnUnitInfo := AnEditorInfo.UnitInfo;
549 AFilename:=AnUnitInfo.Filename;
550 if (FWindowIndex < 0) then
551 SrcNotebook := SourceEditorManager.ActiveOrNewSourceWindow
552 else
553 if FUseWindowID then begin
554 SrcNotebook := SourceEditorManager.SourceWindowWithID(FWindowIndex);
555 FWindowIndex := SourceEditorManager.IndexOfSourceWindow(SrcNotebook);
556 end
557 else
558 if (FWindowIndex >= SourceEditorManager.SourceWindowCount) then begin
559 SrcNotebook := SourceEditorManager.NewSourceWindow;
560 end
561 else
562 SrcNotebook := SourceEditorManager.SourceWindows[FWindowIndex];
563
564 // get syntax highlighter type
565 if (uifInternalFile in AnUnitInfo.Flags) then
566 AnUnitInfo.UpdateDefaultHighlighter(lshFreePascal)
567 else
568 AnUnitInfo.UpdateDefaultHighlighter(FilenameToLazSyntaxHighlighter(AFilename));
569
570 SrcNotebook.IncUpdateLock;
571 try
572 //DebugLn(['TFileOpener.OpenFileInSourceEditor Revert=',ofRevert in Flags,' ',AnUnitInfo.Filename,' PageIndex=',PageIndex]);
573 if (not (ofRevert in FFlags)) or (FPageIndex<0) then begin
574 // create a new source editor
575
576 // update marks and cursor positions in Project1, so that merging the old
577 // settings during restoration will work
578 SaveSourceEditorProjectSpecificSettings;
579 AShareEditor := nil;
580 if AnUnitInfo.OpenEditorInfoCount > 0 then
581 AShareEditor := TSourceEditor(AnUnitInfo.OpenEditorInfo[0].EditorComponent);
582 NewSrcEdit:=SrcNotebook.NewFile(
583 CreateSrcEditPageName(AnUnitInfo.Unit_Name, AFilename, AShareEditor),
584 AnUnitInfo.Source, False, AShareEditor);
585 NewSrcEdit.EditorComponent.BeginUpdate;
586 MainIDEBar.itmFileClose.Enabled:=True;
587 MainIDEBar.itmFileCloseAll.Enabled:=True;
588 NewCaretXY := AnEditorInfo.CursorPos;
589 NewTopLine := AnEditorInfo.TopLine;
590 FoldState := AnEditorInfo.FoldState;
591 NewLeftChar:=1;
592 NewErrorLine:=-1;
593 NewExecutionLine:=-1;
594 end else begin
595 // revert code in existing source editor
596 NewSrcEdit:=SourceEditorManager.SourceEditorsByPage[FWindowIndex, FPageIndex];
597 NewCaretXY:=NewSrcEdit.EditorComponent.CaretXY;
598 NewTopLine:=NewSrcEdit.EditorComponent.TopLine;
599 FoldState := NewSrcEdit.EditorComponent.FoldState;
600 NewLeftChar:=NewSrcEdit.EditorComponent.LeftChar;
601 NewErrorLine:=NewSrcEdit.ErrorLine;
602 NewExecutionLine:=NewSrcEdit.ExecutionLine;
603 NewSrcEdit.EditorComponent.BeginUpdate;
604 if NewSrcEdit.CodeBuffer=AnUnitInfo.Source then begin
605 AnUnitInfo.Source.AssignTo(NewSrcEdit.EditorComponent.Lines,true);
606 end else
607 NewSrcEdit.CodeBuffer:=AnUnitInfo.Source;
608 AnUnitInfo.ClearModifieds;
609 //DebugLn(['TFileOpener.OpenFileInSourceEditor NewCaretXY=',dbgs(NewCaretXY),' NewTopLine=',NewTopLine]);
610 end;
611
612 NewSrcEdit.IsLocked := AnEditorInfo.IsLocked;
613 AnEditorInfo.EditorComponent := NewSrcEdit;
614 //debugln(['TFileOpener.OpenFileInSourceEditor ',AnUnitInfo.Filename]);
615
616 // restore source editor settings
617 DebugBoss.DoRestoreDebuggerMarks(AnUnitInfo);
618 NewSrcEdit.SyntaxHighlighterType := AnEditorInfo.SyntaxHighlighter;
619 NewSrcEdit.EditorComponent.AfterLoadFromFile;
620 try
621 NewSrcEdit.EditorComponent.FoldState := FoldState;
622 except
623 IDEMessageDialog(lisError, lisFailedToLoadFoldStat, mtError, [mbOK]);
624 end;
625
626 NewSrcEdit.EditorComponent.CaretXY:=NewCaretXY;
627 NewSrcEdit.EditorComponent.TopLine:=NewTopLine;
628 NewSrcEdit.EditorComponent.LeftChar:=NewLeftChar;
629 NewSrcEdit.ErrorLine:=NewErrorLine;
630 NewSrcEdit.ExecutionLine:=NewExecutionLine;
631 NewSrcEdit.ReadOnly:=AnUnitInfo.ReadOnly;
632 NewSrcEdit.Modified:=false;
633
634 // mark unit as loaded
635 NewSrcEdit.EditorComponent.EndUpdate;
636 AnUnitInfo.Loaded:=true;
637 finally
638 SrcNotebook.DecUpdateLock;
639 end;
640
641 // update statusbar and focus editor
642 if (not (ofProjectLoading in FFlags)) then begin
643 SourceEditorManager.ActiveEditor := NewSrcEdit;
644 SourceEditorManager.ShowActiveWindowOnTop(True);
645 end;
646 SrcNoteBook.UpdateStatusBar;
647 SrcNotebook.BringToFront;
648
649 Result:=mrOk;
650 end;
651
TFileOpener.AvailSrcWindowIndexnull652 function TFileOpener.AvailSrcWindowIndex(AnUnitInfo: TUnitInfo): Integer;
653 var
654 i: Integer;
655 begin
656 Result := -1;
657 i := 0;
658 if AnUnitInfo.OpenEditorInfoCount > 0 then
659 while (i < SourceEditorManager.SourceWindowCount) and
660 (SourceEditorManager.SourceWindowByLastFocused[i].IndexOfEditorInShareWith
661 (TSourceEditor(AnUnitInfo.OpenEditorInfo[0].EditorComponent)) >= 0)
662 do
663 inc(i);
664 if i < SourceEditorManager.SourceWindowCount then
665 Result := SourceEditorManager.IndexOfSourceWindow(SourceEditorManager.SourceWindowByLastFocused[i]);
666 end;
667
GetAvailableUnitEditorInfonull668 function TFileOpener.GetAvailableUnitEditorInfo(AnUnitInfo: TUnitInfo;
669 ACaretPoint: TPoint; WantedTopLine: integer): TUnitEditorInfo;
670
EditorMatchesnull671 function EditorMatches(AEditInfo: TUnitEditorInfo;
672 AAccess: TEditorOptionsEditAccessOrderEntry; ALockRun: Integer = 0): Boolean;
673 var
674 AEdit: TSourceEditor;
675 begin
676 AEdit := TSourceEditor(AEditInfo.EditorComponent);
677 Result := False;
678 case AAccess.SearchLocked of
679 eoeaIgnoreLock: ;
680 eoeaLockedOnly: if not AEdit.IsLocked then exit;
681 eoeaUnlockedOnly: if AEdit.IsLocked then exit;
682 eoeaLockedFirst: if (not AEdit.IsLocked) and (ALockRun = 0) then exit;
683 eoeaLockedLast: if (AEdit.IsLocked) and (ALockRun = 0) then exit;
684 end;
685 case AAccess.SearchInView of
686 eoeaIgnoreInView: ;
687 eoeaInViewOnly: if not AEdit.IsCaretOnScreen(ACaretPoint, False) then exit;
688 eoeaInViewSoftCenterOnly: if not AEdit.IsCaretOnScreen(ACaretPoint, True) then exit;
689 end;
690 Result := True;
691 end;
692
693 var
694 i, j, w, LockRun: Integer;
695 Access: TEditorOptionsEditAccessOrderEntry;
696 begin
697 Result := nil;
698 // Check for already open Editor. If there is none, then it must be opened in OpenEditorFile
699 if AnUnitInfo.OpenEditorInfoCount = 0 then exit;
700 for i := 0 to EditorOpts.MultiWinEditAccessOrder.Count - 1 do begin
701 Access := EditorOpts.MultiWinEditAccessOrder[i];
702 if not Access.Enabled then continue;
703 LockRun := 1;
704 if Access.SearchLocked in [eoeaLockedFirst, eoeaLockedLast] then LockRun := 0;
705 repeat
706 case Access.RealSearchOrder of
707 eoeaOrderByEditFocus, eoeaOrderByListPref:
708 begin
709 for j := 0 to AnUnitInfo.OpenEditorInfoCount - 1 do
710 if EditorMatches(AnUnitInfo.OpenEditorInfo[j], Access) then begin
711 Result := AnUnitInfo.OpenEditorInfo[j];
712 break;
713 end;
714 end;
715 eoeaOrderByWindowFocus:
716 begin
717 for w := 0 to SourceEditorManager.SourceWindowCount - 1 do begin
718 for j := 0 to AnUnitInfo.OpenEditorInfoCount - 1 do
719 if (TSourceEditor(AnUnitInfo.OpenEditorInfo[j].EditorComponent).SourceNotebook
720 = SourceEditorManager.SourceWindowByLastFocused[w])
721 and EditorMatches(AnUnitInfo.OpenEditorInfo[j], Access) then begin
722 Result := AnUnitInfo.OpenEditorInfo[j];
723 break;
724 end;
725 if Result <> nil then break;
726 end;
727 end;
728 eoeaOrderByOldestEditFocus:
729 begin
730 for j := AnUnitInfo.OpenEditorInfoCount - 1 downto 0 do
731 if EditorMatches(AnUnitInfo.OpenEditorInfo[j], Access) then begin
732 Result := AnUnitInfo.OpenEditorInfo[j];
733 break;
734 end;
735 end;
736 eoeaOrderByOldestWindowFocus:
737 begin
738 for w := SourceEditorManager.SourceWindowCount - 1 downto 0 do begin
739 for j := 0 to AnUnitInfo.OpenEditorInfoCount - 1 do
740 if (TSourceEditor(AnUnitInfo.OpenEditorInfo[j].EditorComponent).SourceNotebook
741 = SourceEditorManager.SourceWindowByLastFocused[w])
742 and EditorMatches(AnUnitInfo.OpenEditorInfo[j], Access) then begin
743 Result := AnUnitInfo.OpenEditorInfo[j];
744 break;
745 end;
746 if Result <> nil then break;
747 end;
748 end;
749 eoeaOnlyCurrentEdit:
750 begin
751 LockRun := 1;
752 for j := 0 to AnUnitInfo.OpenEditorInfoCount - 1 do
753 if (AnUnitInfo.OpenEditorInfo[j].EditorComponent = SourceEditorManager.ActiveEditor)
754 and EditorMatches(AnUnitInfo.OpenEditorInfo[j], Access) then begin
755 Result := AnUnitInfo.OpenEditorInfo[j];
756 break;
757 end;
758 end;
759 eoeaOnlyCurrentWindow:
760 begin
761 LockRun := 1;
762 for j := 0 to AnUnitInfo.OpenEditorInfoCount - 1 do
763 if (TSourceEditor(AnUnitInfo.OpenEditorInfo[j].EditorComponent).SourceNotebook
764 = SourceEditorManager.ActiveSourceWindow)
765 and EditorMatches(AnUnitInfo.OpenEditorInfo[j], Access) then begin
766 Result := AnUnitInfo.OpenEditorInfo[j];
767 break;
768 end;
769 end;
770 end;
771 inc(LockRun);
772 until (LockRun > 1) or (Result <> nil);
773 FUseWindowID:=False;
774 FFlags:=[];
775 FPageIndex:=-1;
776 if (Result = nil) then
777 case Access.SearchOpenNew of
778 eoeaNoNewTab: ;
779 eoeaNewTabInExistingWindowOnly:
780 begin
781 FWindowIndex := AvailSrcWindowIndex(AnUnitInfo);
782 if FWindowIndex >= 0 then
783 if OpenFileInSourceEditor(AnUnitInfo.GetClosedOrNewEditorInfo) = mrOk then
784 Result := AnUnitInfo.OpenEditorInfo[0]; // newly opened will be last focused
785 end;
786 eoeaNewTabInNewWindowOnly:
787 begin
788 FWindowIndex := SourceEditorManager.SourceWindowCount;
789 if OpenFileInSourceEditor(AnUnitInfo.GetClosedOrNewEditorInfo) = mrOk then
790 Result := AnUnitInfo.OpenEditorInfo[0]; // newly opened will be last focused
791 end;
792 eoeaNewTabInExistingOrNewWindow:
793 begin
794 FWindowIndex := AvailSrcWindowIndex(AnUnitInfo);
795 if FWindowIndex < 0 then
796 FWindowIndex := SourceEditorManager.SourceWindowCount;
797 if OpenFileInSourceEditor(AnUnitInfo.GetClosedOrNewEditorInfo) = mrOk then
798 Result := AnUnitInfo.OpenEditorInfo[0]; // newly opened will be last focused
799 end;
800 end;
801 if Result <> nil then
802 break;
803 end;
804 if Result = nil then
805 // should never happen
806 Result := AnUnitInfo.OpenEditorInfo[0];
807 if Result<>nil then begin
808 // WantedTopLine
809 if (WantedTopLine>0)
810 and (Result.EditorComponent<>nil) then
811 Result.EditorComponent.TopLine:=WantedTopLine;
812 end;
813 end;
814
TFileOpener.OpenResourcenull815 function TFileOpener.OpenResource: TModalResult;
816 var
817 CloseFlags: TCloseFlags;
818 begin
819 // read form data
820 if FilenameIsPascalUnit(FFilename) then begin
821 // this could be a unit with a form
822 //debugln('TFileOpener.OpenResource ',FFilename,' ',OpenFlagsToString(Flags));
823 if ([ofDoNotLoadResource]*FFlags=[])
824 and ( (ofDoLoadResource in FFlags)
825 or ((ofProjectLoading in FFlags)
826 and FNewUnitInfo.LoadedDesigner
827 and (not Project1.AutoOpenDesignerFormsDisabled)
828 and EnvironmentOptions.AutoCreateFormsOnOpen))
829 then begin
830 // -> try to (re)load the lfm file
831 //debugln(['TFileOpener.OpenResource Loading LFM for ',FNewUnitInfo.Filename,' LoadedDesigner=',FNewUnitInfo.LoadedDesigner]);
832 CloseFlags:=[cfSaveDependencies];
833 if ofRevert in FFlags then
834 Include(CloseFlags,cfCloseDependencies);
835 Result:=LoadLFM(FNewUnitInfo,FFlags,CloseFlags);
836 if Result<>mrOk then begin
837 DebugLn(['TFileOpener.OpenResource LoadLFM failed']);
838 exit;
839 end;
840 end else begin
841 Result:=mrOk;
842 end;
843 end else if FNewUnitInfo.Component<>nil then begin
844 // this is no pascal source and there is a designer form
845 // This can be the case, when the file is renamed and/or reverted
846 // -> close form
847 Result:=CloseUnitComponent(FNewUnitInfo,[cfCloseDependencies,cfSaveDependencies]);
848 if Result<>mrOk then begin
849 DebugLn(['TFileOpener.OpenResource CloseUnitComponent failed']);
850 end;
851 end else begin
852 Result:=mrOk;
853 end;
854 if FNewUnitInfo.Component=nil then
855 FNewUnitInfo.LoadedDesigner:=false;
856 end;
857
858 procedure TFileOpener.CheckInternalFile;
859 var
860 NewBuf: TCodeBuffer;
861 begin
862 if LazStartsStr(EditorMacroVirtualDrive, FFileName) then
863 begin
864 FUnitIndex:=Project1.IndexOfFilename(FFilename);
865 if (FUnitIndex < 0) then begin
866 NewBuf := CodeToolBoss.SourceCache.CreateFile(FFileName);
867 if MacroListViewer.MacroByFullName(FFileName) <> nil then
868 NewBuf.Source := MacroListViewer.MacroByFullName(FFileName).GetAsSource;
869 FNewUnitInfo:=TUnitInfo.Create(NewBuf);
870 FNewUnitInfo.DefaultSyntaxHighlighter := lshFreePascal;
871 Project1.AddFile(FNewUnitInfo,false);
872 end
873 else begin
874 FNewUnitInfo:=Project1.Units[FUnitIndex];
875 end;
876 FNewUnitInfo.Flags := FNewUnitInfo.Flags + [uifInternalFile];
877
878 if FNewUnitInfo.OpenEditorInfoCount > 0 then begin
879 FNewEditorInfo := FNewUnitInfo.OpenEditorInfo[0];
880 SourceEditorManager.SetWindowByIDAndPage(FNewEditorInfo.WindowID, FNewEditorInfo.PageIndex);
881 end
882 else begin
883 FNewEditorInfo := FNewUnitInfo.GetClosedOrNewEditorInfo;
884 OpenFileInSourceEditor(FNewEditorInfo);
885 end;
886 end;
887 end;
888
TFileOpener.CheckRevertnull889 function TFileOpener.CheckRevert: TModalResult;
890 // revert: use source editor filename
891 begin
892 if (FPageIndex>=0) then begin
893 if FUseWindowID then // Revert must have a valid ID
894 FWindowIndex := SourceEditorManager.IndexOfSourceWindowWithID(FWindowIndex);
895 FUseWindowID := False;
896 Assert((FWindowIndex >= 0) and (FWindowIndex < SourceEditorManager.SourceWindowCount), 'FWindowIndex for revert');
897 FFilename := SourceEditorManager.SourceEditorsByPage[FWindowIndex, FPageIndex].FileName;
898 end
899 else
900 FFlags := FFlags - [ofRevert]; // No editor exists yet, don't try to revert.
901 FUnitIndex:=Project1.IndexOfFilename(FFilename);
902 if (FUnitIndex > 0) then begin
903 FNewUnitInfo:=Project1.Units[FUnitIndex];
904 if (uifInternalFile in FNewUnitInfo.Flags) then
905 begin
906 if (FNewUnitInfo.OpenEditorInfoCount > 0) then begin
907 FNewEditorInfo := FNewUnitInfo.OpenEditorInfo[0];
908 if MacroListViewer.MacroByFullName(FFileName) <> nil then
909 FNewUnitInfo.Source.Source := MacroListViewer.MacroByFullName(FFileName).GetAsSource;
910 FUseWindowID:=True;
911 FPageIndex := FNewEditorInfo.PageIndex;
912 FWindowIndex := FNewEditorInfo.WindowID;
913 OpenFileInSourceEditor(FNewEditorInfo);
914 end;
915 // else unknown internal file
916 exit(mrIgnore);
917 end;
918 end;
919 exit(mrOk);
920 end;
921
PrepareRevertnull922 function TFileOpener.PrepareRevert(DiskFilename: String): TModalResult;
923 var
924 WInd: integer;
925 ed: TSourceEditor;
926 begin
927 FUnknownFile := False;
928 if FUseWindowID then
929 WInd:=SourceEditorManager.IndexOfSourceWindowWithID(FWindowIndex)
930 else
931 WInd:=FWindowIndex;
932 ed := SourceEditorManager.SourceEditorsByPage[WInd, FPageIndex];
933 FNewEditorInfo := Project1.EditorInfoWithEditorComponent(ed);
934 FNewUnitInfo := FNewEditorInfo.UnitInfo;
935 FUnitIndex:=Project1.IndexOf(FNewUnitInfo);
936 FFilename:=FNewUnitInfo.Filename;
937 if CompareFilenames(FFileName,DiskFilename)=0 then
938 FFileName:=DiskFilename;
939 if FNewUnitInfo.IsVirtual then begin
940 if (not (ofQuiet in FFlags)) then begin
941 IDEMessageDialog(lisRevertFailed, Format(lisFileIsVirtual, [FFilename]),
942 mtInformation,[mbCancel]);
943 end;
944 exit(mrCancel);
945 end;
946 exit(mrOK);
947 end;
948
PrepareFilenull949 function TFileOpener.PrepareFile: TModalResult;
950 begin
951 FUnitIndex:=Project1.IndexOfFilename(FFilename);
952 FUnknownFile := (FUnitIndex < 0);
953 FNewEditorInfo := nil;
954 if not FUnknownFile then begin
955 FNewUnitInfo := Project1.Units[FUnitIndex];
956 if FEditorInfo <> nil then
957 FNewEditorInfo := FEditorInfo
958 else if (ofProjectLoading in FFlags) then
959 FNewEditorInfo := FNewUnitInfo.GetClosedOrNewEditorInfo
960 else
961 FNewEditorInfo := FNewUnitInfo.EditorInfo[0];
962 end;
963 Result := mrOK;
964 end;
965
ChangeEditorPagenull966 function TFileOpener.ChangeEditorPage: TModalResult;
967 // file already open -> change source notebook page
968 begin
969 //DebugLn(['TFileOpener.ChangeEditorPage file already open ',FNewUnitInfo.Filename,' WindowIndex=',FNewEditorInfo.WindowID,' PageIndex=',FNewEditorInfo.PageIndex]);
970 SourceEditorManager.SetWindowByIDAndPage(FNewEditorInfo.WindowID, FNewEditorInfo.PageIndex);
971 if ofDoLoadResource in FFlags then
972 Result:=OpenResource
973 else
974 Result:=mrOk;
975 end;
976
OpenKnownnull977 function TFileOpener.OpenKnown: TModalResult;
978 // project knows this file => all the meta data is known -> just load the source
979 var
980 LoadBufferFlags: TLoadBufferFlags;
981 NewBuf: TCodeBuffer;
982 begin
983 FNewUnitInfo:=Project1.Units[FUnitIndex];
984 LoadBufferFlags:=[lbfCheckIfText];
985 if FilenameIsAbsolute(FFilename) then begin
986 if (not (ofUseCache in FFlags)) then
987 Include(LoadBufferFlags,lbfUpdateFromDisk);
988 if ofRevert in FFlags then
989 Include(LoadBufferFlags,lbfRevert);
990 end;
991 Result:=LoadCodeBuffer(NewBuf,FFileName,LoadBufferFlags,
992 [ofProjectLoading,ofMultiOpen]*FFlags<>[]);
993 if Result<>mrOk then begin
994 DebugLn(['TFileOpener.OpenKnownFile failed LoadCodeBuffer: ',FFilename]);
995 exit;
996 end;
997 FNewUnitInfo.Source:=NewBuf;
998 if FilenameIsPascalUnit(FNewUnitInfo.Filename) then
999 FNewUnitInfo.ReadUnitNameFromSource(false);
1000 FNewUnitInfo.Modified:=FNewUnitInfo.Source.FileOnDiskNeedsUpdate;
1001 end;
1002
OpenUnknownnull1003 function TFileOpener.OpenUnknown: TModalResult;
1004 // open unknown file, Never happens if ofRevert
1005 begin
1006 Result:=OpenUnknownFile;
1007 if Result<>mrOk then exit;
1008 // the file was previously unknown, use the default EditorInfo
1009 if FEditorInfo <> nil then
1010 FNewEditorInfo := FEditorInfo
1011 else
1012 if FNewUnitInfo <> nil then
1013 FNewEditorInfo := FNewUnitInfo.GetClosedOrNewEditorInfo
1014 else
1015 FNewEditorInfo := nil;
1016 end;
1017
OpenUnknownFilenull1018 function TFileOpener.OpenUnknownFile: TModalResult;
1019 var
1020 NewProgramName, LPIFilename, ACaption, AText: string;
1021 PreReadBuf: TCodeBuffer;
1022 LoadFlags: TLoadBufferFlags;
1023 SourceType: String;
1024 begin
1025 if ([ofProjectLoading,ofRegularFile]*FFlags=[]) and (MainIDE.ToolStatus=itNone)
1026 and FilenameExtIs(FFilename,'lpi',true) then begin
1027 // this is a project info file -> load whole project
1028 Result:=MainIDE.DoOpenProjectFile(FFilename,[ofAddToRecent]);
1029 if Result = mrOK then
1030 Result := mrIgnore;
1031 exit;
1032 end;
1033
1034 // load the source
1035 LoadFlags := [lbfCheckIfText,lbfUpdateFromDisk,lbfRevert];
1036 if ofQuiet in FFlags then Include(LoadFlags, lbfQuiet);
1037 Result:=LoadCodeBuffer(PreReadBuf,FFileName,LoadFlags,true);
1038 if Result<>mrOk then exit;
1039 FNewUnitInfo:=nil;
1040
1041 // check if unit is a program
1042 if ([ofProjectLoading,ofRegularFile]*FFlags=[])
1043 and FilenameIsPascalSource(FFilename) then begin
1044 SourceType:=CodeToolBoss.GetSourceType(PreReadBuf,false);
1045 if (SysUtils.CompareText(SourceType,'PROGRAM')=0)
1046 or (SysUtils.CompareText(SourceType,'LIBRARY')=0)
1047 then begin
1048 NewProgramName:=CodeToolBoss.GetSourceName(PreReadBuf,false);
1049 if NewProgramName<>'' then begin
1050 // source is a program
1051 // either this is a lazarus project or it is not yet a lazarus project ;)
1052 LPIFilename:=ChangeFileExt(FFilename,'.lpi');
1053 if FileExistsCached(LPIFilename) then begin
1054 case IDEQuestionDialog(lisProjectInfoFileDetected,
1055 Format(lisTheFileSeemsToBeTheProgramFileOfAnExistingLazarusP,
1056 [FFilename]), mtConfirmation,
1057 [mrOk, lisOpenProject2, mrAbort, lisOpenTheFileAsNormalSource])
1058 of
1059 mrOk:
1060 begin
1061 Result:=MainIDE.DoOpenProjectFile(LPIFilename,[ofAddToRecent]);
1062 if Result = mrOK then
1063 Result := mrIgnore;
1064 exit;
1065 end;
1066 mrCancel: Exit(mrCancel);
1067 end;
1068 end else begin
1069 AText:=Format(lisTheFileSeemsToBeAProgramCloseCurrentProject,
1070 [FFilename, LineEnding, LineEnding]);
1071 ACaption:=lisProgramDetected;
1072 if IDEMessageDialog(ACaption, AText, mtConfirmation, [mbYes,mbNo])=mrYes then
1073 begin
1074 Result:=CreateProjectForProgram(PreReadBuf);
1075 if Result = mrOK then
1076 Result := mrIgnore;
1077 exit;
1078 end;
1079 end;
1080 end;
1081 end;
1082 end;
1083 FNewUnitInfo:=TUnitInfo.Create(PreReadBuf);
1084 if FilenameIsPascalSource(FNewUnitInfo.Filename) then
1085 FNewUnitInfo.ReadUnitNameFromSource(true);
1086 Project1.AddFile(FNewUnitInfo,false);
1087 if (ofAddToProject in FFlags) and (not FNewUnitInfo.IsPartOfProject) then
1088 begin
1089 FNewUnitInfo.IsPartOfProject:=true;
1090 Project1.Modified:=true;
1091 end;
1092 Result:=mrOk;
1093 end;
1094
OpenNotExistingFilenull1095 function TFileOpener.OpenNotExistingFile: TModalResult;
1096 var
1097 NewFlags: TNewFlags;
1098 begin
1099 if ofProjectLoading in FFlags then begin
1100 // this is a file that was loaded last time, but was removed from disk
1101 Result:=IDEQuestionDialog(lisFileNotFound,
1102 Format(lisTheFileWasNotFoundIgnoreWillGoOnLoadingTheProject,
1103 [FFilename, LineEnding, LineEnding]),
1104 mtError, [mrIgnore, lisSkipFileAndContinueLoading,
1105 mrAbort, lisAbortLoadingProject]);
1106 exit;
1107 end;
1108
1109 // Default to cancel
1110 Result:=mrCancel;
1111 if ofQuiet in FFlags then Exit;
1112
1113 if ofOnlyIfExists in FFlags then
1114 begin
1115 IDEMessageDialog(lisFileNotFound,
1116 Format(lisFileNotFound2, [FFilename])+LineEnding, mtInformation,[mbCancel]);
1117 // cancel loading file
1118 Exit;
1119 end;
1120
1121 if IDEMessageDialog(lisFileNotFound,
1122 Format(lisFileNotFoundDoYouWantToCreateIt,[FFilename,LineEnding]),
1123 mtInformation,[mbYes,mbNo])=mrYes then
1124 begin
1125 // create new file
1126 NewFlags:=[nfOpenInEditor,nfCreateDefaultSrc];
1127 if ofAddToProject in FFlags then
1128 Include(NewFlags,nfIsPartOfProject);
1129 if FilenameIsPascalSource(FFilename) then
1130 Result:=MainIDE.DoNewEditorFile(FileDescriptorUnit,FFilename,'',NewFlags)
1131 else
1132 Result:=MainIDE.DoNewEditorFile(FileDescriptorText,FFilename,'',NewFlags);
1133 end;
1134 end;
1135
ResolvePossibleSymlinknull1136 function TFileOpener.ResolvePossibleSymlink: TModalResult;
1137 // Check if symlink and ask user if the real file should be opened instead.
1138 // Compiler never resolves symlinks, files in compiler search path must not be resolved.
1139 // If there already is an editor with a "physical" target of a symlink, use it.
1140 var
1141 SPath, Target: String; // Search path and target file for the symlink.
1142 begin
1143 Result := mrOK;
1144 if ofProjectLoading in FFlags then Exit; // Use the given name when project loads.
1145 Target := GetPhysicalFilenameCached(FFileName,false);
1146 if Target = FFilename then Exit; // Not a symlink, continue with FFilename.
1147 // ToDo: Check if there is an editor with a symlink for this "physical" file.
1148
1149 SPath := CodeToolBoss.GetCompleteSrcPathForDirectory('');
1150 // Check if symlink is found in search path or in editor.
1151 if (SearchDirectoryInSearchPath(SPath, ExtractFilePath(FFileName)) > 0)
1152 or Assigned(SourceEditorManager.SourceEditorIntfWithFilename(FFileName))
1153 then
1154 Exit; // Symlink found -> use it.
1155 // Check if "physical" target for a symlink is found in search path or in editor.
1156 if (SearchDirectoryInSearchPath(SPath, ExtractFilePath(Target)) > 0)
1157 or Assigned(SourceEditorManager.SourceEditorIntfWithFilename(Target))
1158 then // Target found -> use Target name.
1159 FFileName := Target
1160 else // Not found anywhere, ask user.
1161 Result := ChooseSymlink(FFileName, Target);
1162 end;
1163
OpenEditorFilenull1164 function TFileOpener.OpenEditorFile(APageIndex, AWindowIndex: integer;
1165 AEditorInfo: TUnitEditorInfo; AFlags: TOpenFlags): TModalResult;
1166 var
1167 s, DiskFilename: String;
1168 Reverting: Boolean;
1169 begin
1170 {$IFDEF IDE_VERBOSE}
1171 DebugLn('');
1172 DebugLn(['*** TFileOpener.OpenEditorFile START "',AFilename,'" ',OpenFlagsToString(Flags),' Window=',WindowIndex,' Page=',PageIndex]);
1173 {$ENDIF}
1174 {$IFDEF IDE_MEM_CHECK}CheckHeapWrtMemCnt('TFileOpener.OpenEditorFile START');{$ENDIF}
1175 FPageIndex := APageIndex;
1176 FWindowIndex := AWindowIndex;
1177 FEditorInfo := AEditorInfo;
1178 FFlags := AFlags;
1179
1180 Result:=mrCancel;
1181
1182 // replace macros
1183 if ofConvertMacros in FFlags then begin
1184 if not GlobalMacroList.SubstituteStr(FFilename) then exit;
1185 FFilename:=ExpandFileNameUTF8(FFilename);
1186 end;
1187
1188 if (ofRevert in FFlags) then begin
1189 Result := CheckRevert;
1190 if Result = mrIgnore then exit(mrOK);
1191 Assert(Result = mrOK);
1192 end;
1193
1194 if (ofInternalFile in FFlags) then begin
1195 CheckInternalFile;
1196 // unknown internal file => ignore
1197 exit(mrOK);
1198 end;
1199
1200 // normalize filename
1201 FFilename:=TrimFilename(FFilename);
1202 DiskFilename:=CodeToolBoss.DirectoryCachePool.FindDiskFilename(FFilename);
1203 if DiskFilename<>FFilename then begin
1204 // the case is different
1205 DebugLn(['TFileOpener.OpenEditorFile Fixing file name: ',FFilename,' -> ',DiskFilename]);
1206 FFilename:=DiskFilename;
1207 end;
1208 if not (ofRegularFile in FFlags) then begin
1209 DiskFilename:=GetShellLinkTarget(FFileName);
1210 if DiskFilename<>FFilename then begin
1211 // not regular file
1212 DebugLn(['TFileOpener.OpenEditorFile Fixing file name: ',FFilename,' -> ',DiskFilename]);
1213 FFilename:=DiskFilename;
1214 end;
1215 end;
1216
1217 if FilenameIsAbsolute(FFileName) then begin
1218 Result := ResolvePossibleSymlink;
1219 if Result <> mrOK then exit;
1220 end;
1221
1222 // check to not open directories
1223 s:=ExtractFilename(FFilename);
1224 if (s='') or (s='.') or (s='..') then
1225 begin
1226 DebugLn(['TFileOpener.OpenEditorFile ignoring special file: ',FFilename]);
1227 exit;
1228 end;
1229 if DirectoryExistsUTF8(FFileName) then begin
1230 debugln(['TFileOpener.OpenEditorFile skipping directory ',FFileName]);
1231 exit(mrCancel);
1232 end;
1233
1234 if ([ofAddToRecent,ofRevert,ofVirtualFile]*FFlags=[ofAddToRecent])
1235 and (FFilename<>'') and FilenameIsAbsolute(FFilename) then
1236 EnvironmentOptions.AddToRecentOpenFiles(FFilename);
1237
1238 // check if this is a hidden unit:
1239 // if this is the main unit, it is already
1240 // loaded and needs only to be shown in the sourceeditor/formeditor
1241 if (not (ofRevert in FFlags)) and (CompareFilenames(Project1.MainFilename,FFilename)=0)
1242 then begin
1243 Result:=OpenMainUnit;
1244 exit;
1245 end;
1246
1247 // check for special files
1248 if ([ofRegularFile,ofRevert,ofProjectLoading]*FFlags=[])
1249 and FilenameIsAbsolute(FFilename) and FileExistsCached(FFilename) then begin
1250 // check if file is a lazarus project (.lpi)
1251 if FilenameExtIs(FFilename,'lpi',true) then
1252 begin
1253 case
1254 IDEQuestionDialog(lisOpenProject, Format(lisOpenTheProject, [FFilename]),
1255 mtConfirmation, [mrYes, lisOpenProject2,
1256 mrNoToAll, lisOpenAsXmlFile,
1257 mrCancel])
1258 of
1259 mrYes: begin
1260 Result:=MainIDE.DoOpenProjectFile(FFilename,[ofAddToRecent]);
1261 exit;
1262 end;
1263 mrNoToAll: include(FFlags, ofRegularFile);
1264 mrCancel: exit(mrCancel);
1265 end;
1266 end;
1267
1268 // check if file is a lazarus package (.lpk)
1269 if FilenameExtIs(FFilename,'lpk',true) then
1270 begin
1271 case
1272 IDEQuestionDialog(lisOpenPackage,
1273 Format(lisOpenThePackage, [FFilename]),
1274 mtConfirmation, [mrYes, lisCompPalOpenPackage,
1275 mrNoToAll, lisOpenAsXmlFile,
1276 mrCancel])
1277 of
1278 mrYes: begin
1279 Result:=PkgBoss.DoOpenPackageFile(FFilename,[pofAddToRecent],
1280 [ofProjectLoading,ofMultiOpen]*FFlags<>[]);
1281 exit;
1282 end;
1283 mrCancel: exit(mrCancel);
1284 end;
1285 end;
1286 end;
1287
1288 // check if the project knows this file
1289 if (ofRevert in FFlags) then begin
1290 Result := PrepareRevert(DiskFilename);
1291 if Result <> mrOK then exit;
1292 end else begin
1293 Result := PrepareFile;
1294 if Result <> mrOK then exit;
1295 end;
1296
1297 if (FNewEditorInfo <> nil) and (ofAddToProject in FFlags) and (not FNewUnitInfo.IsPartOfProject) then
1298 begin
1299 FNewUnitInfo.IsPartOfProject:=true;
1300 Project1.Modified:=true;
1301 end;
1302
1303 if (FNewEditorInfo <> nil) and (FFlags * [ofProjectLoading, ofRevert] = [])
1304 and (FNewEditorInfo.EditorComponent <> nil) then
1305 exit(ChangeEditorPage);
1306
1307 Reverting:=ofRevert in FFlags;
1308 if Reverting then
1309 Project1.BeginRevertUnit(FNewUnitInfo);
1310 try
1311
1312 // check if file exists
1313 if FilenameIsAbsolute(FFilename) and (not FileExistsCached(FFilename)) then
1314 begin
1315 // file does not exist
1316 if (ofRevert in FFlags) then begin
1317 // PrepareRevert failed, due to missing file
1318 if not (ofQuiet in FFlags) then begin
1319 IDEMessageDialog(lisRevertFailed, Format(lisPkgMangFileNotFound, [FFilename]),
1320 mtError,[mbCancel]);
1321 end;
1322 Result:=mrCancel;
1323 exit;
1324 end else begin
1325 Result:=OpenNotExistingFile;
1326 exit;
1327 end;
1328 end;
1329
1330 // load the source
1331 if FUnknownFile then
1332 Result := OpenUnknown
1333 else
1334 Result := OpenKnown;
1335 if Result=mrIgnore then exit(mrOK);
1336 if Result<>mrOk then exit;
1337
1338 // check readonly
1339 FNewUnitInfo.FileReadOnly:=FileExistsCached(FNewUnitInfo.Filename)
1340 and (not FileIsWritable(FNewUnitInfo.Filename));
1341 //debugln('[TFileOpener.OpenEditorFile] B');
1342 // open file in source notebook
1343 Result:=OpenFileInSourceEditor(FNewEditorInfo);
1344 if Result<>mrOk then begin
1345 DebugLn(['TFileOpener.OpenEditorFile failed OpenFileInSourceEditor: ',FFilename]);
1346 exit;
1347 end;
1348 // open resource component (designer, form, datamodule, ...)
1349 if FNewUnitInfo.OpenEditorInfoCount = 1 then
1350 Result:=OpenResource;
1351 if Result<>mrOk then begin
1352 DebugLn(['TFileOpener.OpenEditorFile failed OpenResource: ',FFilename]);
1353 exit;
1354 end;
1355 finally
1356 if Reverting then
1357 Project1.EndRevertUnit(FNewUnitInfo);
1358 end;
1359
1360 Result:=mrOk;
1361 //debugln('TFileOpener.OpenEditorFile END "',FFilename,'"');
1362 {$IFDEF IDE_MEM_CHECK}CheckHeapWrtMemCnt('TFileOpener.OpenEditorFile END');{$ENDIF}
1363 end;
1364
FindFilenull1365 function TFileOpener.FindFile(SearchPath: String): Boolean;
1366 // Searches for FileName in SearchPath
1367 // If FileName is not found, we'll check extensions pp and pas too
1368 // Returns true if found. FFileName contains the full file+path in that case
1369 var TempFile,TempPath,CurPath: String;
1370 p,c: Integer;
1371 PasExt: TPascalExtType;
1372
SetFileIfExistsnull1373 function SetFileIfExists(const Ext: String): Boolean;
1374 var
1375 FinalFile: String;
1376 begin
1377 FinalFile:=ExpandFileNameUTF8(CurPath+TempFile+Ext);
1378 Result:=FileExistsCached(FinalFile);
1379 if Result then
1380 FFileName:=FinalFile;
1381 end;
1382
1383 begin
1384 if SearchPath='' then SearchPath:='.';
1385 Result:=true;
1386 TempPath:=SearchPath;
1387 while TempPath<>'' do begin
1388 p:=pos(';',TempPath);
1389 if p=0 then p:=length(TempPath)+1;
1390 CurPath:=copy(TempPath,1,p-1);
1391 Delete(TempPath,1,p);
1392 if CurPath='' then continue;
1393 CurPath:=AppendPathDelim(CurPath);
1394 if not FilenameIsAbsolute(CurPath) then begin
1395 if FActiveUnitInfo.IsVirtual then
1396 CurPath:=AppendPathDelim(Project1.Directory)+CurPath
1397 else
1398 CurPath:=AppendPathDelim(ExtractFilePath(FActiveUnitInfo.Filename))+CurPath;
1399 end;
1400 for c:=0 to 2 do begin
1401 TempFile:='';
1402 // FPC searches first lowercase, then keeping case, then uppercase
1403 case c of
1404 0: TempFile:=LowerCase(FFileName);
1405 1: TempFile:=FFileName;
1406 2: TempFile:=UpperCase(FFileName);
1407 end;
1408 if ExtractFileExt(TempFile)='' then begin
1409 for PasExt:=Low(TPascalExtType) to High(TPascalExtType) do
1410 if SetFileIfExists(PascalExtension[PasExt]) then exit;
1411 end
1412 else
1413 if SetFileIfExists('') then exit;
1414 end;
1415 end;
1416 Result:=false;
1417 end;
1418
CheckIfIncludeDirectiveInFrontnull1419 function TFileOpener.CheckIfIncludeDirectiveInFront(const Line: string;
1420 X: integer): boolean;
1421 var
1422 DirectiveEnd, DirectiveStart: integer;
1423 Directive: string;
1424 begin
1425 Result:=false;
1426 DirectiveEnd:=X;
1427 while (DirectiveEnd>1) and (Line[DirectiveEnd-1] in [' ',#9]) do
1428 dec(DirectiveEnd);
1429 DirectiveStart:=DirectiveEnd-1;
1430 while (DirectiveStart>0) and (Line[DirectiveStart]<>'$') do
1431 dec(DirectiveStart);
1432 Directive:=uppercase(copy(Line,DirectiveStart,DirectiveEnd-DirectiveStart));
1433 if (Directive='$INCLUDE') or (Directive='$I') then begin
1434 if ((DirectiveStart>1) and (Line[DirectiveStart-1]='{'))
1435 or ((DirectiveStart>2)
1436 and (Line[DirectiveStart-2]='(') and (Line[DirectiveStart-1]='*'))
1437 then begin
1438 Result:=true;
1439 end;
1440 end;
1441 end;
1442
TFileOpener.GetFilenameAtRowColnull1443 function TFileOpener.GetFilenameAtRowCol(XY: TPoint): string;
1444 var
1445 Line: string;
1446 Len, Stop: integer;
1447 StopChars: set of char;
1448 begin
1449 Result := '';
1450 FIsIncludeDirective:=false;
1451 if (XY.Y >= 1) and (XY.Y <= FActiveSrcEdit.EditorComponent.Lines.Count) then
1452 begin
1453 Line := FActiveSrcEdit.EditorComponent.Lines.Strings[XY.Y - 1];
1454 Len := Length(Line);
1455 if (XY.X >= 1) and (XY.X <= Len + 1) then begin
1456 StopChars := [',',';',':','[',']','{','}','(',')','''','"','`'
1457 ,'#','%','=','>'];
1458 Stop := XY.X;
1459 if Stop>Len then Stop:=Len;
1460 while (Stop >= 1) and (not (Line[Stop] in ['''','"','`'])) do
1461 dec(Stop);
1462 if Stop<1 then
1463 StopChars:=StopChars+[' ',#9]; // no quotes in front => use spaces as boundaries
1464 Stop := XY.X;
1465 while (Stop <= Len) and (not (Line[Stop] in StopChars)) do
1466 Inc(Stop);
1467 while (XY.X > 1) and (not (Line[XY.X - 1] in StopChars)) do
1468 Dec(XY.X);
1469 if Stop > XY.X then begin
1470 Result := Copy(Line, XY.X, Stop - XY.X);
1471 FIsIncludeDirective:=CheckIfIncludeDirectiveInFront(Line,XY.X);
1472 end;
1473 end;
1474 end;
1475 end;
1476
TFileOpener.OpenFileAtCursornull1477 function TFileOpener.OpenFileAtCursor: TModalResult;
1478
ShowNotFoundnull1479 function ShowNotFound(aFilename: string): TModalResult;
1480 begin
1481 Result:=mrCancel;
1482 if aFilename<>'' then
1483 IDEMessageDialog(lisOpenFileAtCursor, lisFileNotFound+':'#13+aFileName,
1484 mtError, [mbOk]);
1485 end;
1486
1487 var
1488 Found: Boolean;
1489 BaseDir: String;
1490 NewFilename,InFilename: string;
1491 AUnitName: String;
1492 SearchPath, Line: String;
1493 Edit: TIDESynEditor;
1494 FoundType: TFindFileAtCursorFlag;
1495 XY: TPoint;
1496 Len: Integer;
1497 begin
1498 Result:=mrCancel;
1499
1500 {$IFDEF VerboseFindFileAtCursor}
1501 debugln(['TFileOpener.OpenFileAtCursor ',FActiveUnitInfo<>nil]);
1502 {$ENDIF}
1503 if (FActiveSrcEdit=nil) or (FActiveUnitInfo=nil) then exit;
1504 BaseDir:=ExtractFilePath(FActiveUnitInfo.Filename);
1505 {$IFDEF VerboseFindFileAtCursor}
1506 debugln(['TFileOpener.OpenFileAtCursor File="',FActiveUnitInfo.Filename,'"']);
1507 {$ENDIF}
1508
1509 Found:=false;
1510
1511 // check if a filename is selected
1512 Edit:=FActiveSrcEdit.EditorComponent;
1513 if Edit.SelAvail and (Edit.BlockBegin.Y=Edit.BlockBegin.X) then begin
1514 {$IFDEF VerboseFindFileAtCursor}
1515 debugln(['TFileOpener.OpenFileAtCursor Edit.SelAvail Edit.SelText="',Edit.SelText,'"']);
1516 {$ENDIF}
1517 FFileName:=ResolveDots(Edit.SelText);
1518 if not FilenameIsAbsolute(FFileName) then
1519 FFileName:=ResolveDots(BaseDir+FFileName);
1520 if FilenameIsAbsolute(FFileName) then begin
1521 if FileExistsCached(FFileName) then
1522 Found:=true
1523 else
1524 exit(ShowNotFound(FFileName));
1525 end;
1526 end;
1527
1528
1529 XY:=Edit.LogicalCaretXY;
1530 if (XY.Y >= 1) and (XY.Y <= FActiveSrcEdit.EditorComponent.Lines.Count) then
1531 begin
1532 Line := FActiveSrcEdit.EditorComponent.Lines.Strings[XY.Y - 1];
1533 Len := Length(Line);
1534 if (XY.X>1) and (XY.X-1<=Len) and IsWordChar[Line[XY.X-1]]
1535 and ((XY.X>Len) or IsNonWordChar[Line[XY.X]]) then
1536 dec(XY.X);
1537 end;
1538
1539
1540 // in a Pascal file use codetools
1541 if FilenameIsPascalSource(FActiveUnitInfo.Filename) then begin
1542 {$IFDEF VerboseFindFileAtCursor}
1543 debugln(['TFileOpener.OpenFileAtCursor FilenameIsPascalSource -> using codetools']);
1544 {$ENDIF}
1545 if MainIDE.BeginCodeTool(FActiveSrcEdit,FActiveUnitInfo,[]) then begin
1546 if CodeToolBoss.FindFileAtCursor(FActiveSrcEdit.CodeBuffer,
1547 XY.X,XY.Y,FoundType,FFileName) then
1548 Found:=true
1549 else begin
1550 FFileName:=FActiveSrcEdit.EditorComponent.GetWordAtRowCol(
1551 FActiveSrcEdit.EditorComponent.LogicalCaretXY);
1552 exit(ShowNotFound(FFileName));
1553 end;
1554 end;
1555 end;
1556
1557 if not Found then begin
1558 // parse FFileName at cursor
1559 FFileName:=GetFilenameAtRowCol(FActiveSrcEdit.EditorComponent.LogicalCaretXY);
1560 if FFileName='' then exit;
1561 // check if absolute FFileName
1562 if FilenameIsAbsolute(FFileName) then begin
1563 if FileExistsCached(FFileName) then
1564 Found:=true
1565 else
1566 exit(ShowNotFound(FFileName));
1567 end;
1568
1569 if FIsIncludeDirective then
1570 begin
1571 if (not Found) then begin
1572 // search include file
1573 SearchPath:='.;'+CodeToolBoss.DefineTree.GetIncludePathForDirectory(BaseDir);
1574 if FindFile(SearchPath) then // sets FFileName if result=true
1575 Found:=true;
1576 end;
1577 end else
1578 begin
1579 if (not Found) then
1580 begin
1581 // search pascal unit without extension
1582 AUnitName:=FFileName;
1583 InFilename:='';
1584 NewFilename:=CodeToolBoss.DirectoryCachePool.FindUnitSourceInCompletePath(
1585 BaseDir,AUnitName,InFilename,true);
1586 if NewFilename<>'' then begin
1587 Found:=true;
1588 FFileName:=NewFilename;
1589 end;
1590 end;
1591
1592 if (not Found) and (ExtractFileExt(FFileName)<>'') then
1593 begin
1594 // search pascal unit with extension
1595 AUnitName:=ExtractFileNameOnly(FFileName);
1596 InFilename:=FFileName;
1597 NewFilename:=CodeToolBoss.DirectoryCachePool.FindUnitSourceInCompletePath(
1598 BaseDir,AUnitName,InFilename,true);
1599 if NewFilename<>'' then begin
1600 Found:=true;
1601 FFileName:=NewFilename;
1602 end;
1603 end;
1604 end;
1605 end;
1606
1607 if (not Found) then begin
1608 // simple search relative to current unit
1609 InFilename:=AppendPathDelim(BaseDir)+FFileName;
1610 if FileExistsCached(InFilename) then begin
1611 Found:=true;
1612 FFileName:=InFilename;
1613 end;
1614 end;
1615
1616 if (not Found) and (System.Pos('.',FFileName)>0) and (not FIsIncludeDirective) then
1617 begin
1618 // for example 'SysUtils.CompareText'
1619 FFileName:=FActiveSrcEdit.EditorComponent.GetWordAtRowCol(
1620 FActiveSrcEdit.EditorComponent.LogicalCaretXY);
1621 if IsValidIdent(FFileName) then begin
1622 // search pascal unit
1623 AUnitName:=FFileName;
1624 InFilename:='';
1625 NewFilename:=CodeToolBoss.DirectoryCachePool.FindUnitSourceInCompletePath(
1626 BaseDir,AUnitName,InFilename,true);
1627 if NewFilename<>'' then begin
1628 Found:=true;
1629 FFileName:=NewFilename;
1630 end;
1631 end;
1632 end;
1633
1634 if Found then begin
1635 // open, FFileName is set earlier.
1636 InputHistories.SetFileDialogSettingsInitialDir(ExtractFilePath(FFileName));
1637 FUseWindowID:=False;
1638 Result:=OpenEditorFile(-1, -1, nil, [ofAddToRecent]);
1639 end else
1640 exit(ShowNotFound(FFileName));
1641 end;
1642
OpenMainUnitnull1643 function TFileOpener.OpenMainUnit: TModalResult;
1644 var
1645 MainUnitInfo: TUnitInfo;
1646 begin
1647 {$IFDEF IDE_VERBOSE}
1648 debugln(['[TFileOpener.OpenMainUnit] A ProjectLoading=',ofProjectLoading in Flags,' MainUnitID=',Project1.MainUnitID]);
1649 {$ENDIF}
1650 Result:=mrCancel;
1651 if (Project1=nil) or (Project1.MainUnitID<0) then exit;
1652 MainUnitInfo:=Project1.MainUnitInfo;
1653
1654 // check if main unit is already open in source editor
1655 if (MainUnitInfo.OpenEditorInfoCount > 0) and (not (ofProjectLoading in FFlags)) then
1656 begin
1657 // already loaded -> switch to source editor
1658 SourceEditorManager.ActiveEditor := TSourceEditor(MainUnitInfo.OpenEditorInfo[0].EditorComponent);
1659 SourceEditorManager.ShowActiveWindowOnTop(True);
1660 Result:=mrOk;
1661 exit;
1662 end;
1663
1664 // open file in source notebook
1665 Result:=OpenFileInSourceEditor(MainUnitInfo.GetClosedOrNewEditorInfo);
1666 if Result<>mrOk then exit;
1667
1668 Result:=mrOk;
1669 {$IFDEF IDE_VERBOSE}
1670 debugln('[TFileOpener.OpenMainUnit] END');
1671 {$ENDIF}
1672 end;
1673
RevertMainUnitnull1674 function TFileOpener.RevertMainUnit: TModalResult;
1675 begin
1676 Result:=mrOk;
1677 if Project1.MainUnitID<0 then exit;
1678 FFileName:='';
1679 FUseWindowID:=True;
1680 if Project1.MainUnitInfo.OpenEditorInfoCount > 0 then
1681 // main unit is loaded, so we can just revert
1682 Result:=OpenEditorFile(Project1.MainUnitInfo.EditorInfo[0].PageIndex,
1683 Project1.MainUnitInfo.EditorInfo[0].WindowID, nil, [ofRevert])
1684 else begin
1685 // main unit is only loaded in background
1686 // -> just reload the source and update the source name
1687 Result:=Project1.MainUnitInfo.ReadUnitSource(true,true);
1688 end;
1689 end;
1690
CheckMainSrcLCLInterfacesnull1691 function CheckMainSrcLCLInterfaces(Silent: boolean): TModalResult;
1692 var
1693 MainUnitInfo: TUnitInfo;
1694 MainUsesSection,ImplementationUsesSection: TStrings;
1695 MsgResult: TModalResult;
1696 begin
1697 Result:=mrOk;
1698 if (Project1=nil) then exit;
1699 if Project1.SkipCheckLCLInterfaces then exit;
1700 MainUnitInfo:=Project1.MainUnitInfo;
1701 if (MainUnitInfo=nil) or (MainUnitInfo.Source=nil) then exit;
1702 if PackageGraph.FindDependencyRecursively(Project1.FirstRequiredDependency,
1703 PackageGraph.LCLBasePackage)=nil
1704 then
1705 exit; // project does not use LCLBase
1706 // project uses LCLBase
1707 MainUsesSection:=nil;
1708 ImplementationUsesSection:=nil;
1709 try
1710 if not CodeToolBoss.FindUsedUnitNames(MainUnitInfo.Source,
1711 MainUsesSection,ImplementationUsesSection) then exit;
1712 if (SearchInStringListI(MainUsesSection,'forms')<0)
1713 and (SearchInStringListI(ImplementationUsesSection,'forms')<0) then
1714 exit;
1715 // project uses lcl unit Forms
1716 if (SearchInStringListI(MainUsesSection,'interfaces')>=0)
1717 or (SearchInStringListI(ImplementationUsesSection,'interfaces')>=0) then
1718 exit;
1719 // project uses lcl unit Forms, but not unit interfaces
1720 // this will result in strange linker error
1721 if not Silent then
1722 begin
1723 MsgResult:=IDEQuestionDialog(lisCCOWarningCaption,
1724 Format(lisTheProjectDoesNotUseTheLCLUnitInterfacesButItSeems, [LineEnding]),
1725 mtWarning, [mrYes, lisAddUnitInterfaces,
1726 mrNo, lisIgnore,
1727 mrNoToAll, lisAlwaysIgnore,
1728 mrCancel]);
1729 case MsgResult of
1730 mrNo: exit;
1731 mrNoToAll: begin Project1.SkipCheckLCLInterfaces:=true; exit; end;
1732 mrCancel: exit(mrCancel);
1733 end;
1734 end;
1735 CodeToolBoss.AddUnitToMainUsesSection(MainUnitInfo.Source,'Interfaces','');
1736 finally
1737 MainUsesSection.Free;
1738 ImplementationUsesSection.Free;
1739 end;
1740 end;
1741
1742 procedure AddRecentProjectFile(const AFilename: string);
1743 begin
1744 EnvironmentOptions.AddToRecentProjectFiles(AFilename);
1745 MainIDE.SetRecentProjectFilesMenu;
1746 MainIDE.SaveEnvironment;
1747 end;
1748
1749 procedure RemoveRecentProjectFile(const AFilename: string);
1750 begin
1751 EnvironmentOptions.RemoveFromRecentProjectFiles(AFilename);
1752 MainIDE.SetRecentProjectFilesMenu;
1753 MainIDE.SaveEnvironment;
1754 end;
1755
AddActiveUnitToProjectnull1756 function AddActiveUnitToProject: TModalResult;
1757 begin
1758 Result := AddUnitToProject(nil);
1759 end;
1760
AddUnitToProjectnull1761 function AddUnitToProject(const AEditor: TSourceEditorInterface): TModalResult;
1762 var
1763 ActiveSourceEditor: TSourceEditor;
1764 ActiveUnitInfo: TUnitInfo;
1765 s, ShortUnitName: string;
1766 OkToAdd, IsPascal: boolean;
1767 Owners: TFPList;
1768 i: Integer;
1769 APackage: TLazPackage;
1770 MsgResult: TModalResult;
1771 begin
1772 Result:=mrCancel;
1773 if AEditor<>nil then
1774 begin
1775 ActiveSourceEditor := AEditor as TSourceEditor;
1776 if not MainIDE.BeginCodeTool(ActiveSourceEditor,ActiveUnitInfo,[ctfUseGivenSourceEditor]) then exit;
1777 end else
1778 begin
1779 ActiveSourceEditor:=nil;
1780 if not MainIDE.BeginCodeTool(ActiveSourceEditor,ActiveUnitInfo,[]) then exit;
1781 end;
1782 if (ActiveUnitInfo=nil) then exit;
1783 if ActiveUnitInfo.IsPartOfProject then begin
1784 if not ActiveUnitInfo.IsVirtual then
1785 s:=Format(lisTheFile, [ActiveUnitInfo.Filename])
1786 else
1787 s:=Format(lisTheFile, [ActiveSourceEditor.PageName]);
1788 s:=Format(lisisAlreadyPartOfTheProject, [s]);
1789 IDEMessageDialog(lisInformation, s, mtInformation, [mbOk]);
1790 exit;
1791 end;
1792 if not ActiveUnitInfo.IsVirtual then
1793 s:='"'+ActiveUnitInfo.Filename+'"'
1794 else
1795 s:='"'+ActiveSourceEditor.PageName+'"';
1796 if (ActiveUnitInfo.Unit_Name<>'')
1797 and (Project1.IndexOfUnitWithName(ActiveUnitInfo.Unit_Name,true,ActiveUnitInfo)>=0) then
1798 begin
1799 IDEMessageDialog(lisInformation, Format(
1800 lisUnableToAddToProjectBecauseThereIsAlreadyAUnitWith, [s]),
1801 mtInformation, [mbOk]);
1802 exit;
1803 end;
1804
1805 Owners:=PkgBoss.GetPossibleOwnersOfUnit(ActiveUnitInfo.Filename,[]);
1806 try
1807 if (Owners<>nil) then begin
1808 for i:=0 to Owners.Count-1 do begin
1809 if TObject(Owners[i]) is TLazPackage then begin
1810 APackage:=TLazPackage(Owners[i]);
1811 MsgResult:=IDEQuestionDialog(lisAddPackageRequirement,
1812 Format(lisTheUnitBelongsToPackage, [APackage.IDAsString]),
1813 mtConfirmation, [mrYes, lisAddPackageToProject2,
1814 mrIgnore, lisAddUnitNotRecommended,
1815 mrCancel],'');
1816 case MsgResult of
1817 mrYes:
1818 begin
1819 PkgBoss.AddProjectDependency(Project1,APackage);
1820 exit;
1821 end;
1822 mrIgnore: ;
1823 else
1824 exit;
1825 end;
1826 end;
1827 end;
1828 end;
1829 finally
1830 Owners.Free;
1831 end;
1832
1833 IsPascal:=FilenameIsPascalUnit(ActiveUnitInfo.Filename);
1834 if IsPascal and (EnvironmentOptions.CharcaseFileAction<>ccfaIgnore) then
1835 begin
1836 // ask user to apply naming conventions
1837 Result:=RenameUnitLowerCase(ActiveUnitInfo,true);
1838 if Result=mrIgnore then Result:=mrOk;
1839 if Result<>mrOk then begin
1840 DebugLn('AddUnitToProject A RenameUnitLowerCase failed ',ActiveUnitInfo.Filename);
1841 exit;
1842 end;
1843 end;
1844
1845 if IDEMessageDialog(lisConfirmation, Format(lisAddToProject, [s]),
1846 mtConfirmation, [mbYes, mbCancel]) in [mrOk, mrYes]
1847 then begin
1848 OkToAdd:=True;
1849 if IsPascal then
1850 OkToAdd:=CheckDirIsInSearchPath(ActiveUnitInfo,False)
1851 else if FilenameExtIs(ActiveUnitInfo.Filename,'inc') then
1852 OkToAdd:=CheckDirIsInSearchPath(ActiveUnitInfo,True);
1853 if OkToAdd then begin
1854 ActiveUnitInfo.IsPartOfProject:=true;
1855 Project1.Modified:=true;
1856 if IsPascal and (pfMainUnitHasUsesSectionForAllUnits in Project1.Flags) then
1857 begin
1858 ActiveUnitInfo.ReadUnitNameFromSource(false);
1859 ShortUnitName:=ActiveUnitInfo.CreateUnitName;
1860 if (ShortUnitName<>'') then begin
1861 if CodeToolBoss.AddUnitToMainUsesSection(Project1.MainUnitInfo.Source,ShortUnitName,'')
1862 then
1863 Project1.MainUnitInfo.Modified:=true;
1864 end;
1865 end;
1866 end;
1867 end;
1868
1869 if Project1.AutoCreateForms and IsPascal
1870 and (pfMainUnitHasCreateFormStatements in Project1.Flags) then
1871 UpdateUnitInfoResourceBaseClass(ActiveUnitInfo,true);
1872 end;
1873
1874 procedure UpdateSourceNames;
1875 var
1876 i: integer;
1877 AnUnitInfo: TUnitInfo;
1878 SourceName, PageName: string;
1879 AEditor: TSourceEditor;
1880 begin
1881 for i:=0 to SourceEditorManager.SourceEditorCount-1 do begin
1882 AEditor := SourceEditorManager.SourceEditors[i];
1883 AnUnitInfo := Project1.UnitWithEditorComponent(AEditor);
1884 if AnUnitInfo=nil then continue;
1885 if FilenameIsPascalUnit(AnUnitInfo.Filename) then begin
1886 SourceName:=CodeToolBoss.GetCachedSourceName(AnUnitInfo.Source);
1887 if SourceName<>'' then
1888 AnUnitInfo.ReadUnitNameFromSource(true);
1889 end else
1890 SourceName:='';
1891 PageName:=CreateSrcEditPageName(SourceName, AnUnitInfo.Filename, AEditor);
1892 AEditor.PageName := PageName;
1893 end;
1894 end;
1895
CheckEditorNeedsSavenull1896 function CheckEditorNeedsSave(AEditor: TSourceEditorInterface;
1897 IgnoreSharedEdits: Boolean): Boolean;
1898 var
1899 AnEditorInfo: TUnitEditorInfo;
1900 AnUnitInfo: TUnitInfo;
1901 begin
1902 Result := False;
1903 if AEditor = nil then exit;
1904 AnEditorInfo := Project1.EditorInfoWithEditorComponent(AEditor);
1905 if AnEditorInfo = nil then exit;
1906
1907 AnUnitInfo := AnEditorInfo.UnitInfo;
1908 if (AnUnitInfo.OpenEditorInfoCount > 1) and IgnoreSharedEdits then
1909 exit;
1910
1911 // save some meta data of the source
1912 SaveSrcEditorProjectSpecificSettings(AnEditorInfo);
1913
1914 Result := (AEditor.Modified) or (AnUnitInfo.Modified);
1915 end;
1916
1917 procedure ArrangeSourceEditorAndMessageView(PutOnTop: boolean);
1918 begin
1919 if SourceEditorManager.SourceWindowCount > 0 then
1920 begin
1921 if PutOnTop then
1922 begin
1923 IDEWindowCreators.ShowForm(MessagesView,true);
1924 SourceEditorManager.ShowActiveWindowOnTop(False);
1925 exit;
1926 end;
1927 end;
1928 MainIDE.DoShowMessagesView(PutOnTop);
1929 end;
1930
SomethingOfProjectIsModifiednull1931 function SomethingOfProjectIsModified(Verbose: boolean): boolean;
1932 begin
1933 Result:=(Project1<>nil)
1934 and (Project1.SomethingModified(true,true,Verbose)
1935 or SourceEditorManager.SomethingModified(Verbose));
1936 end;
1937
FileExistsInIDEnull1938 function FileExistsInIDE(const Filename: string;
1939 SearchFlags: TProjectFileSearchFlags): boolean;
1940 begin
1941 Result:=FileExistsCached(Filename)
1942 or ((Project1<>nil) and (Project1.UnitInfoWithFilename(Filename,SearchFlags)<>nil));
1943 end;
1944
BeautifySrcnull1945 function BeautifySrc(const s: string): string;
1946 begin
1947 Result:=CodeToolBoss.SourceChangeCache.BeautifyCodeOptions.BeautifyStatement(s,0);
1948 end;
1949
NewFilenull1950 function NewFile(NewFileDescriptor: TProjectFileDescriptor;
1951 var NewFilename: string; NewSource: string;
1952 NewFlags: TNewFlags; NewOwner: TObject): TModalResult;
1953 var
1954 NewUnitInfo: TUnitInfo;
1955 NewSrcEdit: TSourceEditor;
1956 NewUnitName: string;
1957 NewBuffer: TCodeBuffer;
1958 OldUnitIndex: Integer;
1959 AncestorType: TPersistentClass;
1960 LFMFilename: String;
1961 SearchFlags: TProjectFileSearchFlags;
1962 LFMSourceText: String;
1963 LFMCode: TCodeBuffer;
1964 AProject: TProject;
1965 LRSFilename: String;
1966 ResType: TResourceType;
1967 SrcNoteBook: TSourceNotebook;
1968 AShareEditor: TSourceEditor;
1969 DisableAutoSize: Boolean;
1970 APackage: TLazPackage;
1971 IsPartOfProject: Boolean;
1972 RequiredPackages: String;
1973 Src: String;
1974 i: Integer;
1975 LFindDesignerBaseClassByName: Boolean = True;
1976 PreventAutoSize: Boolean;
1977 begin
1978 //debugln('NewFile A NewFilename=',NewFilename);
1979 // empty NewFilename is ok, it will be auto generated
1980 SaveEditorChangesToCodeCache(nil);
1981
1982 // convert macros in filename
1983 if nfConvertMacros in NewFlags then begin
1984 if not GlobalMacroList.SubstituteStr(NewFilename) then begin
1985 Result:=mrCancel;
1986 exit;
1987 end;
1988 end;
1989
1990 Result:=NewFileDescriptor.Init(NewFilename,NewOwner,NewSource,nfQuiet in NewFlags);
1991 if Result<>mrOk then exit;
1992
1993 if FilenameIsAbsolute(NewFilename) and DirectoryExistsUTF8(NewFilename) then
1994 begin
1995 IDEMessageDialog(lisFileIsDirectory,
1996 lisUnableToCreateNewFileBecauseThereIsAlreadyADirecto,
1997 mtError,[mbCancel]);
1998 exit(mrCancel);
1999 end;
2000
2001 if NewOwner is TProject then
2002 AProject:=TProject(NewOwner)
2003 else
2004 AProject:=Project1;
2005 if NewOwner is TLazPackage then
2006 APackage:=TLazPackage(NewOwner)
2007 else
2008 APackage:=nil;
2009
2010 OldUnitIndex:=AProject.IndexOfFilename(NewFilename);
2011 if OldUnitIndex>=0 then begin
2012 // the file is not really new
2013 // => close form
2014 Result:=CloseUnitComponent(AProject.Units[OldUnitIndex],
2015 [cfCloseDependencies,cfSaveDependencies]);
2016 if Result<>mrOk then
2017 begin
2018 debugln(['NewFile CloseUnitComponent failed']);
2019 exit;
2020 end;
2021 end;
2022
2023 IsPartOfProject:=(nfIsPartOfProject in NewFlags)
2024 or (NewOwner is TProject)
2025 or (AProject.FileIsInProjectDir(NewFilename)
2026 and (not (nfIsNotPartOfProject in NewFlags)));
2027
2028 // add required packages
2029 //debugln(['NewFile NewFileDescriptor.RequiredPackages="',NewFileDescriptor.RequiredPackages,'" ',DbgSName(NewFileDescriptor)]);
2030 RequiredPackages:=NewFileDescriptor.RequiredPackages;
2031 if (RequiredPackages='') and (NewFileDescriptor.ResourceClass<>nil) then
2032 begin
2033 if (NewFileDescriptor.ResourceClass.InheritsFrom(TForm))
2034 or (NewFileDescriptor.ResourceClass.InheritsFrom(TFrame)) then
2035 RequiredPackages:='LCL';
2036 end;
2037 if RequiredPackages<>'' then
2038 begin
2039 if IsPartOfProject then begin
2040 Result:=PkgBoss.AddProjectDependencies(Project1,RequiredPackages);
2041 if Result<>mrOk then
2042 begin
2043 debugln(['NewFile PkgBoss.AddProjectDependencies failed RequiredPackages="',RequiredPackages,'"']);
2044 exit;
2045 end;
2046 end;
2047 if APackage<>nil then
2048 begin
2049 Result:=PkgBoss.AddPackageDependency(APackage,RequiredPackages);
2050 if Result<>mrOk then
2051 begin
2052 debugln(['NewFile PkgBoss.AddPackageDependency failed RequiredPackages="',RequiredPackages,'"']);
2053 exit;
2054 end;
2055 end;
2056 end;
2057
2058 // check if the new file fits
2059 Result:=NewFileDescriptor.CheckOwner(nfQuiet in NewFlags);
2060 if Result<>mrOk then
2061 begin
2062 debugln(['NewFile NewFileDescriptor.CheckOwner failed NewFilename="',NewFilename,'"']);
2063 exit;
2064 end;
2065
2066 // create new codebuffer and apply naming conventions
2067 NewBuffer:=nil;
2068 NewUnitName:='';
2069 Result:=CreateNewCodeBuffer(NewFileDescriptor,NewOwner,NewFilename,NewBuffer,NewUnitName);
2070 if Result<>mrOk then
2071 begin
2072 debugln(['NewFile CreateNewCodeBuffer failed NewFilename="',NewFilename,'"']);
2073 exit;
2074 end;
2075 NewFilename:=NewBuffer.Filename;
2076
2077 if OldUnitIndex>=0 then begin
2078 // the file is not really new
2079 NewUnitInfo:=AProject.Units[OldUnitIndex];
2080 // assign source
2081 NewUnitInfo.Source:=NewBuffer;
2082 end else
2083 NewUnitInfo:=TUnitInfo.Create(NewBuffer);
2084 //debugln(['NewFile ',NewUnitInfo.Filename,' ',NewFilename]);
2085 if (CompareText(NewUnitInfo.Unit_Name,NewUnitName)=0) then
2086 NewUnitInfo.Unit_Name:=NewUnitName;
2087 NewUnitInfo.BuildFileIfActive:=NewFileDescriptor.BuildFileIfActive;
2088 NewUnitInfo.RunFileIfActive:=NewFileDescriptor.RunFileIfActive;
2089
2090 // create source code
2091 //debugln('NewFile A nfCreateDefaultSrc=',nfCreateDefaultSrc in NewFlags,' ResourceClass=',dbgs(NewFileDescriptor.ResourceClass));
2092 if nfCreateDefaultSrc in NewFlags then begin
2093 if (NewFileDescriptor.ResourceClass<>nil) then begin
2094 NewUnitInfo.ComponentName:=NewUniqueComponentName(NewFileDescriptor.DefaultResourceName);
2095 NewUnitInfo.ComponentResourceName:='';
2096 end;
2097 Src:=NewFileDescriptor.CreateSource(NewUnitInfo.Filename,NewUnitName,NewUnitInfo.ComponentName);
2098 Src:=SourceEditorManager.Beautify(Src,[sembfNotBreakDots]);
2099 //debugln(['NewFile ',dbgtext(Src)]);
2100 Src:=CodeToolBoss.SourceChangeCache.BeautifyCodeOptions.BeautifyStatement(Src,0);
2101 NewUnitInfo.Source.Source:=Src;
2102 end else begin
2103 if nfBeautifySrc in NewFlags then
2104 NewBuffer.Source:=BeautifySrc(NewSource)
2105 else
2106 NewBuffer.Source:=NewSource;
2107 end;
2108 NewUnitInfo.Modified:=true;
2109
2110 // add to project
2111 NewUnitInfo.Loaded:=true;
2112 NewUnitInfo.IsPartOfProject:=IsPartOfProject;
2113 if OldUnitIndex<0 then begin
2114 AProject.AddFile(NewUnitInfo,
2115 NewFileDescriptor.AddToProject
2116 and NewFileDescriptor.IsPascalUnit
2117 and NewUnitInfo.IsPartOfProject
2118 and (pfMainUnitHasUsesSectionForAllUnits in AProject.Flags));
2119 end;
2120 NewSrcEdit := Nil;
2121 if nfOpenInEditor in NewFlags then begin
2122 // open a new sourceeditor
2123 SrcNoteBook := SourceEditorManager.ActiveOrNewSourceWindow;
2124 AShareEditor := nil;
2125 if NewUnitInfo.OpenEditorInfoCount > 0 then
2126 AShareEditor := TSourceEditor(NewUnitInfo.OpenEditorInfo[0].EditorComponent);
2127 NewSrcEdit := SrcNoteBook.NewFile(
2128 CreateSrcEditPageName(NewUnitInfo.Unit_Name, NewUnitInfo.Filename, AShareEditor),
2129 NewUnitInfo.Source, True, AShareEditor);
2130 MainIDEBar.itmFileClose.Enabled:=True;
2131 MainIDEBar.itmFileCloseAll.Enabled:=True;
2132 NewSrcEdit.SyntaxHighlighterType:=NewUnitInfo.EditorInfo[0].SyntaxHighlighter;
2133 NewUnitInfo.GetClosedOrNewEditorInfo.EditorComponent := NewSrcEdit;
2134 NewSrcEdit.EditorComponent.CaretXY := Point(1,1);
2135
2136 // create component
2137 AncestorType:=NewFileDescriptor.ResourceClass;
2138 if AncestorType <> nil then
2139 begin
2140 // loop for Inherited Items
2141 for i:=0 to BaseFormEditor1.StandardDesignerBaseClassesCount - 1 do
2142 if AncestorType.InheritsFrom(BaseFormEditor1.StandardDesignerBaseClasses[i]) then
2143 begin
2144 LFindDesignerBaseClassByName := False;
2145 Break;
2146 end;
2147 if LFindDesignerBaseClassByName then
2148 AncestorType:=FormEditor1.FindDesignerBaseClassByName(AncestorType.ClassName, True);
2149 end;
2150 //DebugLn(['NewFile AncestorType=',dbgsName(AncestorType),' ComponentName',NewUnitInfo.ComponentName]);
2151 if AncestorType<>nil then begin
2152 ResType:=MainBuildBoss.GetResourceType(NewUnitInfo);
2153 LFMSourceText:=NewFileDescriptor.GetResourceSource(NewUnitInfo.ComponentName);
2154 //DebugLn(['NewFile LFMSourceText=',LFMSourceText]);
2155 if LFMSourceText<>'' then begin
2156 // the NewFileDescriptor provides a custom .lfm source
2157 // -> put it into a new .lfm buffer and load it
2158 LFMFilename:=ChangeFileExt(NewUnitInfo.Filename,'.lfm');
2159 LFMCode:=CodeToolBoss.CreateFile(LFMFilename);
2160 LFMCode.Source:=LFMSourceText;
2161 //debugln('NewFile A ',LFMFilename);
2162 Result:=LoadLFM(NewUnitInfo,LFMCode,[],[]);
2163 //DebugLn(['NewFile ',dbgsName(NewUnitInfo.Component),' ',dbgsName(NewUnitInfo.Component.ClassParent)]);
2164 // make sure the .lrs file exists
2165 if (ResType=rtLRS) and NewUnitInfo.IsVirtual then begin
2166 LRSFilename:=ChangeFileExt(NewUnitInfo.Filename,'.lrs');
2167 CodeToolBoss.CreateFile(LRSFilename);
2168 end;
2169 if ((NewUnitInfo.Component is TCustomForm) or (NewUnitInfo.Component is TDataModule))
2170 and NewFileDescriptor.UseCreateFormStatements
2171 and NewUnitInfo.IsPartOfProject
2172 and AProject.AutoCreateForms
2173 and (pfMainUnitHasCreateFormStatements in AProject.Flags) then
2174 begin
2175 AProject.AddCreateFormToProjectFile(NewUnitInfo.Component.ClassName,
2176 NewUnitInfo.Component.Name);
2177 end;
2178 end else begin
2179 // create a designer form for a form/datamodule/frame
2180 //DebugLn(['NewFile Name=',NewFileDescriptor.Name,' Class=',NewFileDescriptor.ClassName]);
2181 DisableAutoSize:=true;
2182 Result := CreateNewForm(NewUnitInfo, AncestorType, nil,
2183 NewFileDescriptor.UseCreateFormStatements,
2184 DisableAutoSize);
2185 if DisableAutoSize and (NewUnitInfo.Component<>nil)
2186 and (NewUnitInfo.Component is TControl) then
2187 begin
2188 // disable autosizing for docked form editor forms, see issue #32207
2189 PreventAutoSize := (IDETabMaster <> nil)
2190 and (NewUnitInfo.Component is TCustomDesignControl)
2191 and IDETabMaster.AutoSizeInShowDesigner(TControl(NewUnitInfo.Component));
2192 if not PreventAutoSize then
2193 TControl(NewUnitInfo.Component).EnableAutoSizing{$IFDEF DebugDisableAutoSizing}('TAnchorDockMaster Delayed'){$ENDIF};
2194 end;
2195 end;
2196 if Result<>mrOk then
2197 begin
2198 debugln(['NewFile create designer form failed ',NewUnitInfo.Filename]);
2199 exit;
2200 end;
2201 end;
2202
2203 // show form and select form
2204 if NewUnitInfo.Component<>nil then begin
2205 // show form
2206 MainIDE.DoShowDesignerFormOfCurrentSrc(False);
2207 end else begin
2208 MainIDE.DisplayState:= dsSource;
2209 end;
2210 end else begin
2211 // do not open in editor
2212 end;
2213
2214 // Update HasResources property (if the .lfm file was created separately)
2215 if (not NewUnitInfo.HasResources)
2216 and FilenameIsPascalUnit(NewUnitInfo.Filename) then begin
2217 //debugln('NewFile no HasResources ',NewUnitInfo.Filename);
2218 LFMFilename:=ChangeFileExt(NewUnitInfo.Filename,'.lfm');
2219 SearchFlags:=[];
2220 if NewUnitInfo.IsPartOfProject then
2221 Include(SearchFlags,pfsfOnlyProjectFiles);
2222 if NewUnitInfo.IsVirtual then
2223 Include(SearchFlags,pfsfOnlyVirtualFiles);
2224 if (AProject.UnitInfoWithFilename(LFMFilename,SearchFlags)<>nil) then begin
2225 //debugln('NewFile no HasResources ',NewUnitInfo.Filename,' ResourceFile exists');
2226 NewUnitInfo.HasResources:=true;
2227 end;
2228 end;
2229
2230 if (nfAskForFilename in NewFlags) then begin
2231 // save and ask for filename
2232 NewUnitInfo.Modified:=true;
2233 Result:=SaveEditorFile(NewSrcEdit,[sfCheckAmbiguousFiles,sfSaveAs]);
2234 if Result<>mrOk then
2235 begin
2236 debugln(['NewFile SaveEditorFile failed ',NewFilename]);
2237 exit;
2238 end;
2239 end else if nfSave in NewFlags then begin
2240 if (nfOpenInEditor in NewFlags) or NewBuffer.IsVirtual then begin
2241 // save and ask for filename if needed
2242 NewUnitInfo.Modified:=true;
2243 Result:=SaveEditorFile(NewSrcEdit,[sfCheckAmbiguousFiles]);
2244 if Result<>mrOk then
2245 begin
2246 debugln(['NewFile SaveEditorFile SaveAs failed ',NewFilename]);
2247 exit;
2248 end;
2249 end else begin
2250 // save quietly
2251 NewBuffer.Save;
2252 end;
2253 end;
2254
2255 Result:=mrOk;
2256 //DebugLn('NewFile END ',NewUnitInfo.Filename);
2257 {$IFDEF IDE_MEM_CHECK}CheckHeapWrtMemCnt('NewUnit end');{$ENDIF}
2258 end;
2259
NewOthernull2260 function NewOther: TModalResult;
2261 var
2262 NewIDEItem: TNewIDEItemTemplate;
2263 NewProjFile: TNewItemProjectFile;
2264 begin
2265 Result:=ShowNewIDEItemDialog(NewIDEItem);
2266 if Result<>mrOk then exit;
2267 if NewIDEItem is TNewItemProjectFile then begin
2268 // file
2269 NewProjFile:=TNewItemProjectFile(NewIDEItem);
2270 if NewProjFile.Descriptor<>nil then
2271 NewProjFile.Descriptor.Owner:=Project1;
2272 try
2273 Result:=MainIDE.DoNewEditorFile(NewProjFile.Descriptor,
2274 '','',[nfOpenInEditor,nfCreateDefaultSrc]);
2275 finally
2276 if NewProjFile.Descriptor<>nil then
2277 NewProjFile.Descriptor.Owner:=nil;
2278 end;
2279 end else if NewIDEItem is TNewItemProject then // project
2280 Result:=MainIDE.DoNewProject(TNewItemProject(NewIDEItem).Descriptor)
2281 else if NewIDEItem is TNewItemPackage then // packages
2282 PkgBoss.DoNewPackage
2283 else
2284 IDEMessageDialog(ueNotImplCap, lisSorryThisTypeIsNotYetImplemented, mtInformation,[mbOk]);
2285 end;
2286
NewUnitOrFormnull2287 function NewUnitOrForm(Template: TNewIDEItemTemplate;
2288 DefaultDesc: TProjectFileDescriptor): TModalResult;
2289 var
2290 Desc: TProjectFileDescriptor;
2291 Flags: TNewFlags;
2292 begin
2293 if (Template is TNewItemProjectFile) and Template.VisibleInNewDialog then
2294 Desc:=TNewItemProjectFile(Template).Descriptor
2295 else
2296 Desc:=DefaultDesc;
2297 Flags:=[nfOpenInEditor,nfCreateDefaultSrc];
2298 if (not Project1.IsVirtual) and EnvironmentOptions.AskForFilenameOnNewFile then
2299 Flags:=Flags+[nfAskForFilename,nfSave];
2300 Desc.Owner:=Project1;
2301 try
2302 Result := MainIDE.DoNewEditorFile(Desc,'','',Flags);
2303 finally
2304 Desc.Owner:=nil;
2305 end;
2306 end;
2307
2308 procedure CreateFileDialogFilterForSourceEditorFiles(Filter: string;
2309 out AllEditorMask, AllMask: string);
2310 // Filter: a TFileDialog filter, e.g. Pascal|*.pas;*.pp|Text|*.txt
2311 // AllEditorExt: a mask for all open files in the source editor, that are not
2312 // in Filter, e.g. '*.txt;*.xml'
2313 // AllFilter: all masks of Filter and AllEditorExt, e.g. '*.pas;*.pp;*.inc'
2314 var
2315 i: Integer;
2316 SrcEdit: TSourceEditor;
2317 Ext: String;
2318 begin
2319 AllMask:='|'+TFileDialog.ExtractAllFilterMasks(Filter);
2320 AllEditorMask:='|';
2321 for i:=0 to SourceEditorManager.SourceEditorCount-1 do begin
2322 SrcEdit:=SourceEditorManager.SourceEditors[i];
2323 Ext:=ExtractFileExt(SrcEdit.FileName);
2324 if Ext<>'' then begin
2325 Ext:='*'+Ext;
2326 if (TFileDialog.FindMaskInFilter(AllMask,Ext)>0)
2327 or (TFileDialog.FindMaskInFilter(AllEditorMask,Ext)>0) then continue;
2328 if AllEditorMask<>'|' then
2329 AllEditorMask:=AllEditorMask+';';
2330 AllEditorMask:=AllEditorMask+Ext;
2331 end;
2332 end;
2333 System.Delete(AllMask,1,1);
2334 System.Delete(AllEditorMask,1,1);
2335 if AllEditorMask<>'' then begin
2336 if AllMask<>'' then
2337 AllMask:=AllMask+';';
2338 AllMask:=AllMask+AllEditorMask;
2339 end;
2340 end;
2341
SaveEditorFilenull2342 function SaveEditorFile(AEditor: TSourceEditorInterface; Flags: TSaveFlags): TModalResult;
2343 var
2344 AnUnitInfo, MainUnitInfo: TUnitInfo;
2345 TestFilename, DestFilename: string;
2346 LRSCode, LFMCode: TCodeBuffer;
2347 OldUnitName, OldFilename: String;
2348 NewUnitName, NewFilename: String;
2349 WasVirtual, WasPascalSource, CanAbort, Confirm: Boolean;
2350 SaveProjectFlags: TSaveFlags;
2351 EMacro: TEditorMacro;
2352 begin
2353 Result:=mrCancel;
2354 CanAbort:=[sfCanAbort,sfProjectSaving]*Flags<>[];
2355 //debugln('SaveEditorFile A PageIndex=',PageIndex,' Flags=',SaveFlagsToString(Flags));
2356 {$IFDEF IDE_MEM_CHECK}CheckHeapWrtMemCnt('SaveEditorFile A');{$ENDIF}
2357 if not (MainIDE.ToolStatus in [itNone,itDebugger]) then
2358 exit(mrAbort);
2359 if AEditor=nil then exit(mrCancel);
2360 AnUnitInfo := Project1.UnitWithEditorComponent(AEditor);
2361 if AnUnitInfo=nil then exit(mrCancel);
2362
2363 // do not save a unit which is currently reverting
2364 if AnUnitInfo.IsReverting then
2365 exit(mrOk);
2366
2367 WasVirtual:=AnUnitInfo.IsVirtual;
2368 WasPascalSource:=FilenameIsPascalSource(AnUnitInfo.Filename);
2369
2370 // if this file is part of a virtual project then save the project first
2371 if (not (sfProjectSaving in Flags)) and Project1.IsVirtual and AnUnitInfo.IsPartOfProject then
2372 begin
2373 SaveProjectFlags:=Flags*[sfSaveToTestDir];
2374 if AnUnitInfo=Project1.MainUnitInfo then
2375 Include(SaveProjectFlags,sfSaveMainSourceAs);
2376 Result:=SaveProject(SaveProjectFlags);
2377 exit;
2378 end;
2379
2380 // update codetools cache and collect Modified flags
2381 if not (sfProjectSaving in Flags) then
2382 SaveEditorChangesToCodeCache(nil);
2383
2384 if (uifInternalFile in AnUnitInfo.Flags) then
2385 begin
2386 if LazStartsStr(EditorMacroVirtualDrive, AnUnitInfo.Filename) then
2387 begin
2388 // save to macros
2389 EMacro := MacroListViewer.MacroByFullName(AnUnitInfo.Filename);
2390 if EMacro <> nil then begin
2391 EMacro.SetFromSource(AEditor.SourceText);
2392 if EMacro.IsInvalid and (EMacro.ErrorMsg <> '') then
2393 IDEMessagesWindow.AddCustomMessage(mluError,EMacro.ErrorMsg);
2394 end;
2395 MacroListViewer.UpdateDisplay;
2396 AnUnitInfo.ClearModifieds;
2397 AEditor.Modified:=false;
2398 end;
2399 // otherwise unknown internal file => skip
2400 exit(mrOk);
2401 end;
2402
2403 // if this is a new unit then a simple Save becomes a SaveAs
2404 if (not (sfSaveToTestDir in Flags)) and (AnUnitInfo.IsVirtual) then
2405 Include(Flags,sfSaveAs);
2406
2407 // if this is the main source and has the same name as the lpi
2408 // rename the project
2409 // Note:
2410 // Changing the main source file without the .lpi is possible only by
2411 // manually editing the lpi file, because this is only needed in
2412 // special cases (rare functions don't need front ends).
2413 MainUnitInfo:=AnUnitInfo.Project.MainUnitInfo;
2414 if (sfSaveAs in Flags) and (not (sfProjectSaving in Flags)) and (AnUnitInfo=MainUnitInfo)
2415 then begin
2416 Result:=SaveProject([sfSaveAs,sfSaveMainSourceAs]);
2417 exit;
2418 end;
2419
2420 // if nothing modified then a simple Save can be skipped
2421 //debugln(['SaveEditorFile A ',AnUnitInfo.Filename,' ',AnUnitInfo.NeedsSaveToDisk]);
2422 if ([sfSaveToTestDir,sfSaveAs]*Flags=[]) and (not AnUnitInfo.NeedsSaveToDisk) then
2423 begin
2424 if AEditor.Modified then
2425 begin
2426 AnUnitInfo.SessionModified:=true;
2427 AEditor.Modified:=false;
2428 end;
2429 exit(mrOk);
2430 end;
2431
2432 // check if file is writable on disk
2433 if (not AnUnitInfo.IsVirtual) and FileExistsUTF8(AnUnitInfo.Filename) then
2434 AnUnitInfo.FileReadOnly:=not FileIsWritable(AnUnitInfo.Filename)
2435 else
2436 AnUnitInfo.FileReadOnly:=false;
2437
2438 // if file is readonly then a simple Save is skipped
2439 if (AnUnitInfo.ReadOnly) and ([sfSaveToTestDir,sfSaveAs]*Flags=[]) then
2440 exit(mrOk);
2441
2442 // load old resource file
2443 LFMCode:=nil;
2444 LRSCode:=nil;
2445 if WasPascalSource then
2446 begin
2447 Result:=LoadResourceFile(AnUnitInfo,LFMCode,LRSCode,true,CanAbort);
2448 if not (Result in [mrIgnore,mrOk]) then
2449 exit;
2450 end;
2451
2452 OldUnitName:='';
2453 if WasPascalSource then
2454 OldUnitName:=AnUnitInfo.ReadUnitNameFromSource(true);
2455 OldFilename:=AnUnitInfo.Filename;
2456
2457 if [sfSaveAs,sfSaveToTestDir]*Flags=[sfSaveAs] then begin
2458 // let user choose a filename
2459 NewFilename:=OldFilename;
2460 Result:=ShowSaveFileAsDialog(NewFilename,AnUnitInfo,LFMCode,LRSCode,CanAbort);
2461 if not (Result in [mrIgnore,mrOk]) then
2462 exit;
2463 end;
2464
2465 // save source
2466
2467 // a) do before save events
2468 if EditorOpts.AutoRemoveEmptyMethods and (AnUnitInfo.Component<>nil) then begin
2469 // Note: When removing published methods, the source, the lfm, the lrs
2470 // and the form must be changed. At the moment editing the lfm without
2471 // the component is not yet implemented.
2472 Result:=RemoveEmptyMethodsInUnit(AnUnitInfo.Source, AnUnitInfo.Component.ClassName,
2473 0,0,[pcsPublished]);
2474 if Result=mrAbort then exit;
2475 end;
2476
2477 // b) do actual save
2478 DestFilename := '';
2479 if (sfSaveToTestDir in Flags) or AnUnitInfo.IsVirtual then
2480 begin
2481 // save source to test directory
2482 TestFilename := MainBuildBoss.GetTestUnitFilename(AnUnitInfo);
2483 if TestFilename <> '' then
2484 begin
2485 DestFilename := TestFilename;
2486 // notify packages
2487 Result:=MainIDEInterface.CallSaveEditorFileHandler(LazarusIDE,AnUnitInfo,
2488 sefsBeforeWrite,DestFilename);
2489 if Result<>mrOk then exit;
2490 // actual write
2491 //DebugLn(['SaveEditorFile TestFilename="',TestFilename,'" Size=',AnUnitInfo.Source.SourceLength]);
2492 Result := AnUnitInfo.WriteUnitSourceToFile(DestFilename);
2493 if Result <> mrOk then
2494 Exit;
2495 // notify packages
2496 Result:=MainIDEInterface.CallSaveEditorFileHandler(LazarusIDE,AnUnitInfo,
2497 sefsAfterWrite,DestFilename);
2498 if Result<>mrOk then exit;
2499 end
2500 else
2501 exit(mrCancel);
2502 end else
2503 begin
2504 if AnUnitInfo.Modified or (MainIDE.CheckFilesOnDiskEnabled and AnUnitInfo.NeedsSaveToDisk) then
2505 begin
2506 // save source to file
2507 DestFilename := AnUnitInfo.Filename;
2508 // notify packages
2509 Result:=MainIDEInterface.CallSaveEditorFileHandler(LazarusIDE,
2510 AnUnitInfo,sefsBeforeWrite,DestFilename);
2511 if Result<>mrOk then exit;
2512 // actual write
2513 Result := AnUnitInfo.WriteUnitSource;
2514 if Result <> mrOK then
2515 exit;
2516 // notify packages
2517 Result:=MainIDEInterface.CallSaveEditorFileHandler(LazarusIDE,
2518 AnUnitInfo,sefsAfterWrite,DestFilename);
2519 if Result<>mrOk then exit;
2520 end;
2521 end;
2522
2523 if sfCheckAmbiguousFiles in Flags then
2524 MainBuildBoss.CheckAmbiguousSources(DestFilename,false);
2525
2526 {$IFDEF IDE_DEBUG}
2527 debugln(['*** HasResources=',AnUnitInfo.HasResources]);
2528 {$ENDIF}
2529 {$IFDEF IDE_MEM_CHECK}CheckHeapWrtMemCnt('SaveEditorFile B');{$ENDIF}
2530 // save resource file and lfm file
2531 if (LRSCode<>nil) or (AnUnitInfo.Component<>nil) then begin
2532 Result:=SaveUnitComponent(AnUnitInfo,LRSCode,LFMCode,Flags);
2533 if not (Result in [mrIgnore, mrOk]) then
2534 exit;
2535 end;
2536
2537 // unset all modified flags
2538 if not (sfSaveToTestDir in Flags) then begin
2539 AnUnitInfo.ClearModifieds;
2540 AEditor.Modified:=false;
2541 MainIDE.UpdateSaveMenuItemsAndButtons(not (sfProjectSaving in Flags));
2542 end;
2543 TSourceEditor(AEditor).SourceNotebook.UpdateStatusBar;
2544
2545 // fix all references
2546 NewUnitName:='';
2547 if FilenameIsPascalSource(AnUnitInfo.Filename) then
2548 NewUnitName:=AnUnitInfo.ReadUnitNameFromSource(true);
2549 NewFilename:=AnUnitInfo.Filename;
2550 if (NewUnitName<>'')
2551 and ((OldUnitName<>NewUnitName) or (CompareFilenames(OldFilename,NewFilename)<>0))
2552 then begin
2553 if EnvironmentOptions.UnitRenameReferencesAction<>urraNever then
2554 begin
2555 // silently update references of new units (references were auto created
2556 // and keeping old references makes no sense)
2557 Confirm:=(EnvironmentOptions.UnitRenameReferencesAction=urraAsk)
2558 and (not WasVirtual);
2559 Result:=ReplaceUnitUse(OldFilename,OldUnitName,NewFilename,NewUnitName,
2560 true,true,Confirm);
2561 if Result<>mrOk then exit;
2562 end;
2563 end;
2564
2565 {$IFDEF IDE_VERBOSE}
2566 debugln(['SaveEditorFile END ',NewFilename,' AnUnitInfo.Modified=',AnUnitInfo.Modified,' AEditor.Modified=',AEditor.Modified]);
2567 {$ENDIF}
2568 Result:=mrOk;
2569 end;
2570
2571 function SaveEditorFile(const Filename: string; Flags: TSaveFlags): TModalResult;
2572 var
2573 UnitIndex: Integer;
2574 AnUnitInfo: TUnitInfo;
2575 i: Integer;
2576 begin
2577 Result:=mrOk;
2578 if Filename='' then exit;
2579 UnitIndex:=Project1.IndexOfFilename(TrimFilename(Filename),[pfsfOnlyEditorFiles]);
2580 if UnitIndex<0 then exit;
2581 AnUnitInfo:=Project1.Units[UnitIndex];
2582 for i := 0 to AnUnitInfo.OpenEditorInfoCount-1 do begin
2583 Result:=SaveEditorFile(AnUnitInfo.OpenEditorInfo[i].EditorComponent, Flags);
2584 if Result <> mrOK then Break;
2585 Flags:=Flags-[sfSaveAs,sfCheckAmbiguousFiles];
2586 end;
2587 end;
2588
2589 function CloseEditorFile(AEditor: TSourceEditorInterface; Flags: TCloseFlags): TModalResult;
2590 var
2591 AnUnitInfo: TUnitInfo;
2592 ACaption, AText: string;
2593 i: integer;
2594 AnEditorInfo: TUnitEditorInfo;
2595 SrcEditWasFocused: Boolean;
2596 SrcEdit: TSourceEditor;
2597 begin
2598 {$IFDEF IDE_DEBUG}
2599 //debugln('CloseEditorFile A PageIndex=',IntToStr(AnUnitInfo.PageIndex));
2600 {$ENDIF}
2601 Result:=mrCancel;
2602 if AEditor = nil then exit;
2603 AnEditorInfo := Project1.EditorInfoWithEditorComponent(AEditor);
2604 //AnUnitInfo := Project1.UnitWithEditorComponent(AEditor);
2605 if AnEditorInfo = nil then begin
2606 // we need to close the page anyway or else we might enter a loop
2607 DebugLn('CloseEditorFile INCONSISTENCY: NO AnUnitInfo');
2608 SourceEditorManager.CloseFile(AEditor);
2609 Result:=mrOk;
2610 exit;
2611 end;
2612 AnUnitInfo := AnEditorInfo.UnitInfo;
2613 AnUnitInfo.SessionModified:=true;
2614 SrcEditWasFocused:=(AnEditorInfo.EditorComponent<>nil)
2615 and (AnEditorInfo.EditorComponent.EditorControl<>nil)
2616 and AnEditorInfo.EditorComponent.EditorControl.Focused;
2617 //debugln(['CloseEditorFile File=',AnUnitInfo.Filename,' WasFocused=',SrcEditWasFocused]);
2618 try
2619 //debugln(['CloseEditorFile File=',AnUnitInfo.Filename,' UnitSession=',AnUnitInfo.SessionModified,' ProjSession=',project1.SessionModified]);
2620 if AnUnitInfo.OpenEditorInfoCount > 1 then begin
2621 // opened multiple times => close one instance
2622 SourceEditorManager.CloseFile(AEditor);
2623 Result:=mrOk;
2624 exit;
2625 end;
2626
2627 if (AnUnitInfo.Component<>nil) and (MainIDE.LastFormActivated<>nil)
2628 and (MainIDE.LastFormActivated.Designer.LookupRoot=AnUnitInfo.Component) then
2629 MainIDE.LastFormActivated:=nil;
2630
2631 // save some meta data of the source
2632 SaveSrcEditorProjectSpecificSettings(AnEditorInfo);
2633
2634 // if SaveFirst then save the source
2635 if (cfSaveFirst in Flags) and (not AnUnitInfo.ReadOnly)
2636 and ((AEditor.Modified) or (AnUnitInfo.Modified)) then begin
2637 if not (cfQuiet in Flags) then begin
2638 // ask user
2639 if AnUnitInfo.Filename<>'' then
2640 AText:=Format(lisFileHasChangedSave, [AnUnitInfo.Filename])
2641 else if AnUnitInfo.Unit_Name<>'' then
2642 AText:=Format(lisUnitHasChangedSave, [AnUnitInfo.Unit_Name])
2643 else
2644 AText:=Format(lisSourceOfPageHasChangedSave, [TSourceEditor(AEditor).PageName]);
2645 ACaption:=lisSourceModified;
2646 Result:=IDEQuestionDialog(ACaption, AText,
2647 mtConfirmation, [mrYes, lisMenuSave,
2648 mrNo, lisDiscardChanges,
2649 mrAbort]);
2650 end else
2651 Result:=mrYes;
2652 if Result=mrYes then begin
2653 Result:=SaveEditorFile(AnEditorInfo.EditorComponent,[sfCheckAmbiguousFiles]);
2654 end;
2655 if Result in [mrAbort,mrCancel] then exit;
2656 Result:=mrOk;
2657 end;
2658 // mark file as unmodified
2659 if (AnUnitInfo.Source<>nil) and AnUnitInfo.Source.Modified then
2660 AnUnitInfo.Source.Clear;
2661
2662 // add to recent file list
2663 if (not AnUnitInfo.IsVirtual) and (not (cfProjectClosing in Flags)) then
2664 begin
2665 EnvironmentOptions.AddToRecentOpenFiles(AnUnitInfo.Filename);
2666 MainIDE.SetRecentFilesMenu;
2667 end;
2668
2669 // close form soft (keep it if used by another component)
2670 CloseUnitComponent(AnUnitInfo,[]);
2671
2672 // close source editor
2673 SourceEditorManager.CloseFile(AnEditorInfo.EditorComponent);
2674 MainIDEBar.itmFileClose.Enabled:=SourceEditorManager.SourceEditorCount > 0;
2675 MainIDEBar.itmFileCloseAll.Enabled:=MainIDEBar.itmFileClose.Enabled;
2676
2677 // free sources, forget changes
2678 if (AnUnitInfo.Source<>nil) then begin
2679 if (Project1.MainUnitInfo=AnUnitInfo)
2680 and (not (cfProjectClosing in Flags)) then begin
2681 AnUnitInfo.Source.Revert;
2682 end else begin
2683 AnUnitInfo.Source.IsDeleted:=true;
2684 end;
2685 end;
2686
2687 // close file in project
2688 AnUnitInfo.Loaded:=false;
2689 if AnUnitInfo<>Project1.MainUnitInfo then
2690 AnUnitInfo.Source:=nil;
2691 if not (cfProjectClosing in Flags) then begin
2692 i:=Project1.IndexOf(AnUnitInfo);
2693 if (i<>Project1.MainUnitID) and AnUnitInfo.IsVirtual then begin
2694 Project1.RemoveUnit(i);
2695 end;
2696 end;
2697
2698 finally
2699 if SrcEditWasFocused then begin
2700 // before closing the syendit was focused. Focus the current synedit.
2701 SrcEdit := SourceEditorManager.ActiveEditor;
2702 if (SrcEdit<>nil)
2703 and (SrcEdit.EditorControl<>nil)
2704 and (SrcEdit.EditorControl.CanFocus) then
2705 SrcEdit.EditorControl.SetFocus;
2706 //debugln(['CloseEditorFile Focus=',SrcEdit.FileName,' Editor=',DbgSName(SrcEdit.EditorControl),' Focused=',(SrcEdit.EditorControl<>nil) and (SrcEdit.EditorControl.Focused)]);
2707 end;
2708 end;
2709 {$IFDEF IDE_DEBUG}
2710 DebugLn('CloseEditorFile end');
2711 {$ENDIF}
2712 Result:=mrOk;
2713 end;
2714
2715 function CloseEditorFile(const Filename: string; Flags: TCloseFlags): TModalResult;
2716 var
2717 UnitIndex: Integer;
2718 AnUnitInfo: TUnitInfo;
2719 begin
2720 Result:=mrOk;
2721 if Filename='' then exit;
2722 UnitIndex:=Project1.IndexOfFilename(TrimFilename(Filename),[pfsfOnlyEditorFiles]);
2723 if UnitIndex<0 then exit;
2724 AnUnitInfo:=Project1.Units[UnitIndex];
2725 while (AnUnitInfo.OpenEditorInfoCount > 0) and (Result = mrOK) do
2726 Result:=CloseEditorFile(AnUnitInfo.OpenEditorInfo[0].EditorComponent, Flags);
2727 end;
2728
2729 function FindUnitFileImpl(const AFilename: string; TheOwner: TObject;
2730 Flags: TFindUnitFileFlags): string;
2731
2732 function FindInBaseIDE: string;
2733 var
2734 AnUnitName: String;
2735 BaseDir: String;
2736 UnitInFilename: String;
2737 begin
2738 AnUnitName:=ExtractFileNameOnly(AFilename);
2739 BaseDir:=EnvironmentOptions.GetParsedLazarusDirectory+PathDelim+'ide';
2740 UnitInFilename:='';
2741 Result:=CodeToolBoss.DirectoryCachePool.FindUnitSourceInCompletePath(
2742 BaseDir,AnUnitName,UnitInFilename,true);
2743 end;
2744
2745 function FindInProject(AProject: TProject): string;
2746 var
2747 AnUnitInfo: TUnitInfo;
2748 AnUnitName: String;
2749 BaseDir: String;
2750 UnitInFilename: String;
2751 begin
2752 // search in virtual (unsaved) files
2753 AnUnitInfo:=AProject.UnitInfoWithFilename(AFilename,
2754 [pfsfOnlyProjectFiles,pfsfOnlyVirtualFiles]);
2755 if AnUnitInfo<>nil then begin
2756 Result:=AnUnitInfo.Filename;
2757 exit;
2758 end;
2759
2760 // search in search path of project
2761 AnUnitName:=ExtractFileNameOnly(AFilename);
2762 BaseDir:=AProject.Directory;
2763 UnitInFilename:='';
2764 Result:=CodeToolBoss.DirectoryCachePool.FindUnitSourceInCompletePath(
2765 BaseDir,AnUnitName,UnitInFilename,true);
2766 end;
2767
2768 function FindInPackage(APackage: TLazPackage): string;
2769 var
2770 BaseDir: String;
2771 AnUnitName: String;
2772 UnitInFilename: String;
2773 begin
2774 Result:='';
2775 BaseDir:=APackage.Directory;
2776 if not FilenameIsAbsolute(BaseDir) then exit;
2777 // search in search path of package
2778 AnUnitName:=ExtractFileNameOnly(AFilename);
2779 UnitInFilename:='';
2780 Result:=CodeToolBoss.DirectoryCachePool.FindUnitSourceInCompletePath(
2781 BaseDir,AnUnitName,UnitInFilename,true);
2782 end;
2783
2784 var
2785 AProject: TProject;
2786 i: Integer;
2787 begin
2788 if FilenameIsAbsolute(AFilename) then begin
2789 Result:=AFilename;
2790 exit;
2791 end;
2792 Result:='';
2793
2794 // project
2795 AProject:=nil;
2796 if TheOwner=nil then begin
2797 AProject:=Project1;
2798 end else if (TheOwner is TProject) then
2799 AProject:=TProject(TheOwner);
2800
2801 if AProject<>nil then
2802 begin
2803 Result:=FindInProject(AProject);
2804 if Result<>'' then exit;
2805 end;
2806
2807 // package
2808 if TheOwner is TLazPackage then begin
2809 Result:=FindInPackage(TLazPackage(TheOwner));
2810 if Result<>'' then exit;
2811 end;
2812
2813 if TheOwner=LazarusIDE then begin
2814 // search in base IDE
2815 Result:=FindInBaseIDE;
2816 if Result<>'' then exit;
2817
2818 // search in installed packages
2819 for i:=0 to PackageGraph.Count-1 do
2820 if (PackageGraph[i].Installed<>pitNope)
2821 and ((not (fuffIgnoreUninstallPackages in Flags))
2822 or (PackageGraph[i].AutoInstall<>pitNope))
2823 then begin
2824 Result:=FindInPackage(PackageGraph[i]);
2825 if Result<>'' then exit;
2826 end;
2827 // search in auto install packages
2828 for i:=0 to PackageGraph.Count-1 do
2829 if (PackageGraph[i].Installed=pitNope)
2830 and (PackageGraph[i].AutoInstall<>pitNope) then begin
2831 Result:=FindInPackage(PackageGraph[i]);
2832 if Result<>'' then exit;
2833 end;
2834 // then search in all other open packages
2835 for i:=0 to PackageGraph.Count-1 do
2836 if (PackageGraph[i].Installed=pitNope)
2837 and (PackageGraph[i].AutoInstall=pitNope) then begin
2838 Result:=FindInPackage(PackageGraph[i]);
2839 if Result<>'' then exit;
2840 end;
2841 end;
2842 Result:='';
2843 end;
2844
2845 function FindSourceFileImpl(const AFilename, BaseDirectory: string;
2846 Flags: TFindSourceFlags): string;
2847 // AFilename can be an absolute or relative filename, of a source file or a
2848 // compiled unit (.ppu).
2849 // Find the source filename (pascal source or include file) and returns
2850 // the absolute path.
2851 // With fsfMapTempToVirtualFiles files in the temp directory are stripped off
2852 // the temporary files resulting in the virtual file name of the CodeTools.
2853 //
2854 // First it searches in the current projects src path, then its unit path, then
2855 // its include path. Then all used package source directories are searched.
2856 // Finally the fpc sources are searched.
2857 var
2858 CompiledSrcExt: String;
2859 BaseDir: String;
2860 AlreadySearchedPaths: string;
2861 StartUnitPath: String;
2862
2863 procedure MarkPathAsSearched(const AddSearchPath: string);
2864 begin
2865 AlreadySearchedPaths:=MergeSearchPaths(AlreadySearchedPaths,AddSearchPath);
2866 end;
2867
2868 function SearchIndirectIncludeFile: string;
2869 var
2870 UnitPath: String;
2871 CurDir: String;
2872 AlreadySearchedUnitDirs: String;
2873 CompiledUnitPath: String;
2874 AllSrcPaths: String;
2875 CurSrcPath: String;
2876 CurIncPath: String;
2877 PathPos: Integer;
2878 AllIncPaths: String;
2879 SearchPath: String;
2880 SearchFile: String;
2881 begin
2882 if CompiledSrcExt='' then exit('');
2883 // get unit path for compiled units
2884 UnitPath:=BaseDir+';'+StartUnitPath;
2885 UnitPath:=TrimSearchPath(UnitPath,BaseDir);
2886
2887 // Extract all directories with compiled units
2888 CompiledUnitPath:='';
2889 AlreadySearchedUnitDirs:='';
2890 PathPos:=1;
2891 while PathPos<=length(UnitPath) do begin
2892 CurDir:=GetNextDirectoryInSearchPath(UnitPath,PathPos);
2893 // check if directory is already tested
2894 if SearchDirectoryInSearchPath(AlreadySearchedUnitDirs,CurDir,1)>0 then
2895 continue;
2896 AlreadySearchedUnitDirs:=MergeSearchPaths(AlreadySearchedUnitDirs,CurDir);
2897 // check if directory contains a compiled unit
2898 if FindFirstFileWithExt(CurDir,CompiledSrcExt)<>'' then
2899 CompiledUnitPath:=CompiledUnitPath+';'+CurDir;
2900 end;
2901 {$IFDEF VerboseFindSourceFile}
2902 debugln(['SearchIndirectIncludeFile CompiledUnitPath="',CompiledUnitPath,'"']);
2903 {$ENDIF}
2904
2905 // collect all src paths for the compiled units
2906 AllSrcPaths:=CompiledUnitPath;
2907 PathPos:=1;
2908 while PathPos<=length(CompiledUnitPath) do begin
2909 CurDir:=GetNextDirectoryInSearchPath(CompiledUnitPath,PathPos);
2910 CurSrcPath:=CodeToolBoss.GetCompiledSrcPathForDirectory(CurDir);
2911 CurSrcPath:=TrimSearchPath(CurSrcPath,CurDir);
2912 AllSrcPaths:=MergeSearchPaths(AllSrcPaths,CurSrcPath);
2913 end;
2914 {$IFDEF VerboseFindSourceFile}
2915 debugln(['SearchIndirectIncludeFile AllSrcPaths="',AllSrcPaths,'"']);
2916 {$ENDIF}
2917
2918 // add fpc src directories
2919 // ToDo
2920
2921 // collect all include paths
2922 AllIncPaths:=AllSrcPaths;
2923 PathPos:=1;
2924 while PathPos<=length(AllSrcPaths) do begin
2925 CurDir:=GetNextDirectoryInSearchPath(AllSrcPaths,PathPos);
2926 CurIncPath:=CodeToolBoss.GetIncludePathForDirectory(CurDir);
2927 CurIncPath:=TrimSearchPath(CurIncPath,CurDir);
2928 AllIncPaths:=MergeSearchPaths(AllIncPaths,CurIncPath);
2929 end;
2930 {$IFDEF VerboseFindSourceFile}
2931 debugln(['SearchIndirectIncludeFile AllIncPaths="',AllIncPaths,'"']);
2932 {$ENDIF}
2933
2934 SearchFile:=AFilename;
2935 SearchPath:=AllIncPaths;
2936 Result:=FileUtil.SearchFileInPath(SearchFile,BaseDir,SearchPath,';',[]);
2937 {$IFDEF VerboseFindSourceFile}
2938 debugln(['SearchIndirectIncludeFile Result="',Result,'"']);
2939 {$ENDIF}
2940 MarkPathAsSearched(SearchPath);
2941 end;
2942
2943 function SearchInPath(const TheSearchPath, SearchFile: string;
2944 var Filename: string): boolean;
2945 var
2946 SearchPath: String;
2947 begin
2948 Filename:='';
2949 SearchPath:=RemoveSearchPaths(TheSearchPath,AlreadySearchedPaths);
2950 if SearchPath<>'' then begin
2951 Filename:=FileUtil.SearchFileInPath(SearchFile,BaseDir,SearchPath,';',[]);
2952 {$IFDEF VerboseFindSourceFile}
2953 debugln(['FindSourceFile trying "',SearchPath,'" Filename="',Filename,'"']);
2954 {$ENDIF}
2955 MarkPathAsSearched(SearchPath);
2956 end;
2957 Result:=Filename<>'';
2958 end;
2959
2960 var
2961 SearchPath: String;
2962 SearchFile: String;
2963 ProjFile: TLazProjectFile;
2964 begin
2965 {$IFDEF VerboseFindSourceFile}
2966 debugln(['FindSourceFile Filename="',AFilename,'" BaseDirectory="',BaseDirectory,'"']);
2967 {$ENDIF}
2968 if AFilename='' then exit('');
2969
2970 if fsfMapTempToVirtualFiles in Flags then
2971 begin
2972 BaseDir:=MainBuildBoss.GetTestBuildDirectory;
2973 if FilenameIsAbsolute(AFilename)
2974 and FileIsInPath(AFilename,BaseDir) then
2975 begin
2976 Result:=CreateRelativePath(AFilename,BaseDir);
2977 if (Project1<>nil) and (Project1.UnitInfoWithFilename(Result)<>nil) then
2978 exit;
2979 end;
2980 end;
2981
2982 if FilenameIsAbsolute(AFilename) then
2983 begin
2984 Result := AFilename;
2985 if not FileExistsCached(Result) then
2986 Result := '';
2987 Exit;
2988 end;
2989
2990 AlreadySearchedPaths:='';
2991 BaseDir:=BaseDirectory;
2992 GlobalMacroList.SubstituteStr(BaseDir);
2993 BaseDir:=AppendPathDelim(TrimFilename(BaseDir));
2994
2995 // search file in base directory
2996 if FilenameIsAbsolute(BaseDir) then begin
2997 Result:=TrimFilename(BaseDir+AFilename);
2998 {$IFDEF VerboseFindSourceFile}
2999 debugln(['FindSourceFile trying Base "',Result,'"']);
3000 {$ENDIF}
3001 if FileExistsCached(Result) then exit;
3002 MarkPathAsSearched(BaseDir);
3003 end else if Project1<>nil then begin
3004 // search in virtual files
3005 Result:=TrimFilename(BaseDir+AFilename);
3006 ProjFile:=Project1.FindFile(Result,[pfsfOnlyVirtualFiles]);
3007 if ProjFile<>nil then
3008 exit;
3009 end;
3010
3011 // search file in debug path
3012 if (fsfUseDebugPath in Flags) and (Project1<>nil) then begin
3013 SearchPath:=EnvironmentOptions.GetParsedDebuggerSearchPath;
3014 SearchPath:=MergeSearchPaths(Project1.CompilerOptions.GetDebugPath(false),
3015 SearchPath);
3016 SearchPath:=TrimSearchPath(SearchPath,BaseDir);
3017 if SearchInPath(SearchPath,AFilename,Result) then exit;
3018 end;
3019
3020 CompiledSrcExt:=CodeToolBoss.GetCompiledSrcExtForDirectory(BaseDir);
3021 StartUnitPath:=CodeToolBoss.GetCompleteSrcPathForDirectory(BaseDir);
3022 StartUnitPath:=TrimSearchPath(StartUnitPath,BaseDir);
3023
3024 // if file is a pascal unit, search via unit and src paths
3025 if FilenameIsPascalUnit(AFilename) then begin
3026 // first search file in unit path
3027 if SearchInPath(StartUnitPath,AFilename,Result) then exit;
3028
3029 // search unit in fpc source directory
3030 Result:=CodeToolBoss.FindUnitInUnitSet(BaseDir,
3031 ExtractFilenameOnly(AFilename));
3032 {$IFDEF VerboseFindSourceFile}
3033 debugln(['FindSourceFile tried unitset Result=',Result]);
3034 {$ENDIF}
3035 if Result<>'' then exit;
3036 end;
3037
3038 if fsfUseIncludePaths in Flags then begin
3039 // search in include path
3040 if (fsfSearchForProject in Flags) then
3041 SearchPath:=Project1.CompilerOptions.GetIncludePath(false)
3042 else
3043 SearchPath:=CodeToolBoss.GetIncludePathForDirectory(BaseDir);
3044 SearchPath:=TrimSearchPath(SearchPath,BaseDir);
3045 if SearchInPath(StartUnitPath,AFilename,Result) then exit;
3046
3047 if not(fsfSkipPackages in Flags) then begin
3048 // search include file in source directories of all required packages
3049 SearchFile:=AFilename;
3050 Result:=PkgBoss.FindIncludeFileInProjectDependencies(Project1,SearchFile);
3051 {$IFDEF VerboseFindSourceFile}
3052 debugln(['FindSourceFile trying packages "',SearchPath,'" Result=',Result]);
3053 {$ENDIF}
3054 end;
3055 if Result<>'' then exit;
3056
3057 Result:=SearchIndirectIncludeFile;
3058 if Result<>'' then exit;
3059 end;
3060
3061 Result:='';
3062 end;
3063
3064 function FindUnitsOfOwnerImpl(TheOwner: TObject; Flags: TFindUnitsOfOwnerFlags): TStrings;
3065 var
3066 Files: TFilenameToStringTree;
3067 UnitPath: string; // only if not AddPackages:
3068 // owner unitpath without unitpaths of required packages
3069
3070 function Add(const aFilename: string): boolean;
3071 begin
3072 if Files.Contains(aFilename) then exit(false);
3073 //debugln([' Add ',aFilename]);
3074 Files[aFilename]:='';
3075 FindUnitsOfOwnerImpl.Add(aFilename);
3076 Result := True;
3077 end;
3078
3079 procedure AddListedPackageUnits(aPackage: TLazPackage);
3080 // add listed units of aPackage
3081 var
3082 i: Integer;
3083 PkgFile: TPkgFile;
3084 begin
3085 //debugln([' AddListedPackageUnits ',aPackage.IDAsString]);
3086 for i:=0 to aPackage.FileCount-1 do
3087 begin
3088 PkgFile:=aPackage.Files[i];
3089 if not (PkgFile.FileType in PkgFileRealUnitTypes) then continue;
3090 if not PkgFile.InUses then continue;
3091 Add(PkgFile.Filename);
3092 end;
3093 end;
3094
3095 procedure AddUsedUnit(const aFilename: string);
3096 // add recursively all units
3097
3098 procedure AddUses(UsesSection: TStrings);
3099 var
3100 i: Integer;
3101 Code: TCodeBuffer;
3102 begin
3103 if UsesSection=nil then exit;
3104 for i:=0 to UsesSection.Count-1 do begin
3105 //debugln(['AddUses ',UsesSection[i]]);
3106 Code:=TCodeBuffer(UsesSection.Objects[i]);
3107 if Code=nil then exit;
3108 AddUsedUnit(Code.Filename);
3109 end;
3110 end;
3111
3112 var
3113 Code: TCodeBuffer;
3114 MainUsesSection, ImplementationUsesSection: TStrings;
3115 begin
3116 //debugln([' AddUsedUnit START ',aFilename]);
3117 if not (fuooPackages in Flags) then
3118 begin
3119 if FilenameIsAbsolute(aFilename) then
3120 begin
3121 if SearchDirectoryInSearchPath(UnitPath,ExtractFilePath(aFilename))<0 then
3122 exit; // not in exclusive unitpath
3123 end else begin
3124 if (not (TheOwner is TProject)) or (not TProject(TheOwner).IsVirtual) then
3125 exit;
3126 end;
3127 end;
3128 //debugln([' AddUsedUnit OK ',aFilename]);
3129 if not Add(aFilename) then exit;
3130 Code:=CodeToolBoss.LoadFile(aFilename,true,false);
3131 if Code=nil then exit;
3132 MainUsesSection:=nil;
3133 ImplementationUsesSection:=nil;
3134 try
3135 CodeToolBoss.FindUsedUnitFiles(Code,MainUsesSection,ImplementationUsesSection);
3136 AddUses(MainUsesSection);
3137 AddUses(ImplementationUsesSection);
3138 finally
3139 MainUsesSection.Free;
3140 ImplementationUsesSection.Free;
3141 end;
3142 end;
3143
3144 var
3145 aProject: TProject;
3146 aPackage, ReqPackage: TLazPackage;
3147 MainFile, CurFilename: String;
3148 AnUnitInfo: TUnitInfo;
3149 i: Integer;
3150 Code: TCodeBuffer;
3151 FoundInUnits, MissingUnits, NormalUnits: TStrings;
3152 PkgList: TFPList;
3153 PkgListFlags: TPkgIntfRequiredFlags;
3154 begin
3155 Result:=TStringList.Create;
3156 MainFile:='';
3157 FoundInUnits:=nil;
3158 MissingUnits:=nil;
3159 NormalUnits:=nil;
3160 aProject:=nil;
3161 aPackage:=nil;
3162 PkgList:=nil;
3163 Files:=TFilenameToStringTree.Create(false);
3164 try
3165 //debugln(['FindUnitsOfOwner ',DbgSName(TheOwner)]);
3166 if TheOwner is TProject then
3167 begin
3168 aProject:=TProject(TheOwner);
3169 // add main project source (e.g. .lpr)
3170 if (aProject.MainFile<>nil) and (pfMainUnitIsPascalSource in aProject.Flags)
3171 then begin
3172 MainFile:=aProject.MainFile.Filename;
3173 Add(MainFile);
3174 end;
3175 if (fuooListed in Flags) then begin
3176 // add listed units (i.e. units in project inspector)
3177 AnUnitInfo:=aProject.FirstPartOfProject;
3178 while AnUnitInfo<>nil do
3179 begin
3180 if FilenameIsPascalUnit(AnUnitInfo.Filename) then
3181 Add(AnUnitInfo.Filename);
3182 AnUnitInfo:=AnUnitInfo.NextPartOfProject;
3183 end;
3184 end;
3185 if (fuooListed in Flags) and (fuooPackages in Flags) then
3186 begin
3187 // get required packages
3188 if pfUseDesignTimePackages in aProject.Flags then
3189 PkgListFlags:=[]
3190 else
3191 PkgListFlags:=[pirSkipDesignTimeOnly];
3192 PackageGraph.GetAllRequiredPackages(nil,aProject.FirstRequiredDependency,
3193 PkgList,PkgListFlags);
3194 end;
3195 end else if TheOwner is TLazPackage then begin
3196 aPackage:=TLazPackage(TheOwner);
3197 if (fuooListed in Flags) then
3198 begin
3199 // add listed units (i.e. units in package editor)
3200 AddListedPackageUnits(aPackage);
3201 end;
3202 if (fuooUsed in Flags) then
3203 MainFile:=aPackage.GetSrcFilename;
3204 if (fuooListed in Flags) and (fuooPackages in Flags) then
3205 begin
3206 // get required packages
3207 PackageGraph.GetAllRequiredPackages(aPackage,nil,PkgList,[]);
3208 end;
3209 end else begin
3210 FreeAndNil(Result);
3211 raise Exception.Create('FindUnitsOfOwner: invalid owner '+DbgSName(TheOwner));
3212 end;
3213
3214 if (fuooListed in Flags) and (fuooPackages in Flags) and (PkgList<>nil) then begin
3215 // add package units (listed in their package editors)
3216 for i:=0 to PkgList.Count-1 do begin
3217 ReqPackage:=TLazPackage(PkgList[i]);
3218 AddListedPackageUnits(ReqPackage);
3219 end;
3220 end;
3221
3222 if (fuooUsed in Flags) and (MainFile<>'') then
3223 begin
3224 // add all used units with 'in' files
3225 Code:=CodeToolBoss.LoadFile(MainFile,true,false);
3226 if Code<>nil then begin
3227 UnitPath:='';
3228 if aProject<>nil then begin
3229 CodeToolBoss.FindDelphiProjectUnits(Code,FoundInUnits,MissingUnits,NormalUnits);
3230 if not (fuooPackages in Flags) then
3231 begin
3232 // only project units wanted -> create unitpath excluding unitpaths from packages
3233 // Note: even if the project contains an unitpath to the source
3234 // folder of a package, the units are not project units.
3235 UnitPath:=aProject.CompilerOptions.GetUnitPath(false);
3236 RemoveSearchPaths(UnitPath,aProject.CompilerOptions.GetInheritedOption(icoUnitPath,false));
3237 end;
3238 end
3239 else if aPackage<>nil then begin
3240 CodeToolBoss.FindDelphiPackageUnits(Code,FoundInUnits,MissingUnits,NormalUnits);
3241 if not (fuooPackages in Flags) then
3242 begin
3243 // only units of this package wanted
3244 // -> create unitpath excluding unitpaths from used packages
3245 // Note: even if the package contains an unitpath to the source
3246 // folder of a sub package, the units belong to the sub package
3247 UnitPath:=aPackage.CompilerOptions.GetUnitPath(false);
3248 RemoveSearchPaths(UnitPath,aPackage.CompilerOptions.GetInheritedOption(icoUnitPath,false));
3249 end;
3250 end;
3251 //debugln(['FindUnitsOfOwner UnitPath="',UnitPath,'"']);
3252 if FoundInUnits<>nil then
3253 for i:=0 to FoundInUnits.Count-1 do
3254 begin
3255 CurFilename:=TCodeBuffer(FoundInUnits.Objects[i]).Filename;
3256 Add(CurFilename); // units with 'in' filename always belong to the
3257 // project, that's the Delphi way
3258 AddUsedUnit(CurFilename);
3259 end;
3260 if NormalUnits<>nil then
3261 for i:=0 to NormalUnits.Count-1 do
3262 AddUsedUnit(TCodeBuffer(NormalUnits.Objects[i]).Filename);
3263 end;
3264 end;
3265 if (fuooSourceEditor in Flags) then
3266 for i := 0 to pred(SourceEditorManager.SourceEditorCount) do
3267 begin
3268 CurFilename := SourceEditorManager.SourceEditors[i].FileName;
3269 if FilenameIsPascalUnit(CurFilename) then
3270 Add(CurFilename);
3271 end;
3272 finally
3273 FoundInUnits.Free;
3274 MissingUnits.Free;
3275 NormalUnits.Free;
3276 PkgList.Free;
3277 Files.Free;
3278 end;
3279 end;
3280
SelectProjectItemsnull3281 function SelectProjectItems(ItemList: TViewUnitEntries; ItemType: TIDEProjectItem): TModalResult;
3282 var
3283 i: integer;
3284 AUnitName, DlgCaption: string;
3285 MainUnitInfo: TUnitInfo;
3286 ActiveSourceEditor: TSourceEditor;
3287 ActiveUnitInfo: TUnitInfo;
3288 CurUnitInfo: TUnitInfo;
3289 LFMFilename: String;
3290 LFMType: String;
3291 LFMComponentName: String;
3292 LFMClassName: String;
3293 anUnitName: String;
3294 LFMCode: TCodeBuffer;
3295 begin
3296 if Project1=nil then exit(mrCancel);
3297 MainIDE.GetCurrentUnit(ActiveSourceEditor, ActiveUnitInfo);
3298 for i := 0 to Project1.UnitCount - 1 do
3299 begin
3300 CurUnitInfo:=Project1.Units[i];
3301 if not CurUnitInfo.IsPartOfProject then
3302 Continue;
3303 if ItemType in [piComponent, piFrame] then
3304 begin
3305 // add all form names of project
3306 if CurUnitInfo.ComponentName <> '' then
3307 begin
3308 if (ItemType = piComponent) or
3309 ((ItemType = piFrame) and (CurUnitInfo.ResourceBaseClass = pfcbcFrame)) then
3310 ItemList.Add(CurUnitInfo.ComponentName,
3311 CurUnitInfo.Filename, i, CurUnitInfo = ActiveUnitInfo);
3312 end else if FilenameIsAbsolute(CurUnitInfo.Filename)
3313 and FilenameIsPascalSource(CurUnitInfo.Filename)
3314 and FileExistsCached(CurUnitInfo.Filename) then
3315 begin
3316 // this unit has a lfm, but the lpi does not know a ComponentName
3317 // => maybe this component was added without the IDE
3318 LFMFilename:=ChangeFileExt(CurUnitInfo.Filename,'.lfm');
3319 LFMCode:=CodeToolBoss.LoadFile(LFMFilename,true,false);
3320 if LFMCode<>nil then
3321 begin
3322 ReadLFMHeader(LFMCode.Source,LFMType,LFMComponentName,LFMClassName);
3323 if LFMComponentName<>'' then begin
3324 anUnitName:=CurUnitInfo.Unit_Name;
3325 if anUnitName='' then
3326 anUnitName:=ExtractFileNameOnly(LFMFilename);
3327 ItemList.Add(LFMComponentName, CurUnitInfo.Filename,
3328 i, CurUnitInfo = ActiveUnitInfo);
3329 end;
3330 end;
3331 end;
3332 end else
3333 begin
3334 // add all unit names of project
3335 if (CurUnitInfo.FileName <> '') then
3336 begin
3337 AUnitName := ExtractFileName(CurUnitInfo.Filename);
3338 if ItemList.Find(AUnitName) = nil then
3339 ItemList.Add(AUnitName, CurUnitInfo.Filename,
3340 i, CurUnitInfo = ActiveUnitInfo);
3341 end
3342 else
3343 if Project1.MainUnitID = i then
3344 begin
3345 MainUnitInfo := Project1.MainUnitInfo;
3346 if pfMainUnitIsPascalSource in Project1.Flags then
3347 begin
3348 AUnitName := ExtractFileName(MainUnitInfo.Filename);
3349 if (AUnitName <> '') and (ItemList.Find(AUnitName) = nil) then
3350 begin
3351 ItemList.Add(AUnitName, MainUnitInfo.Filename,
3352 i, MainUnitInfo = ActiveUnitInfo);
3353 end;
3354 end;
3355 end;
3356 end;
3357 end;
3358 case ItemType of
3359 piUnit: DlgCaption := dlgMainViewUnits;
3360 piComponent: DlgCaption := dlgMainViewForms;
3361 piFrame: DlgCaption := dlgMainViewFrames;
3362 else DlgCaption := '';
3363 end;
3364 Result := ShowViewUnitsDlg(ItemList, true, DlgCaption, ItemType);
3365 end;
3366
SelectUnitComponentsnull3367 function SelectUnitComponents(DlgCaption: string; ItemType: TIDEProjectItem;
3368 Files: TStringList): TModalResult;
3369 var
3370 ActiveSourceEditor: TSourceEditor;
3371 ActiveUnitInfo: TUnitInfo;
3372 UnitToFilename: TStringToStringTree;
3373 UnitPath: String;
3374
ResourceFitsnull3375 function ResourceFits(ResourceBaseClass: TPFComponentBaseClass): boolean;
3376 begin
3377 case ItemType of
3378 piUnit: Result:=true;
3379 piComponent: Result:=ResourceBaseClass<>pfcbcNone;
3380 piFrame: Result:=ResourceBaseClass=pfcbcFrame;
3381 else Result:=false;
3382 end;
3383 end;
3384
3385 procedure AddUnit(AnUnitName,AFilename: string);
3386 var
3387 LFMFilename: String;
3388 begin
3389 //debugln(['AddUnit ',AFilename]);
3390 if not FilenameIsPascalUnit(AFilename) then exit;
3391 if CompareFilenames(AFilename,ActiveUnitInfo.Filename)=0 then exit;
3392 if (AnUnitName='') then
3393 AnUnitName:=ExtractFileNameOnly(AFilename);
3394 if (not FilenameIsAbsolute(AFilename)) then begin
3395 if (not ActiveUnitInfo.IsVirtual) then
3396 exit; // virtual UnitToFilename can not be accessed from disk UnitToFilename
3397 end else begin
3398 //debugln(['AddUnit unitpath=',UnitPath]);
3399 if SearchDirectoryInSearchPath(UnitPath,ExtractFilePath(AFilename))<1 then
3400 exit; // not reachable
3401 end;
3402 if UnitToFilename.Contains(AnUnitName) then exit; // duplicate unit
3403 if not FileExistsCached(AFilename) then exit;
3404 LFMFilename:=ChangeFileExt(aFilename,'.lfm');
3405 if not FileExistsCached(LFMFilename) then exit;
3406 UnitToFilename[AnUnitName]:=AFilename;
3407 end;
3408
3409 procedure AddPackage(Pkg: TLazPackage);
3410 var
3411 i: Integer;
3412 PkgFile: TPkgFile;
3413 begin
3414 //debugln(['AddPackage ',pkg.Name]);
3415 for i:=0 to Pkg.FileCount-1 do begin
3416 PkgFile:=TPkgFile(Pkg.Files[i]);
3417 if not (PkgFile.FileType in PkgFileRealUnitTypes) then continue;
3418 if not FilenameIsAbsolute(PkgFile.Filename) then continue;
3419 if not ResourceFits(PkgFile.ResourceBaseClass) then begin
3420 if PkgFile.ResourceBaseClass<>pfcbcNone then continue;
3421 // unknown resource class => check file
3422 PkgFile.ResourceBaseClass:=FindLFMBaseClass(PkgFile.Filename);
3423 if not ResourceFits(PkgFile.ResourceBaseClass) then continue;
3424 end;
3425 AddUnit(PkgFile.Unit_Name,PkgFile.Filename);
3426 end;
3427 end;
3428
3429 var
3430 Owners: TFPList;
3431 APackage: TLazPackage;
3432 AProject: TProject;
3433 AnUnitInfo: TUnitInfo;
3434 FirstDependency: TPkgDependency;
3435 PkgList: TFPList;
3436 i: Integer;
3437 S2SItem: PStringToStringItem;
3438 AnUnitName: String;
3439 AFilename: String;
3440 UnitList: TViewUnitEntries;
3441 Entry: TViewUnitsEntry;
3442 begin
3443 Result:=mrCancel;
3444 MainIDE.GetCurrentUnit(ActiveSourceEditor, ActiveUnitInfo);
3445 if ActiveUnitInfo=nil then exit;
3446 Owners:=PkgBoss.GetPossibleOwnersOfUnit(ActiveUnitInfo.Filename,[]);
3447 UnitPath:=CodeToolBoss.GetCompleteSrcPathForDirectory(ExtractFilePath(ActiveUnitInfo.Filename));
3448 PkgList:=nil;
3449 UnitToFilename:=TStringToStringTree.Create(false);
3450 UnitList:=TViewUnitEntries.Create;
3451 try
3452 // fetch owner of active unit
3453 AProject:=nil;
3454 APackage:=nil;
3455 if (Owners<>nil) then begin
3456 for i:=0 to Owners.Count-1 do begin
3457 if TObject(Owners[i]) is TProject then begin
3458 AProject:=TProject(Owners[i]);
3459 break;
3460 end else if TObject(Owners[i]) is TLazPackage then begin
3461 APackage:=TLazPackage(Owners[i]);
3462 end;
3463 end;
3464 end;
3465 if AProject<>nil then begin
3466 // add project units
3467 //debugln(['SelectUnitComponents Project=',AProject.ProjectInfoFile]);
3468 FirstDependency:=AProject.FirstRequiredDependency;
3469 for i:=0 to AProject.UnitCount-1 do begin
3470 AnUnitInfo:=AProject.Units[i];
3471 if (not AnUnitInfo.IsPartOfProject)
3472 or (AnUnitInfo.ComponentName='')
3473 then continue;
3474 if not ResourceFits(AnUnitInfo.ResourceBaseClass) then begin
3475 if AnUnitInfo.ResourceBaseClass<>pfcbcNone then continue;
3476 // unknown resource class => check file
3477 AnUnitInfo.ResourceBaseClass:=FindLFMBaseClass(AnUnitInfo.Filename);
3478 if not ResourceFits(AnUnitInfo.ResourceBaseClass) then continue;
3479 end;
3480 AddUnit(AnUnitInfo.Unit_Name,AnUnitInfo.Filename);
3481 end;
3482 end else if APackage<>nil then begin
3483 // add package units
3484 FirstDependency:=APackage.FirstRequiredDependency;
3485 AddPackage(APackage);
3486 end else
3487 FirstDependency:=nil;
3488 // add all units of all used packages
3489 PackageGraph.GetAllRequiredPackages(nil,FirstDependency,PkgList);
3490 if PkgList<>nil then
3491 for i:=0 to PkgList.Count-1 do
3492 AddPackage(TLazPackage(PkgList[i]));
3493
3494 // create Files
3495 i:=0;
3496 for S2SItem in UnitToFilename do begin
3497 AnUnitName:=S2SItem^.Name;
3498 AFilename:=S2SItem^.Value;
3499 UnitList.Add(AnUnitName,AFilename,i,false);
3500 inc(i);
3501 end;
3502 // show dialog
3503 Result := ShowViewUnitsDlg(UnitList, false,
3504 DlgCaption, ItemType, ActiveUnitInfo.Filename);
3505 // create list of selected files
3506 for Entry in UnitList do
3507 if Entry.Selected then
3508 Files.Add(Entry.Filename);
3509
3510 finally
3511 UnitList.Free;
3512 PkgList.Free;
3513 Owners.Free;
3514 UnitToFilename.Free;
3515 end;
3516 end;
3517
RemoveFromProjectDialognull3518 function RemoveFromProjectDialog: TModalResult;
3519 var
3520 ViewUnitEntries: TViewUnitEntries;
3521 i:integer;
3522 AName: string;
3523 AnUnitInfo: TUnitInfo;
3524 UnitInfos: TFPList;
3525 UEntry: TViewUnitsEntry;
3526 Begin
3527 if Project1=nil then exit(mrCancel);
3528 Project1.UpdateIsPartOfProjectFromMainUnit;
3529 ViewUnitEntries := TViewUnitEntries.Create;
3530 UnitInfos:=nil;
3531 try
3532 for i := 0 to Project1.UnitCount-1 do
3533 begin
3534 AnUnitInfo:=Project1.Units[i];
3535 if (AnUnitInfo.IsPartOfProject) and (i<>Project1.MainUnitID) then
3536 begin
3537 AName := Project1.RemoveProjectPathFromFilename(AnUnitInfo.FileName);
3538 ViewUnitEntries.Add(AName,AnUnitInfo.FileName,i,false);
3539 end;
3540 end;
3541 if ShowViewUnitsDlg(ViewUnitEntries,true,lisRemoveFromProject,piUnit) <> mrOk then
3542 exit(mrOk);
3543 { This is where we check what the user selected. }
3544 UnitInfos:=TFPList.Create;
3545 for UEntry in ViewUnitEntries do
3546 begin
3547 if UEntry.Selected then
3548 begin
3549 if UEntry.ID<0 then continue;
3550 AnUnitInfo:=Project1.Units[UEntry.ID];
3551 if AnUnitInfo.IsPartOfProject then
3552 UnitInfos.Add(AnUnitInfo);
3553 end;
3554 end;
3555 if UnitInfos.Count>0 then
3556 Result:=RemoveFilesFromProject(UnitInfos)
3557 else
3558 Result:=mrOk;
3559 finally
3560 UnitInfos.Free;
3561 ViewUnitEntries.Free;
3562 end;
3563 end;
3564
InitNewProjectnull3565 function InitNewProject(ProjectDesc: TProjectDescriptor): TModalResult;
3566 var
3567 i:integer;
3568 HandlerResult: TModalResult;
3569 begin
3570 try
3571 Project1.BeginUpdate(true);
3572 try
3573 if Project1.CompilerOptions.CompilerPath='' then
3574 Project1.CompilerOptions.CompilerPath:=DefaultCompilerPath;
3575 if pfUseDefaultCompilerOptions in Project1.Flags then begin
3576 MainIDE.DoMergeDefaultProjectOptions;
3577 Project1.Flags:=Project1.Flags-[pfUseDefaultCompilerOptions];
3578 end;
3579 Project1.AutoAddOutputDirToIncPath;
3580 // call ProjectOpening handlers
3581 HandlerResult:=MainIDE.DoCallProjectChangedHandler(lihtProjectOpening, Project1);
3582 MainIDE.UpdateCaption;
3583 if ProjInspector<>nil then
3584 ProjInspector.LazProject:=Project1;
3585 // add and load default required packages
3586 PkgBoss.OpenProjectDependencies(Project1,true);
3587 // rebuild codetools defines
3588 MainBuildBoss.SetBuildTargetProject1(false);
3589 // (i.e. remove old project specific things and create new)
3590 IncreaseCompilerParseStamp;
3591 Project1.DefineTemplates.Active:=true;
3592 DebugBoss.Reset;
3593 finally
3594 Project1.EndUpdate;
3595 end;
3596 Project1.BeginUpdate(true);
3597 try
3598 // create files
3599 if ProjectDesc.CreateStartFiles(Project1)<>mrOk then begin
3600 debugln('InitNewProject ProjectDesc.CreateStartFiles failed');
3601 end;
3602 if (Project1.MainUnitInfo<>nil)
3603 and ((Project1.FirstUnitWithEditorIndex=nil)
3604 or ([pfMainUnitHasCreateFormStatements,pfMainUnitHasTitleStatement,pfMainUnitHasScaledStatement]*Project1.Flags=[]))
3605 then begin
3606 // the project has not created any secondary files
3607 // or the project main source is not auto updated by the IDE
3608 OpenMainUnit(-1,-1,[]);
3609 end;
3610
3611 // init resource files
3612 if not Project1.ProjResources.Regenerate(Project1.MainFilename, True, False,'') then
3613 DebugLn('InitNewProject Project1.Resources.Regenerate failed');
3614 finally
3615 Project1.EndUpdate;
3616 end;
3617 Result:=mrOk;
3618 finally
3619 // set all modified to false
3620 Project1.UpdateAllVisibleUnits;
3621 for i:=0 to Project1.UnitCount-1 do
3622 Project1.Units[i].ClearModifieds;
3623 Project1.Modified:=false;
3624 // call ProjectOpened handlers
3625 HandlerResult:=MainIDE.DoCallProjectChangedHandler(lihtProjectOpened, Project1);
3626 if not (HandlerResult in [mrOk,mrCancel,mrAbort]) then
3627 HandlerResult:=mrCancel;
3628 if (Result=mrOk) then
3629 Result:=HandlerResult;
3630 end;
3631 end;
3632
InitOpenedProjectFilenull3633 function InitOpenedProjectFile(AFileName: string; Flags: TOpenFlags): TModalResult;
3634 var
3635 EditorInfoIndex, i, j: Integer;
3636 NewBuf: TCodeBuffer;
3637 LastDesigner: TIDesigner;
3638 AnUnitInfo: TUnitInfo;
3639 HandlerResult: TModalResult;
3640 AnEditorInfo: TUnitEditorInfo;
3641 begin
3642 EditorInfoIndex := 0;
3643 SourceEditorManager.IncUpdateLock;
3644 Project1.BeginUpdate(true);
3645 try
3646 // call ProjectOpening handlers
3647 HandlerResult:=MainIDE.DoCallProjectChangedHandler(lihtProjectOpening, Project1);
3648 if ProjInspector<>nil then
3649 ProjInspector.LazProject:=Project1;
3650
3651 // read project info file
3652 {$IFDEF IDE_MEM_CHECK}CheckHeapWrtMemCnt('InitOpenedProjectFile B3');{$ENDIF}
3653 Project1.ReadProject(AFilename, EnvironmentOptions.BuildMatrixOptions, True);
3654 {$IFDEF IDE_MEM_CHECK}CheckHeapWrtMemCnt('InitOpenedProjectFile B4');{$ENDIF}
3655 Result:=CompleteLoadingProjectInfo;
3656 {$IFDEF IDE_MEM_CHECK}CheckHeapWrtMemCnt('InitOpenedProjectFile B5');{$ENDIF}
3657 if Result<>mrOk then exit;
3658
3659 if Project1.MainUnitID>=0 then begin
3660 // read MainUnit Source
3661 Result:=LoadCodeBuffer(NewBuf,Project1.MainFilename,
3662 [lbfUpdateFromDisk,lbfRevert],false);// do not check if source is text
3663 case Result of
3664 mrOk: Project1.MainUnitInfo.Source:=NewBuf;
3665 mrIgnore: Project1.MainUnitInfo.Source:=CodeToolBoss.CreateFile(Project1.MainFilename);
3666 else exit(mrCancel);
3667 end;
3668 end;
3669 //debugln('InitOpenedProjectFile C');
3670 {$IFDEF IDE_MEM_CHECK}CheckHeapWrtMemCnt('InitOpenedProjectFile C');{$ENDIF}
3671 IncreaseCompilerParseStamp;
3672
3673 // restore files
3674 while EditorInfoIndex < Project1.AllEditorsInfoCount do begin
3675 // TProject.ReadProject sorts all UnitEditorInfos
3676 AnEditorInfo := Project1.AllEditorsInfo[EditorInfoIndex];
3677 AnUnitInfo := AnEditorInfo.UnitInfo;
3678 if (not AnUnitInfo.Loaded) or (AnEditorInfo.PageIndex < 0) then begin
3679 inc(EditorInfoIndex);
3680 Continue;
3681 end;
3682
3683 // reopen file
3684 if (not AnUnitInfo.IsPartOfProject)
3685 and (not FileExistsCached(AnUnitInfo.Filename)) then begin
3686 // this file does not exist, but is not important => silently ignore
3687 end
3688 else begin
3689 // reopen file
3690 // This will adjust Page/WindowIndex if they are not continous
3691 Result:=OpenEditorFile(AnUnitInfo.Filename, -1, AnEditorInfo.WindowID,
3692 AnEditorInfo, [ofProjectLoading,ofMultiOpen,ofOnlyIfExists], True);
3693 if Result=mrAbort then
3694 exit;
3695 end;
3696 if not ((AnUnitInfo.Filename<>'') and (AnEditorInfo.EditorComponent <> nil))
3697 then begin
3698 // failed to open
3699 AnEditorInfo.PageIndex := -1;
3700 // if failed entirely -> mark as unloaded, so that next time it will not be tried again
3701 if AnUnitInfo.OpenEditorInfoCount = 0 then
3702 AnUnitInfo.Loaded := False;
3703 end;
3704 inc(EditorInfoIndex);
3705 end; // while EditorInfoIndex < Project1.AllEditorsInfoCount
3706 Result:=mrCancel;
3707 //debugln('InitOpenedProjectFile D');
3708
3709 // set active editor source editor
3710 for i := 0 to Project1.AllEditorsInfoCount - 1 do begin
3711 AnEditorInfo := Project1.AllEditorsInfo[i];
3712 if AnEditorInfo.IsVisibleTab then
3713 begin
3714 if (AnEditorInfo.WindowID < 0) then continue;
3715 j := SourceEditorManager.IndexOfSourceWindowWithID(AnEditorInfo.WindowID);
3716 if j < 0
3717 then begin
3718 // session info is invalid (buggy lps file?) => auto fix
3719 AnEditorInfo.IsVisibleTab:=false;
3720 AnEditorInfo.WindowID:=-1;
3721 Continue;
3722 end;
3723 if (SourceEditorManager.SourceWindows[j] <> nil) then
3724 SourceEditorManager.SourceWindows[j].PageIndex := AnEditorInfo.PageIndex;
3725 end;
3726 end;
3727 if (Project1.ActiveWindowIndexAtStart<0)
3728 or (Project1.ActiveWindowIndexAtStart >= SourceEditorManager.SourceWindowCount)
3729 then begin
3730 // session info is invalid (buggy lps file?) => auto fix
3731 Project1.ActiveWindowIndexAtStart := 0;
3732 end;
3733 if (Project1.ActiveWindowIndexAtStart >= 0) and
3734 (Project1.ActiveWindowIndexAtStart < SourceEditorManager.SourceWindowCount)
3735 then begin
3736 SourceEditorManager.ActiveSourceWindow :=
3737 SourceEditorManager.SourceWindows[Project1.ActiveWindowIndexAtStart];
3738 SourceEditorManager.ShowActiveWindowOnTop(True);
3739 end;
3740
3741 if ([ofDoNotLoadResource]*Flags=[])
3742 and ( (not Project1.AutoOpenDesignerFormsDisabled)
3743 and EnvironmentOptions.AutoCreateFormsOnOpen
3744 and (SourceEditorManager.ActiveEditor<>nil) )
3745 then begin
3746 // auto open form of active unit
3747 AnUnitInfo:=Project1.UnitWithEditorComponent(SourceEditorManager.ActiveEditor);
3748 if AnUnitInfo<>nil then
3749 Result:=LoadLFM(AnUnitInfo,[ofProjectLoading,ofMultiOpen,ofOnlyIfExists],
3750 [cfSaveDependencies]);
3751 end;
3752
3753 // select a form (object inspector, formeditor, control selection)
3754 if MainIDE.LastFormActivated<>nil then begin
3755 LastDesigner:=MainIDE.LastFormActivated.Designer;
3756 debugln(['InitOpenedProjectFile select form in designer: ',
3757 DbgSName(MainIDE.LastFormActivated),' ',DbgSName(MainIDE.LastFormActivated.Designer)]);
3758 LastDesigner.SelectOnlyThisComponent(LastDesigner.LookupRoot);
3759 end;
3760
3761 Project1.UpdateAllVisibleUnits;
3762 IncreaseCompilerParseStamp;
3763 IDEProtocolOpts.LastProjectLoadingCrashed := False;
3764 Result:=mrOk;
3765 finally
3766 Project1.EndUpdate;
3767 SourceEditorManager.DecUpdateLock;
3768 if (Result<>mrOk) and (Project1<>nil) then begin
3769 // mark all files, that are left to open as unloaded:
3770 for i := EditorInfoIndex to Project1.AllEditorsInfoCount - 1 do begin
3771 AnEditorInfo := Project1.AllEditorsInfo[i];
3772 AnEditorInfo.PageIndex := -1;
3773 AnUnitInfo := AnEditorInfo.UnitInfo;
3774 if AnUnitInfo.Loaded and (AnUnitInfo.OpenEditorInfoCount = 0) then
3775 AnUnitInfo.Loaded := false;
3776 end;
3777 end;
3778
3779 // set all modified to false
3780 Project1.ClearModifieds(true);
3781
3782 // call ProjectOpened handlers
3783 HandlerResult:=MainIDE.DoCallProjectChangedHandler(lihtProjectOpened, Project1);
3784 if not (HandlerResult in [mrOk,mrCancel,mrAbort]) then
3785 HandlerResult:=mrCancel;
3786 if (Result=mrOk) then
3787 Result:=HandlerResult;
3788 end;
3789 if Result=mrAbort then exit;
3790 //debugln('InitOpenedProjectFile end CodeToolBoss.ConsistencyCheck=',IntToStr(CodeToolBoss.ConsistencyCheck));
3791 {$IFDEF IDE_MEM_CHECK}CheckHeapWrtMemCnt('InitOpenedProjectFile end');{$ENDIF}
3792 end;
3793
3794 procedure NewProjectFromFile;
3795 var
3796 OpenDialog:TOpenDialog;
3797 AFilename: string;
3798 PreReadBuf: TCodeBuffer;
3799 Filter: String;
3800 Begin
3801 OpenDialog:=IDEOpenDialogClass.Create(nil);
3802 try
3803 InputHistories.ApplyFileDialogSettings(OpenDialog);
3804 OpenDialog.Title:=lisChooseProgramSourcePpPasLpr;
3805 OpenDialog.Options:=OpenDialog.Options+[ofPathMustExist,ofFileMustExist];
3806 Filter := dlgFilterLazarusUnit + ' (*.pas;*.pp;*.p)|*.pas;*.pp;*.p'
3807 + '|' + dlgFilterLazarusProjectSource + ' (*.lpr)|*.lpr';
3808 Filter:=Filter+ '|' + dlgFilterAll + ' (' + GetAllFilesMask + ')|' + GetAllFilesMask;
3809 OpenDialog.Filter := Filter;
3810 if OpenDialog.Execute then begin
3811 AFilename:=ExpandFileNameUTF8(OpenDialog.Filename);
3812 if not FilenameIsPascalSource(AFilename) then begin
3813 IDEMessageDialog(lisPkgMangInvalidFileExtension,
3814 lisProgramSourceMustHaveAPascalExtensionLikePasPpOrLp,
3815 mtError,[mbOk],'');
3816 exit;
3817 end;
3818 if (LoadCodeBuffer(PreReadBuf,AFileName,
3819 [lbfCheckIfText,lbfUpdateFromDisk,lbfRevert],false)<>mrOk)
3820 or (CreateProjectForProgram(PreReadBuf)=mrOk) then
3821 exit;
3822 end;
3823 finally
3824 InputHistories.StoreFileDialogSettings(OpenDialog);
3825 OpenDialog.Free;
3826 end;
3827 end;
3828
CreateProjectForProgramnull3829 function CreateProjectForProgram(ProgramBuf: TCodeBuffer): TModalResult;
3830 var
3831 NewProjectDesc: TProjectDescriptor;
3832 begin
3833 //debugln('[CreateProjectForProgram] A ',ProgramBuf.Filename);
3834 if (Project1 <> nil)
3835 and (not MainIDE.DoResetToolStatus([rfInteractive, rfSuccessOnTrigger])) then exit(mrAbort);
3836
3837 Result:=SaveProjectIfChanged;
3838 if Result=mrAbort then exit;
3839
3840 // let user choose the program type
3841 NewProjectDesc:=nil;
3842 if ChooseNewProject(NewProjectDesc)<>mrOk then exit;
3843
3844 // close old project
3845 If Project1<>nil then begin
3846 if CloseProject=mrAbort then begin
3847 Result:=mrAbort;
3848 exit;
3849 end;
3850 end;
3851
3852 // reload file (if the file was open in the IDE, closeproject unloaded it)
3853 ProgramBuf.Reload;
3854
3855 // switch codetools to new project directory
3856 CodeToolBoss.GlobalValues.Variables[ExternalMacroStart+'ProjPath']:=
3857 ExpandFileNameUTF8(ExtractFilePath(ProgramBuf.Filename));
3858
3859 // create a new project
3860 Project1:=MainIDE.CreateProjectObject(NewProjectDesc,ProjectDescriptorProgram);
3861 Result:=InitProjectForProgram(ProgramBuf);
3862 //debugln('[CreateProjectForProgram] END');
3863 end;
3864
InitProjectForProgramnull3865 function InitProjectForProgram(ProgramBuf: TCodeBuffer): TModalResult;
3866 var
3867 MainUnitInfo: TUnitInfo;
3868 begin
3869 Project1.BeginUpdate(true);
3870 try
3871 if ProjInspector<>nil then
3872 ProjInspector.LazProject:=Project1;
3873 MainUnitInfo:=Project1.MainUnitInfo;
3874 MainUnitInfo.Source:=ProgramBuf;
3875 Project1.ProjectInfoFile:=ChangeFileExt(ProgramBuf.Filename,'.lpi');
3876 Project1.CompilerOptions.TargetFilename:=ExtractFileNameOnly(ProgramBuf.Filename);
3877 MainIDE.DoMergeDefaultProjectOptions;
3878 MainIDE.UpdateCaption;
3879 IncreaseCompilerParseStamp;
3880 // add and load default required packages
3881 PkgBoss.OpenProjectDependencies(Project1,true);
3882 Result:=CompleteLoadingProjectInfo;
3883 if Result<>mrOk then exit;
3884 finally
3885 Project1.EndUpdate;
3886 end;
3887 // show program unit
3888 Result:=OpenEditorFile(ProgramBuf.Filename,-1,-1, nil, [ofAddToRecent,ofRegularFile]);
3889 if Result=mrAbort then exit;
3890 Result:=mrOk;
3891 end;
3892
SaveProjectnull3893 function SaveProject(Flags: TSaveFlags):TModalResult;
3894 var
3895 i, j: integer;
3896 AnUnitInfo: TUnitInfo;
3897 SaveFileFlags: TSaveFlags;
3898 SrcEdit: TSourceEditor;
3899 begin
3900 Result:=mrCancel;
3901 if not (MainIDE.ToolStatus in [itNone,itDebugger]) then begin
3902 Result:=mrAbort;
3903 exit;
3904 end;
3905 SaveEditorChangesToCodeCache(nil);
3906 //DebugLn('SaveProject A SaveAs=',dbgs(sfSaveAs in Flags),' SaveToTestDir=',dbgs(sfSaveToTestDir in Flags),' ProjectInfoFile=',Project1.ProjectInfoFile);
3907 Result:=MainIDE.DoCheckFilesOnDisk(true);
3908 if Result in [mrCancel,mrAbort] then begin
3909 debugln(['Info: (lazarus) [SaveProject] MainIDE.DoCheckFilesOnDisk failed']);
3910 exit;
3911 end;
3912
3913 if CheckMainSrcLCLInterfaces(sfQuietUnitCheck in Flags)<>mrOk then begin
3914 debugln(['Info: (lazarus) [SaveProject] CheckMainSrcLCLInterfaces failed']);
3915 exit(mrCancel);
3916 end;
3917
3918 // if this is a virtual project then save first the project info file
3919 // to get a project directory
3920 if Project1.IsVirtual and ([sfSaveToTestDir,sfDoNotSaveVirtualFiles]*Flags=[])
3921 then begin
3922 Result:=SaveProjectInfo(Flags);
3923 if Result in [mrCancel,mrAbort] then begin
3924 debugln(['Info: (lazarus) [SaveProject] SaveProjectInfo failed']);
3925 exit;
3926 end;
3927 end;
3928
3929 // save virtual files
3930 if (not (sfDoNotSaveVirtualFiles in Flags)) then
3931 begin
3932 // check that all new units are saved first to get valid filenames
3933 // Note: this can alter the mainunit: e.g. used unit names
3934 for i:=0 to Project1.UnitCount-1 do begin
3935 AnUnitInfo:=Project1.Units[i];
3936 if (AnUnitInfo.Loaded) and AnUnitInfo.IsVirtual
3937 and AnUnitInfo.IsPartOfProject
3938 and (Project1.MainUnitID<>i)
3939 and (AnUnitInfo.OpenEditorInfoCount > 0) then begin
3940 SaveFileFlags:=[sfSaveAs,sfProjectSaving]+[sfCheckAmbiguousFiles]*Flags;
3941 if sfSaveToTestDir in Flags then begin
3942 Assert(AnUnitInfo.IsPartOfProject or AnUnitInfo.IsVirtual, 'SaveProject: Not IsPartOfProject or IsVirtual');
3943 Include(SaveFileFlags,sfSaveToTestDir);
3944 end;
3945 Result:=SaveEditorFile(AnUnitInfo.OpenEditorInfo[0].EditorComponent, SaveFileFlags);
3946 if Result in [mrCancel,mrAbort] then begin
3947 debugln(['Info: (lazarus) [SaveProject] SaveEditorFile "',AnUnitInfo.Filename,'" failed']);
3948 exit;
3949 end;
3950 end;
3951 end;
3952 end;
3953
3954 Result:=SaveProjectInfo(Flags);
3955 if Result in [mrCancel,mrAbort] then begin
3956 debugln(['Info: (lazarus) [SaveProject] SaveProjectInfo failed']);
3957 exit;
3958 end;
3959
3960 // save all editor files
3961 for i:=0 to SourceEditorManager.SourceEditorCount-1 do begin
3962 SrcEdit:=SourceEditorManager.SourceEditors[i];
3963 AnUnitInfo:=Project1.UnitWithEditorComponent(SrcEdit);
3964 if (Project1.MainUnitID>=0) and (Project1.MainUnitInfo = AnUnitInfo) then
3965 continue;
3966 SaveFileFlags:=[sfProjectSaving]+Flags*[sfCheckAmbiguousFiles];
3967 if AnUnitInfo = nil
3968 then begin
3969 // inconsistency detected, write debug info
3970 DebugLn(['SaveProject - unit not found for page ',i,' File="',SrcEdit.FileName,'" SrcEdit=',dbgsname(SrcEdit),'=',dbgs(Pointer(SrcEdit))]);
3971 DumpStack;
3972 debugln(['SaveProject Project1 has the following information about the source editor:']);
3973 AnUnitInfo:=Project1.FirstUnitWithEditorIndex;
3974 while AnUnitInfo<>nil do begin
3975 for j:=0 to AnUnitInfo.EditorInfoCount-1 do begin
3976 dbgout([' ',AnUnitInfo.Filename,' ',j,'/',AnUnitInfo.EditorInfoCount,' Component=',dbgsname(AnUnitInfo.EditorInfo[j].EditorComponent),'=',dbgs(Pointer(AnUnitInfo.EditorInfo[j].EditorComponent))]);
3977 if AnUnitInfo.EditorInfo[j].EditorComponent<>nil then
3978 dbgout(AnUnitInfo.EditorInfo[j].EditorComponent.FileName);
3979 debugln;
3980 end;
3981 debugln([' ',AnUnitInfo.EditorInfoCount]);
3982 AnUnitInfo:=AnUnitInfo.NextUnitWithEditorIndex;
3983 end;
3984 end else begin
3985 if AnUnitInfo.IsVirtual then begin
3986 if (sfSaveToTestDir in Flags) then
3987 Include(SaveFileFlags,sfSaveToTestDir)
3988 else
3989 continue;
3990 end;
3991 end;
3992 Result:=SaveEditorFile(SrcEdit, SaveFileFlags);
3993 if Result=mrAbort then begin
3994 debugln(['Info: (lazarus) [SaveProject] SaveEditorFile "',SrcEdit.FileName,'" failed']);
3995 exit;
3996 end;
3997 // mrCancel: continue saving other files
3998 end;
3999
4000 // update all lrs files
4001 if sfSaveToTestDir in Flags then
4002 MainBuildBoss.UpdateProjectAutomaticFiles(EnvironmentOptions.GetParsedTestBuildDirectory)
4003 else
4004 MainBuildBoss.UpdateProjectAutomaticFiles('');
4005
4006 // everything went well => clear all modified flags
4007 Project1.ClearModifieds(true);
4008 // update menu and buttons state
4009 MainIDE.UpdateSaveMenuItemsAndButtons(true);
4010 //DebugLn('SaveProject End');
4011 Result:=mrOk;
4012 end;
4013
SaveProjectIfChangednull4014 function SaveProjectIfChanged: TModalResult;
4015 begin
4016 if SomethingOfProjectIsModified then begin
4017 if IDEMessageDialog(lisProjectChanged, Format(lisSaveChangesToProject,
4018 [Project1.GetTitleOrName]),
4019 mtconfirmation, [mbYes, mbNo, mbCancel])=mrYes then
4020 begin
4021 if SaveProject([])=mrAbort then begin
4022 Result:=mrAbort;
4023 exit;
4024 end;
4025 end;
4026 end;
4027 Result:=mrOk;
4028 end;
4029
CloseProjectnull4030 function CloseProject: TModalResult;
4031 var
4032 SrcEdit: TSourceEditor;
4033 begin
4034 if Project1=nil then exit(mrOk);
4035
4036 //debugln('CloseProject A');
4037 {$IFDEF IDE_MEM_CHECK}CheckHeapWrtMemCnt('CloseProject A');{$ENDIF}
4038 Result:=DebugBoss.DoStopProject;
4039 if Result<>mrOk then begin
4040 debugln('CloseProject DebugBoss.DoStopProject failed');
4041 exit;
4042 end;
4043
4044 // call handlers
4045 Result:=MainIDE.DoCallProjectChangedHandler(lihtProjectClose, Project1);
4046 if Result=mrAbort then exit;
4047
4048 // close all loaded files
4049 SourceEditorManager.IncUpdateLock;
4050 try
4051 while SourceEditorManager.SourceEditorCount > 0 do begin
4052 SrcEdit:=SourceEditorManager.SourceEditors[SourceEditorManager.SourceEditorCount-1];
4053 Result:=CloseEditorFile(SrcEdit,[cfProjectClosing]);
4054 if Result=mrAbort then exit;
4055 end;
4056 finally
4057 SourceEditorManager.DecUpdateLock;
4058 end;
4059 // remove all source modifications
4060 CodeToolBoss.SourceCache.ClearAllModified;
4061
4062 {$IFDEF IDE_MEM_CHECK}CheckHeapWrtMemCnt('CloseProject B');{$ENDIF}
4063 IncreaseCompilerParseStamp;
4064
4065 // close Project
4066 if ProjInspector<>nil then
4067 ProjInspector.LazProject:=nil;
4068 FreeThenNil(Project1);
4069 if IDEMessagesWindow<>nil then IDEMessagesWindow.Clear;
4070
4071 MainIDE.UpdateCaption;
4072 {$IFDEF IDE_MEM_CHECK}CheckHeapWrtMemCnt('CloseProject C');{$ENDIF}
4073 Result:=mrOk;
4074 //debugln('CloseProject end ',CodeToolBoss.ConsistencyCheck);
4075 end;
4076
4077 procedure OpenProject(aMenuItem: TIDEMenuItem);
4078 var
4079 OpenDialog: TOpenDialog;
4080 AFileName: string;
4081 LoadFlags: TLoadBufferFlags;
4082 PreReadBuf: TCodeBuffer;
4083 SourceType: String;
4084 LPIFilename: String;
4085 begin
4086 if Assigned(aMenuItem) and (aMenuItem.Section=itmProjectRecentOpen) then
4087 begin
4088 // Hint holds the full filename, Caption may have a shortened form.
4089 AFileName:=aMenuItem.Hint;
4090 Assert(AFileName = ExpandFileNameUTF8(AFileName),'OpenProject: AFileName is not absolute.');
4091 if MainIDE.DoOpenProjectFile(AFilename,[ofAddToRecent])=mrOk then begin
4092 AddRecentProjectFile(AFilename);
4093 end else begin
4094 // open failed
4095 if not FileExistsCached(AFilename) then begin
4096 EnvironmentOptions.RemoveFromRecentProjectFiles(AFilename);
4097 end else
4098 AddRecentProjectFile(AFilename);
4099 end;
4100 end
4101 else begin
4102 OpenDialog:=IDEOpenDialogClass.Create(nil);
4103 try
4104 InputHistories.ApplyFileDialogSettings(OpenDialog);
4105 OpenDialog.Title:=lisOpenProjectFile+' (*.lpi)';
4106 OpenDialog.Filter := dlgFilterLazarusProject+' (*.lpi)|*.lpi|'
4107 +dlgFilterAll+'|'+GetAllFilesMask;
4108 if OpenDialog.Execute then begin
4109 AFilename:=GetPhysicalFilenameCached(ExpandFileNameUTF8(OpenDialog.Filename),false);
4110 if not FilenameExtIs(AFilename,'lpi',true) then begin
4111 // not a lpi file
4112 // check if it is a program source
4113
4114 // load the source
4115 LoadFlags := [lbfCheckIfText,lbfUpdateFromDisk,lbfRevert];
4116 if LoadCodeBuffer(PreReadBuf,AFileName,LoadFlags,true)<>mrOk then exit;
4117
4118 // check if unit is a program
4119 SourceType:=CodeToolBoss.GetSourceType(PreReadBuf,false);
4120 if (SysUtils.CompareText(SourceType,'PROGRAM')=0)
4121 or (SysUtils.CompareText(SourceType,'LIBRARY')=0)
4122 then begin
4123 // source is a program
4124 // either this is a lazarus project
4125 // or it is not yet a lazarus project ;)
4126 LPIFilename:=ChangeFileExt(AFilename,'.lpi');
4127 if FileExistsCached(LPIFilename) then begin
4128 if IDEQuestionDialog(lisProjectInfoFileDetected,
4129 Format(lisTheFileSeemsToBeTheProgramFileOfAnExistingLazarusP, [AFilename]),
4130 mtConfirmation, [mrOk,lisOpenProject2,
4131 mrCancel]) <> mrOk
4132 then
4133 exit;
4134 AFilename:=LPIFilename;
4135 end else begin
4136 if IDEQuestionDialog(lisFileHasNoProject,
4137 Format(lisTheFileIsNotALazarusProjectCreateANewProjectForThi,
4138 [AFilename, LineEnding, lowercase(SourceType)]),
4139 mtConfirmation, [mrYes, lisCreateProject,
4140 mrCancel]) <> mrYes
4141 then
4142 exit;
4143 CreateProjectForProgram(PreReadBuf);
4144 exit;
4145 end;
4146 end;
4147 end;
4148 MainIDE.DoOpenProjectFile(AFilename,[ofAddToRecent]);
4149 end;
4150 InputHistories.StoreFileDialogSettings(OpenDialog);
4151 finally
4152 OpenDialog.Free;
4153 end;
4154 end;
4155 end;
4156
AskToSaveEditorsnull4157 function AskToSaveEditors(EditorList: TList): TModalResult;
4158 // Ask from user about saving the changed SourceEditors in EditorList.
4159 var
4160 Ed: TSourceEditor;
4161 r: TModalResult;
4162 i, Remain: Integer;
4163 begin
4164 Result := mrOK;
4165 if EditorList.Count = 1 then begin
4166 Ed := TSourceEditor(EditorList[0]);
4167 r := IDEQuestionDialog(lisSourceModified,
4168 Format(lisSourceOfPageHasChangedSave, [Ed.PageName]),
4169 mtConfirmation, [mrYes, lisMenuSave,
4170 mrNo, lisDiscardChanges,
4171 mrAbort]);
4172 case r of
4173 mrYes: SaveEditorFile(Ed, [sfCheckAmbiguousFiles]);
4174 mrNo: ; // don't save
4175 mrAbort, mrCancel: Result := mrAbort;
4176 end;
4177 end
4178 else if EditorList.Count > 1 then
4179 for i := 0 to EditorList.Count - 1 do begin
4180 Ed := TSourceEditor(EditorList[i]);
4181 Remain := EditorList.Count-i-1; // Remaining number of files to go.
4182 r := IDEQuestionDialog(lisSourceModified,
4183 Format(lisSourceOfPageHasChangedSaveEx, [Ed.PageName,Remain]),
4184 mtConfirmation, [mrYes, lisMenuSave,
4185 mrAll, lisSaveAll,
4186 mrNo, lisDiscardChanges,
4187 mrIgnore, lisDiscardChangesAll,
4188 mrAbort]);
4189 case r of
4190 mrYes: SaveEditorFile(Ed, [sfCheckAmbiguousFiles]);
4191 mrNo: ; // don't save
4192 mrAll: begin
4193 MainIDE.DoSaveAll([]);
4194 break;
4195 end;
4196 mrIgnore: break; // don't save anymore
4197 mrAbort, mrCancel: begin
4198 Result := mrAbort;
4199 break;
4200 end;
4201 end;
4202 end;
4203 end;
4204
4205 procedure CloseAll;
4206 // Close editor files
4207 var
4208 Ed: TSourceEditor;
4209 EditorList: TList;
4210 i: Integer;
4211 begin
4212 EditorList := TList.Create;
4213 try
4214 // Collect changed editors into a list and save them after asking from user.
4215 for i := 0 to SourceEditorManager.UniqueSourceEditorCount - 1 do
4216 begin
4217 Ed := TSourceEditor(SourceEditorManager.UniqueSourceEditors[i]);
4218 if CheckEditorNeedsSave(Ed, False) then
4219 EditorList.Add(Ed);
4220 end;
4221 if AskToSaveEditors(EditorList) <> mrOK then Exit;
4222 finally
4223 EditorList.Free;
4224 end;
4225 // Now close them all.
4226 SourceEditorManager.IncUpdateLock;
4227 try
4228 while (SourceEditorManager.SourceEditorCount > 0) and
4229 (CloseEditorFile(SourceEditorManager.SourceEditors[0], []) = mrOk)
4230 do ;
4231 finally
4232 SourceEditorManager.DecUpdateLock;
4233 end;
4234
4235 // Close packages
4236 PkgBoss.DoCloseAllPackageEditors;
4237 end;
4238
4239 procedure InvertedFileClose(PageIndex: LongInt; SrcNoteBook: TSourceNotebook;
4240 CloseOnRightSideOnly: Boolean);
4241 // close all source editors except the clicked
4242 var
4243 Ed: TSourceEditor;
4244 EditorList: TList;
4245 i: Integer;
4246 begin
4247 EditorList := TList.Create;
4248 try
4249 // Collect changed editors, except the active one, into a list and maybe save them.
4250 for i := 0 to SrcNoteBook.EditorCount - 1 do begin
4251 Ed := SrcNoteBook.Editors[i];
4252 if ( (i > PageIndex) or // to right
4253 ( (i <> PageIndex) and not CloseOnRightSideOnly )
4254 ) and
4255 CheckEditorNeedsSave(Ed, True)
4256 then
4257 EditorList.Add(Ed);
4258 end;
4259 if AskToSaveEditors(EditorList) <> mrOK then Exit;
4260 finally
4261 EditorList.Free;
4262 end;
4263 // Now close all editors except the active one.
4264 SourceEditorManager.IncUpdateLock;
4265 try
4266 repeat
4267 i:=SrcNoteBook.PageCount-1;
4268 if i=PageIndex then
4269 if CloseOnRightSideOnly then
4270 break
4271 else
4272 dec(i);
4273 if i<0 then break;
4274 if CloseEditorFile(SrcNoteBook.FindSourceEditorWithPageIndex(i),[])<>mrOk then exit;
4275 if i<PageIndex then PageIndex:=i;
4276 until false;
4277 finally
4278 SourceEditorManager.DecUpdateLock;
4279 end;
4280 end;
4281
4282 function UpdateAppTitleInSource: Boolean;
4283 var
4284 TitleProject, ErrMsg: String;
4285 begin
4286 Result := True;
4287 if not (pfMainUnitHasTitleStatement in Project1.Flags) then Exit;
4288 TitleProject := Project1.GetTitle;
4289 //DebugLn(['UpdateAppTitleInSource: Project title=',TitleProject,', Default=',Project1.GetDefaultTitle]);
4290 if (TitleProject <> Project1.GetDefaultTitle) then
4291 begin // Add or update Title statement.
4292 //DebugLn(['UpdateAppTitleInSource: Setting Title to ',TitleProject]);
4293 Result := CodeToolBoss.SetApplicationTitleStatement(Project1.MainUnitInfo.Source, TitleProject);
4294 ErrMsg := lisUnableToChangeProjectTitleInSource; // Used in case of error.
4295 end
4296 else begin // Remove Title statement if it's not needed.
4297 //DebugLn(['UpdateAppTitleInSource: Removing Title']);
4298 Result := CodeToolBoss.RemoveApplicationTitleStatement(Project1.MainUnitInfo.Source);
4299 ErrMsg := lisUnableToRemoveProjectTitleFromSource;
4300 end;
4301 if not Result then
4302 IDEMessageDialog(lisProjOptsError,
4303 Format(ErrMsg, [LineEnding, CodeToolBoss.ErrorMessage]),
4304 mtWarning, [mbOk]);
4305 end;
4306
UpdateAppScaledInSourcenull4307 function UpdateAppScaledInSource: Boolean;
4308 var
4309 ErrMsg: String;
4310 begin
4311 Result := True;
4312 if not (pfMainUnitHasScaledStatement in Project1.Flags) then Exit;
4313 //DebugLn(['UpdateAppScaledInSource: Project Scaled=',Project1.Scaled]);
4314 if Project1.Scaled then
4315 begin // Add or update Scaled statement.
4316 //DebugLn(['UpdateAppScaledInSource: Setting Scaled to ',Project1.Scaled]);
4317 Result := CodeToolBoss.SetApplicationScaledStatement(Project1.MainUnitInfo.Source, Project1.Scaled);
4318 ErrMsg := lisUnableToChangeProjectScaledInSource; // Used in case of error.
4319 end
4320 else begin // Remove Scaled statement if it's not needed.
4321 //DebugLn(['UpdateAppScaledInSource: Removing Scaled']);
4322 Result := CodeToolBoss.RemoveApplicationScaledStatement(Project1.MainUnitInfo.Source);
4323 ErrMsg := lisUnableToRemoveProjectScaledFromSource;
4324 end;
4325 if not Result then
4326 IDEMessageDialog(lisProjOptsError,
4327 Format(ErrMsg, [LineEnding, CodeToolBoss.ErrorMessage]),
4328 mtWarning, [mbOk]);
4329 end;
4330
4331 function UpdateAppAutoCreateForms: boolean;
4332 var
4333 i: integer;
4334 OldList: TStrings;
4335 begin
4336 Result := True;
4337 if not (pfMainUnitHasCreateFormStatements in Project1.Flags) then Exit;
4338 OldList := Project1.GetAutoCreatedFormsList;
4339 if OldList = nil then Exit;
4340 try
4341 if OldList.Count = Project1.TmpAutoCreatedForms.Count then
4342 begin
4343 i := OldList.Count - 1;
4344 while (i >= 0)
4345 and (CompareText(OldList[i], Project1.TmpAutoCreatedForms[i]) = 0) do
4346 Dec(i);
4347 if i < 0 then
4348 Exit; // Just exit if the form list is the same
4349 end;
4350 if not CodeToolBoss.SetAllCreateFromStatements(Project1.MainUnitInfo.Source,
4351 Project1.TmpAutoCreatedForms) then
4352 begin
4353 IDEMessageDialog(lisProjOptsError,
4354 Format(lisProjOptsUnableToChangeTheAutoCreateFormList, [LineEnding]),
4355 mtWarning, [mbOK]);
4356 Result := False;
4357 Exit;
4358 end;
4359 finally
4360 OldList.Free;
4361 end;
4362 end;
4363
4364 function CreateNewCodeBuffer(Descriptor: TProjectFileDescriptor;
4365 NewOwner: TObject; NewFilename: string;
4366 var NewCodeBuffer: TCodeBuffer; var NewUnitName: string): TModalResult;
4367 var
4368 NewShortFilename: String;
4369 NewFileExt: String;
4370 SearchFlags: TSearchIDEFileFlags;
4371 begin
4372 //debugln('CreateNewCodeBuffer START NewFilename=',NewFilename,' ',Descriptor.DefaultFilename,' ',Descriptor.ClassName);
4373 NewUnitName:='';
4374 NewCodeBuffer:=nil;
4375 if NewFilename='' then begin
4376 // create a new unique filename
4377 SearchFlags:=[siffCheckAllProjects];
4378 if Descriptor.IsPascalUnit then begin
4379 if NewUnitName='' then
4380 NewUnitName:=Descriptor.DefaultSourceName;
4381 NewShortFilename:=lowercase(NewUnitName);
4382 NewFileExt:=Descriptor.DefaultFileExt;
4383 SearchFlags:=SearchFlags+[siffIgnoreExtension];
4384 end else begin
4385 NewFilename:=ExtractFilename(Descriptor.DefaultFilename);
4386 NewShortFilename:=ExtractFilenameOnly(NewFilename);
4387 NewFileExt:=ExtractFileExt(NewFilename);
4388 SearchFlags:=[];
4389 end;
4390 NewFilename:=MainIDE.CreateNewUniqueFilename(NewShortFilename,
4391 NewFileExt,NewOwner,SearchFlags,true);
4392 if NewFilename='' then
4393 RaiseGDBException('');
4394 NewShortFilename:=ExtractFilenameOnly(NewFilename);
4395 // use as unitname the NewShortFilename, but with the case of the
4396 // original unitname. e.g. 'unit12.pas' becomes 'Unit12.pas'
4397 if Descriptor.IsPascalUnit then begin
4398 NewUnitName:=ChompEndNumber(NewUnitName);
4399 NewUnitName:=NewUnitName+copy(NewShortFilename,length(NewUnitName)+1,
4400 length(NewShortFilename));
4401 end;
4402 end;
4403 //debugln('CreateNewCodeBuffer NewFilename=',NewFilename,' NewUnitName=',NewUnitName);
4404
4405 if FilenameIsPascalUnit(NewFilename) then begin
4406 if NewUnitName='' then
4407 NewUnitName:=ExtractFileNameOnly(NewFilename);
4408 if EnvironmentOptions.CharcaseFileAction in [ccfaAsk, ccfaAutoRename] then
4409 NewFilename:=ExtractFilePath(NewFilename)+lowercase(ExtractFileName(NewFilename));
4410 end;
4411
4412 NewCodeBuffer:=CodeToolBoss.CreateFile(NewFilename);
4413 if NewCodeBuffer=nil then
4414 exit(mrCancel);
4415 Result:=mrOk;
4416 end;
4417
4418 function CreateNewForm(NewUnitInfo: TUnitInfo;
4419 AncestorType: TPersistentClass; ResourceCode: TCodeBuffer;
4420 UseCreateFormStatements, DisableAutoSize: Boolean): TModalResult;
4421 var
4422 NewComponent: TComponent;
4423 new_x, new_y: integer;
4424 MainIDEBarBottom: integer;
4425 r: TRect;
4426 begin
4427 if not AncestorType.InheritsFrom(TComponent) then
4428 RaiseGDBException('CreateNewForm invalid AncestorType');
4429
4430 //debugln('CreateNewForm START ',NewUnitInfo.Filename,' ',AncestorType.ClassName,' ',dbgs(ResourceCode<>nil));
4431 // create a buffer for the new resource file and for the LFM file
4432 if ResourceCode=nil then
4433 ResourceCode:=CodeToolBoss.CreateFile(ChangeFileExt(NewUnitInfo.Filename,
4434 ResourceFileExt));
4435 //debugln('CreateNewForm B ',ResourceCode.Filename);
4436 ResourceCode.Source:='{ '+LRSComment+' }';
4437 CodeToolBoss.CreateFile(ChangeFileExt(NewUnitInfo.Filename,'.lfm'));
4438
4439 // clear formeditor
4440 FormEditor1.ClearSelection;
4441
4442 // Figure out where we want to put the new form
4443 // if there is more place left of the OI put it left, otherwise right
4444 if ObjectInspector1<>nil then begin
4445 new_x:=ObjectInspector1.Left+10;
4446 new_y:=ObjectInspector1.Top+10;
4447 end else begin
4448 new_x:=200;
4449 new_y:=100;
4450 end;
4451 if new_x>Screen.Width div 2 then
4452 new_x:=new_x-500
4453 else if ObjectInspector1<>nil then
4454 new_x:=new_x + ObjectInspector1.Width + GetSystemMetrics(SM_CXFRAME) shl 1;
4455 if Assigned(MainIDEBar) then
4456 begin
4457 MainIDEBarBottom:=MainIDEBar.Top+MainIDEBar.Height+GetSystemMetrics(SM_CYFRAME) shl 1
4458 +GetSystemMetrics(SM_CYCAPTION);
4459 if MainIDEBarBottom < Screen.Height div 2 then
4460 new_y:=Max(new_y,MainIDEBarBottom+10);
4461 end;
4462 r:=Screen.PrimaryMonitor.WorkareaRect;
4463 new_x:=Max(r.Left,Min(new_x,r.Right-400));
4464 new_y:=Max(r.Top,Min(new_y,r.Bottom-400));
4465
4466 // create jit component
4467 NewComponent := FormEditor1.CreateComponent(nil,TComponentClass(AncestorType),
4468 NewUnitInfo.CreateUnitName, new_x, new_y, 0,0,DisableAutoSize);
4469 if NewComponent=nil then begin
4470 DebugLn(['CreateNewForm FormEditor1.CreateComponent failed ',dbgsName(TComponentClass(AncestorType))]);
4471 exit(mrCancel);
4472 end;
4473 FormEditor1.SetComponentNameAndClass(NewComponent,
4474 NewUnitInfo.ComponentName,'T'+NewUnitInfo.ComponentName);
4475 if NewComponent is TCustomForm then
4476 TControl(NewComponent).Visible := False;
4477 if (NewComponent is TControl)
4478 and (csSetCaption in TControl(NewComponent).ControlStyle) then
4479 TControl(NewComponent).Caption:=NewComponent.Name;
4480 NewUnitInfo.Component := NewComponent;
4481 MainIDE.CreateDesignerForComponent(NewUnitInfo,NewComponent);
4482 if NewComponent is TCustomDesignControl then
4483 begin
4484 TCustomDesignControl(NewComponent).DesignTimePPI := Screen.PixelsPerInch;
4485 TCustomDesignControl(NewComponent).PixelsPerInch := Screen.PixelsPerInch;
4486 end;
4487
4488 NewUnitInfo.ComponentName:=NewComponent.Name;
4489 NewUnitInfo.ComponentResourceName:=NewUnitInfo.ComponentName;
4490 if UseCreateFormStatements
4491 and ((NewComponent is TCustomForm) or (NewComponent is TDataModule))
4492 and NewUnitInfo.IsPartOfProject
4493 and Project1.AutoCreateForms
4494 and (pfMainUnitHasCreateFormStatements in Project1.Flags) then
4495 begin
4496 Project1.AddCreateFormToProjectFile(NewComponent.ClassName,
4497 NewComponent.Name);
4498 end;
4499 Result:=mrOk;
4500 end;
4501
4502 function NewUniqueComponentName(Prefix: string): string;
4503
4504 function SearchProject(AProject: TProject; const Identifier: string): boolean;
4505 var
4506 i: Integer;
4507 AnUnitInfo: TUnitInfo;
4508 begin
4509 if AProject=nil then exit(false);
4510 Result:=true;
4511 for i:=0 to AProject.UnitCount-1 do
4512 begin
4513 AnUnitInfo:=AProject.Units[i];
4514 if (AnUnitInfo.Component<>nil) then begin
4515 if CompareText(AnUnitInfo.Component.Name,Identifier)=0 then exit;
4516 if CompareText(AnUnitInfo.Component.ClassName,Identifier)=0 then exit;
4517 end else if (AnUnitInfo.ComponentName<>'')
4518 and ((AnUnitInfo.IsPartOfProject) or AnUnitInfo.Loaded) then begin
4519 if SysUtils.CompareText(AnUnitInfo.Unit_Name,Identifier)=0 then exit;
4520 if SysUtils.CompareText(AnUnitInfo.ComponentName,Identifier)=0 then exit;
4521 end;
4522 end;
4523 Result:=false;
4524 end;
4525
4526 function SearchPackage(APackage: TLazPackage; const Identifier: string): boolean;
4527 var
4528 i: Integer;
4529 PkgFile: TPkgFile;
4530 begin
4531 if APackage=nil then exit(false);
4532 Result:=true;
4533 if SysUtils.CompareText(APackage.Name,Identifier)=0 then exit;
4534 for i:=0 to APackage.FileCount-1 do
4535 begin
4536 PkgFile:=APackage.Files[i];
4537 if SysUtils.CompareText(PkgFile.Unit_Name,Identifier)=0 then exit;
4538 end;
4539 Result:=false;
4540 end;
4541
4542 function IdentifierExists(Identifier: string): boolean;
4543 var
4544 i: Integer;
4545 begin
4546 Result:=true;
4547 if GetClass(Identifier)<>nil then exit;
4548 if SearchProject(Project1,Identifier) then exit;
4549 for i:=0 to PackageGraph.Count-1 do
4550 if SearchPackage(PackageGraph[i],Identifier) then exit;
4551 Result:=false;
4552 end;
4553
4554 function IdentifierIsOk(Identifier: string): boolean;
4555 begin
4556 Result:=false;
4557 if not IsValidIdent(Identifier) then exit;
4558 if AllKeyWords.DoIdentifier(PChar(Identifier)) then exit;
4559 if IdentifierExists(Identifier) then exit;
4560 if IdentifierExists('T'+Identifier) then exit;
4561 Result:=true;
4562 end;
4563
4564 var
4565 i: Integer;
4566 begin
4567 if IdentifierIsOk(Prefix) then
4568 exit(Prefix);
4569 while (Prefix<>'') and (Prefix[length(Prefix)] in ['0'..'9']) do
4570 System.Delete(Prefix,length(Prefix),1);
4571 if not IsValidIdent(Prefix) then
4572 Prefix:='Resource';
4573 i:=0;
4574 repeat
4575 inc(i);
4576 Result:=Prefix+IntToStr(i);
4577 until IdentifierIsOk(Result);
4578 end;
4579
4580 function ShowSaveFileAsDialog(var AFilename: string; AnUnitInfo: TUnitInfo;
4581 var LFMCode, LRSCode: TCodeBuffer; CanAbort: boolean): TModalResult;
4582 var
4583 SaveDialog: TSaveDialog;
4584 SrcEdit: TSourceEditor;
4585 SaveAsFilename, SaveAsFileExt: string;
4586 NewFilename, NewFileExt: string;
4587 OldUnitName, NewUnitName: string;
4588 ACaption, AText, APath: string;
4589 Filter, AllEditorExt, AllFilter: string;
4590 begin
4591 if (AnUnitInfo<>nil) and (AnUnitInfo.OpenEditorInfoCount>0) then
4592 SrcEdit := TSourceEditor(AnUnitInfo.OpenEditorInfo[0].EditorComponent)
4593 else
4594 SrcEdit:=nil;
4595 //debugln('ShowSaveFileAsDialog ',AnUnitInfo.Filename);
4596
4597 // try to keep the old filename and extension
4598 SaveAsFileExt:=ExtractFileExt(AFileName);
4599 if (SaveAsFileExt='') and (SrcEdit<>nil) then begin
4600 if (SrcEdit.SyntaxHighlighterType in [lshFreePascal, lshDelphi]) then
4601 SaveAsFileExt:=PascalExtension[EnvironmentOptions.PascalFileExtension]
4602 else
4603 SaveAsFileExt:=EditorOpts.HighlighterList.GetDefaultFilextension(
4604 SrcEdit.SyntaxHighlighterType);
4605 end;
4606 if FilenameIsPascalSource(AFilename) then begin
4607 if AnUnitInfo<>nil then
4608 OldUnitName:=AnUnitInfo.ReadUnitNameFromSource(false)
4609 else
4610 OldUnitName:=ExtractFileNameOnly(AFilename);
4611 end else
4612 OldUnitName:='';
4613 //debugln('ShowSaveFileAsDialog sourceunitname=',OldUnitName);
4614 SaveAsFilename:=OldUnitName;
4615 if SaveAsFilename='' then
4616 SaveAsFilename:=ExtractFileNameOnly(AFilename);
4617 if SaveAsFilename='' then
4618 SaveAsFilename:=lisnoname;
4619
4620 //suggest lowercased name if user wants so
4621 if EnvironmentOptions.LowercaseDefaultFilename = true then
4622 SaveAsFilename:=LowerCase(SaveAsFilename);
4623
4624 // let user choose a filename
4625 SaveDialog:=IDESaveDialogClass.Create(nil);
4626 try
4627 InputHistories.ApplyFileDialogSettings(SaveDialog);
4628 SaveDialog.Title:=lisSaveSpace+SaveAsFilename+' (*'+SaveAsFileExt+')';
4629 SaveDialog.FileName:=SaveAsFilename+SaveAsFileExt;
4630
4631 Filter := dlgFilterLazarusUnit + ' (*.pas;*.pp)|*.pas;*.pp';
4632 if (SaveAsFileExt='.lpi') then
4633 Filter:=Filter+ '|' + dlgFilterLazarusProject + ' (*.lpi)|*.lpi';
4634 if (SaveAsFileExt='.lfm') or (SaveAsFileExt='.dfm') then
4635 Filter:=Filter+ '|' + dlgFilterLazarusForm + ' (*.lfm;*.dfm)|*.lfm;*.dfm';
4636 if (SaveAsFileExt='.lpk') then
4637 Filter:=Filter+ '|' + dlgFilterLazarusPackage + ' (*.lpk)|*.lpk';
4638 if (SaveAsFileExt='.lpr') then
4639 Filter:=Filter+ '|' + dlgFilterLazarusProjectSource + ' (*.lpr)|*.lpr';
4640 // append a filter for all editor files
4641 CreateFileDialogFilterForSourceEditorFiles(Filter,AllEditorExt,AllFilter);
4642 if AllEditorExt<>'' then
4643 Filter:=Filter+ '|' + dlgFilterLazarusEditorFile + ' (' + AllEditorExt + ')|' + AllEditorExt;
4644
4645 // append an any file filter *.*
4646 Filter:=Filter+ '|' + dlgFilterAll + ' (' + GetAllFilesMask + ')|' + GetAllFilesMask;
4647
4648 // prepend an all filter
4649 Filter:= dlgFilterLazarusFile + ' ('+AllFilter+')|' + AllFilter + '|' + Filter;
4650 SaveDialog.Filter := Filter;
4651
4652 // if this is a project file, start in project directory
4653 if (AnUnitInfo=nil)
4654 or (AnUnitInfo.IsPartOfProject and (not Project1.IsVirtual)
4655 and (not PathIsInPath(SaveDialog.InitialDir,Project1.Directory)))
4656 then begin
4657 SaveDialog.InitialDir:=Project1.Directory;
4658 end;
4659 // if this is a package file, then start in package directory
4660 APath:=PkgBoss.GetDefaultSaveDirectoryForFile(AFilename);
4661 if (APath<>'') and (not PathIsInPath(SaveDialog.InitialDir,APath)) then
4662 SaveDialog.InitialDir:=APath;
4663
4664 repeat
4665 Result:=mrCancel;
4666 // show save dialog
4667 if (not SaveDialog.Execute) or (ExtractFileName(SaveDialog.Filename)='') then
4668 exit; // user cancels
4669 NewFilename:=ExpandFileNameUTF8(SaveDialog.Filename);
4670
4671 // check file extension
4672 NewFileExt:=ExtractFileExt(NewFilename);
4673 if NewFileExt='' then begin
4674 NewFileExt:=SaveAsFileExt;
4675 NewFilename:=NewFilename+SaveAsFileExt;
4676 end;
4677
4678 // check file path
4679 APath:=ExtractFilePath(NewFilename);
4680 if not DirPathExists(APath) then begin
4681 ACaption:=lisEnvOptDlgDirectoryNotFound;
4682 AText:=Format(lisTheDestinationDirectoryDoesNotExist, [LineEnding, APath]);
4683 Result:=IDEMessageDialogAb(ACaption, AText, mtConfirmation,[mbCancel],CanAbort);
4684 exit;
4685 end;
4686
4687 // check unitname
4688 if (NewFileExt<>'') and IsPascalUnitExt(PChar(NewFileExt)) then begin
4689 NewUnitName:=ExtractFileNameOnly(NewFilename);
4690 // Do not rename the unit if new filename differs from its name only in case
4691 if LowerCase(OldUnitName)=NewUnitName then
4692 NewUnitName:=OldUnitName;
4693 if NewUnitName='' then
4694 exit(mrCancel);
4695 // Is it a valid name? Ask user.
4696 if not IsValidUnitName(NewUnitName) then
4697 begin
4698 Result:=IDEQuestionDialogAb(lisInvalidPascalIdentifierCap,
4699 Format(lisInvalidPascalIdentifierName,[NewUnitName,LineEnding]),
4700 mtConfirmation, [mrIgnore, lisSave,
4701 mrCancel, lisCancel,
4702 mrRetry, lisChooseADifferentName,
4703 mrAbort, lisAbort], not CanAbort);
4704 if Result=mrRetry then
4705 continue;
4706 if Result in [mrCancel,mrAbort] then
4707 exit;
4708 end;
4709 // Does the project already have such unit?
4710 if Project1.IndexOfUnitWithName(NewUnitName,true,AnUnitInfo)>=0 then
4711 begin
4712 Result:=IDEQuestionDialogAb(lisUnitNameAlreadyExistsCap,
4713 Format(lisTheUnitAlreadyExists, [NewUnitName]),
4714 mtConfirmation, [mrIgnore, lisForceRenaming,
4715 mrCancel, lisCancelRenaming,
4716 mrAbort, lisAbort], not CanAbort);
4717 if Result<>mrIgnore then
4718 exit;
4719 end;
4720 end;
4721 until Result<>mrRetry;
4722 finally
4723 InputHistories.StoreFileDialogSettings(SaveDialog);
4724 SaveDialog.Free;
4725 end;
4726
4727 // check filename
4728 if FilenameIsPascalUnit(NewFilename) then begin
4729 AText:=ExtractFileName(NewFilename);
4730 // check if file should be auto renamed
4731 case EnvironmentOptions.CharcaseFileAction of
4732 ccfaAsk:
4733 if LowerCase(AText)<>AText then begin
4734 Result:=IDEQuestionDialogAb(lisRenameFile,
4735 Format(lisThisLooksLikeAPascalFileItIsRecommendedToUseLowerC,
4736 [LineEnding, LineEnding]),
4737 mtWarning, [mrYes, lisRenameToLowercase,
4738 mrNo, lisKeepName,
4739 mrAbort, lisAbort], not CanAbort);
4740 case Result of
4741 mrYes: NewFileName:=ExtractFilePath(NewFilename)+lowercase(AText);
4742 mrAbort, mrCancel: exit;
4743 end;
4744 Result:=mrOk;
4745 end;
4746 ccfaAutoRename:
4747 NewFileName:=ExtractFilePath(NewFilename)+LowerCase(AText);
4748 ccfaIgnore: ;
4749 end;
4750 end;
4751
4752 // check overwrite existing file
4753 if IDESaveDialogClass.NeedOverwritePrompt
4754 and ((not FilenameIsAbsolute(AFilename))
4755 or (CompareFilenames(NewFilename,AFilename)<>0))
4756 and FileExistsUTF8(NewFilename) then
4757 begin
4758 ACaption:=lisOverwriteFile;
4759 AText:=Format(lisAFileAlreadyExistsReplaceIt, [NewFilename, LineEnding]);
4760 Result:=IDEQuestionDialogAb(ACaption, AText, mtConfirmation,
4761 [mrYes, lisOverwriteFileOnDisk,
4762 mrCancel,
4763 mrAbort, lisAbort], not CanAbort);
4764 if Result=mrCancel then exit;
4765 end;
4766
4767 // check overwrite directory
4768 if DirectoryExistsUTF8(NewFilename) then
4769 begin
4770 Result:=IDEQuestionDialogAb(lisFileIsDirectory,
4771 lisUnableToCreateNewFileBecauseThereIsAlreadyADirecto,
4772 mtError,
4773 [mrCancel,
4774 mrAbort, lisAbort], not CanAbort);
4775 exit;
4776 end;
4777
4778 if AnUnitInfo<>nil then begin
4779 // rename unit
4780 Result:=RenameUnit(AnUnitInfo,NewFilename,NewUnitName,LFMCode,LRSCode);
4781 AFilename:=AnUnitInfo.Filename;
4782 if Result<>mrOk then exit;
4783 end else begin
4784 Result:=mrOk;
4785 AFilename:=NewFilename;
4786 end;
4787 end;
4788
4789 type
4790 TTranslateStringItem = record
4791 Name: String;
4792 Value: String;
4793 end;
4794
4795 TTranslateStrings = class
4796 private
4797 FList: array of TTranslateStringItem;
4798 function CalcHash(const S: string): Cardinal;
4799 function GetSourceBytes(const S: string): string;
4800 function GetValue(const S: string): string;
4801 public
4802 destructor Destroy; override;
4803 procedure Add(const AName, AValue: String);
4804 function Count: Integer;
4805 function Text: String;
4806 end;
4807
4808 TLRJGrubber = class(TObject)
4809 private
4810 FGrubbed: TTranslateStrings;
4811 FWriter: TWriter;
4812 public
4813 constructor Create(TheWriter: TWriter);
4814 destructor Destroy; override;
4815 procedure Grub(Sender: TObject; const Instance: TPersistent;
4816 PropInfo: PPropInfo; var Content: string);
4817 property Grubbed: TTranslateStrings read FGrubbed;
4818 property Writer: TWriter read FWriter write FWriter;
4819 end;
4820
CalcHashnull4821 function TTranslateStrings.CalcHash(const S: string): Cardinal;
4822 var
4823 g: Cardinal;
4824 i: Longint;
4825 begin
4826 Result:=0;
4827 for i:=1 to Length(s) do
4828 begin
4829 Result:=Result shl 4;
4830 inc(Result,Ord(S[i]));
4831 g:=Result and ($f shl 28);
4832 if g<>0 then
4833 begin
4834 Result:=Result xor (g shr 24);
4835 Result:=Result xor g;
4836 end;
4837 end;
4838 If Result=0 then
4839 Result:=$ffffffff;
4840 end;
4841
GetSourceBytesnull4842 function TTranslateStrings.GetSourceBytes(const S: string): string;
4843 var
4844 i, l: Integer;
4845 begin
4846 Result:='';
4847 l:=Length(S);
4848 for i:=1 to l do
4849 begin
4850 Result:=Result+IntToStr(Ord(S[i]));
4851 if i<>l then
4852 Result:=Result+',';
4853 end;
4854 end;
4855
GetValuenull4856 function TTranslateStrings.GetValue(const S: string): string;
4857 var
4858 i, l: Integer;
4859 jsonstr: unicodestring;
4860 begin
4861 Result:='';
4862 //input string is assumed to be in UTF-8 encoding
4863 jsonstr:=UTF8ToUTF16(StringToJSONString(S));
4864 l:=Length(jsonstr);
4865 for i:=1 to l do
4866 begin
4867 if (Ord(jsonstr[i])<32) or (Ord(jsonstr[i])>=127) then
4868 Result:=Result+'\u'+HexStr(Ord(jsonstr[i]), 4)
4869 else
4870 Result:=Result+Char(jsonstr[i]);
4871 end;
4872 end;
4873
4874 destructor TTranslateStrings.Destroy;
4875 begin
4876 SetLength(FList,0);
4877 end;
4878
4879 procedure TTranslateStrings.Add(const AName, AValue: String);
4880 begin
4881 SetLength(FList,Length(FList)+1);
4882 with FList[High(FList)] do
4883 begin
4884 Name:=AName;
4885 Value:=AValue;
4886 end;
4887 end;
4888
Countnull4889 function TTranslateStrings.Count: Integer;
4890 begin
4891 Result:=Length(FList);
4892 end;
4893
Textnull4894 function TTranslateStrings.Text: String;
4895 var
4896 i: Integer;
4897 R: TTranslateStringItem;
4898 begin
4899 Result:='';
4900 if Length(FList)=0 then Exit;
4901 Result:='{"version":1,"strings":['+LineEnding;
4902 for i:=Low(FList) to High(FList) do
4903 begin
4904 R:=TTranslateStringItem(FList[i]);
4905 Result:=Result+'{"hash":'+IntToStr(CalcHash(R.Value))+',"name":"'+R.Name+
4906 '","sourcebytes":['+GetSourceBytes(R.Value)+
4907 '],"value":"'+GetValue(R.Value)+'"}';
4908 if i<High(FList) then
4909 Result:=Result+','+LineEnding
4910 else
4911 Result:=Result+LineEnding;
4912 end;
4913 Result:=Result+']}'+LineEnding;
4914 end;
4915
4916 constructor TLRJGrubber.Create(TheWriter: TWriter);
4917 begin
4918 inherited Create;
4919 FGrubbed:=TTranslateStrings.Create;
4920 FWriter:=TheWriter;
4921 FWriter.OnWriteStringProperty:=@Grub;
4922 end;
4923
4924 destructor TLRJGrubber.Destroy;
4925 begin
4926 FGrubbed.Free;
4927 inherited Destroy;
4928 end;
4929
4930 procedure TLRJGrubber.Grub(Sender: TObject; const Instance: TPersistent;
4931 PropInfo: PPropInfo; var Content: string);
4932 var
4933 LRSWriter: TLRSObjectWriter;
4934 Path: String;
4935 begin
4936 if not Assigned(Instance) then exit;
4937 if not Assigned(PropInfo) then exit;
4938 if SysUtils.CompareText(PropInfo^.PropType^.Name,'TTRANSLATESTRING')<>0 then exit;
4939 if (SysUtils.CompareText(Instance.ClassName,'TMENUITEM')=0) and (Content='-') then exit;
4940 if Writer.Driver is TLRSObjectWriter then begin
4941 LRSWriter:=TLRSObjectWriter(Writer.Driver);
4942 Path:=LRSWriter.GetStackPath;
4943 end else begin
4944 Path:=Instance.ClassName+'.'+PropInfo^.Name;
4945 end;
4946 FGrubbed.Add(LowerCase(Path),Content);
4947 end;
4948
4949 function SaveUnitComponent(AnUnitInfo: TUnitInfo;
4950 LRSCode, LFMCode: TCodeBuffer; Flags: TSaveFlags): TModalResult;
4951
4952 function IsI18NEnabled(UnitOwners: TFPList): boolean;
4953 var
4954 i: Integer;
4955 APackage: TLazPackage;
4956 PkgFile: TPkgFile;
4957 begin
4958 if AnUnitInfo.IsPartOfProject then begin
4959 // a project unit
4960 Result:=AnUnitInfo.Project.EnableI18N and AnUnitInfo.Project.EnableI18NForLFM
4961 and (not AnUnitInfo.DisableI18NForLFM);
4962 exit;
4963 end;
4964 if (UnitOwners<>nil) then begin
4965 for i:=0 to UnitOwners.Count-1 do begin
4966 if TObject(UnitOwners[i]) is TLazPackage then begin
4967 // a package unit
4968 APackage:=TLazPackage(UnitOwners[i]);
4969 Result:=false;
4970 if APackage.EnableI18N and APackage.EnableI18NForLFM then begin
4971 PkgFile:=APackage.FindPkgFile(AnUnitInfo.Filename,true,true);
4972 Result:=(PkgFile<>nil) and (not PkgFile.DisableI18NForLFM);
4973 end;
4974 exit;
4975 end;
4976 end;
4977 end;
4978 // a rogue unit
4979 Result:=false;
4980 end;
4981
4982 var
4983 ComponentSavingOk: boolean;
4984 MemStream, BinCompStream, TxtCompStream: TExtMemoryStream;
4985 DestroyDriver: Boolean;
4986 Writer: TWriter;
4987 ACaption, AText: string;
4988 CompResourceCode, LFMFilename, TestFilename: string;
4989 ADesigner: TIDesigner;
4990 Grubber: TLRJGrubber;
4991 LRJFilename: String;
4992 AncestorUnit: TUnitInfo;
4993 Ancestor: TComponent;
4994 HasI18N: Boolean;
4995 UnitOwners: TFPList;
4996 LRSFilename: String;
4997 PropPath: String;
4998 ResType: TResourceType;
4999 begin
5000 Result:=mrCancel;
5001
5002 // save lrs - lazarus resource file and lfm - lazarus form text file
5003 // Note: When there is a bug in the source, the include directive of the
5004 // resource code can not be found, therefore the LFM file should always
5005 // be saved first.
5006 // And therefore each TUnitInfo stores the resource filename (.lrs).
5007
5008 // the lfm file is saved before the lrs file, because the IDE only needs the
5009 // lfm file to recreate the lrs file.
5010 // by VVI - now a LRT file is saved in addition to LFM and LRS
5011 // LRT file format (in present) are lines
5012 // <ClassName>.<PropertyName>=<PropertyValue>
5013 LRSFilename:='';
5014 ResType:=MainBuildBoss.GetResourceType(AnUnitInfo);
5015 LRSCode:=nil;
5016
5017 if (AnUnitInfo.Component<>nil) then begin
5018 // stream component to resource code and to lfm file
5019 ComponentSavingOk:=true;
5020
5021 // clean up component
5022 Result:=RemoveLooseEvents(AnUnitInfo);
5023 if Result<>mrOk then exit;
5024
5025 // save designer form properties to the component
5026 FormEditor1.SaveHiddenDesignerFormProperties(AnUnitInfo.Component);
5027
5028 if ResType=rtLRS then begin
5029 if (sfSaveToTestDir in Flags) then
5030 LRSFilename:=MainBuildBoss.GetDefaultLRSFilename(AnUnitInfo)
5031 else
5032 LRSFilename:=MainBuildBoss.FindLRSFilename(AnUnitInfo,true);
5033 end;
5034
5035 // stream component to binary stream
5036 BinCompStream:=TExtMemoryStream.Create;
5037 if AnUnitInfo.ComponentLastBinStreamSize>0 then
5038 BinCompStream.Capacity:=AnUnitInfo.ComponentLastBinStreamSize+LRSStreamChunkSize;
5039 Writer:=nil;
5040 DestroyDriver:=false;
5041 Grubber:=nil;
5042 UnitOwners:=nil;
5043 try
5044 UnitOwners:=PkgBoss.GetOwnersOfUnit(AnUnitInfo.Filename);
5045 Result:=mrOk;
5046 repeat
5047 try
5048 BinCompStream.Position:=0;
5049 Writer:=AnUnitInfo.UnitResourceFileformat.CreateWriter(BinCompStream,DestroyDriver);
5050 // used to save lrj files
5051 HasI18N:=IsI18NEnabled(UnitOwners);
5052 if HasI18N then
5053 Grubber:=TLRJGrubber.Create(Writer);
5054 Writer.OnWriteMethodProperty:=@FormEditor1.WriteMethodPropertyEvent;
5055 //DebugLn(['SaveUnitComponent AncestorInstance=',dbgsName(AncestorInstance)]);
5056 Writer.OnFindAncestor:=@FormEditor1.WriterFindAncestor;
5057 AncestorUnit:=AnUnitInfo.FindAncestorUnit;
5058 Ancestor:=nil;
5059 if AncestorUnit<>nil then
5060 Ancestor:=AncestorUnit.Component;
5061 //DebugLn(['SaveUnitComponent Writer.WriteDescendent ARoot=',AnUnitInfo.Component,' Ancestor=',DbgSName(Ancestor)]);
5062 if AnUnitInfo.Component is TCustomDesignControl then // set DesignTimePPI on save
5063 TCustomDesignControl(AnUnitInfo.Component).DesignTimePPI := TCustomDesignControl(AnUnitInfo.Component).PixelsPerInch;
5064 Writer.WriteDescendent(AnUnitInfo.Component,Ancestor);
5065 if DestroyDriver then
5066 Writer.Driver.Free;
5067 FreeAndNil(Writer);
5068 AnUnitInfo.ComponentLastBinStreamSize:=BinCompStream.Size;
5069 except
5070 on E: Exception do begin
5071 PropPath:='';
5072 if Writer.Driver is TLRSObjectWriter then
5073 PropPath:=TLRSObjectWriter(Writer.Driver).GetStackPath;
5074 DumpExceptionBackTrace;
5075 ACaption:=lisStreamingError;
5076 AText:=Format(lisUnableToStreamT, [AnUnitInfo.ComponentName,
5077 AnUnitInfo.ComponentName]) + LineEnding + E.Message;
5078 if PropPath<>'' then
5079 AText := Atext + LineEnding + LineEnding + lisPathToInstance
5080 + LineEnding + PropPath;
5081 Result:=IDEMessageDialog(ACaption, AText, mtError,
5082 [mbAbort, mbRetry, mbIgnore]);
5083 if Result=mrAbort then exit;
5084 if Result=mrIgnore then Result:=mrOk;
5085 ComponentSavingOk:=false;
5086 end;
5087 end;
5088 until Result<>mrRetry;
5089
5090 // create lazarus form resource code
5091 if ComponentSavingOk and (LRSFilename<>'') then begin
5092 if LRSCode=nil then begin
5093 LRSCode:=CodeToolBoss.CreateFile(LRSFilename);
5094 ComponentSavingOk:=(LRSCode<>nil);
5095 end;
5096 if ComponentSavingOk then begin
5097 // there is no bug in the source, so the resource code should be changed too
5098 MemStream:=TExtMemoryStream.Create;
5099 if AnUnitInfo.ComponentLastLRSStreamSize>0 then
5100 MemStream.Capacity:=AnUnitInfo.ComponentLastLRSStreamSize+LRSStreamChunkSize;
5101 try
5102 BinCompStream.Position:=0;
5103 BinaryToLazarusResourceCode(BinCompStream,MemStream
5104 ,'T'+AnUnitInfo.ComponentName,'FORMDATA');
5105 AnUnitInfo.ComponentLastLRSStreamSize:=MemStream.Size;
5106 MemStream.Position:=0;
5107 SetLength(CompResourceCode{%H-},MemStream.Size);
5108 MemStream.Read(CompResourceCode[1],length(CompResourceCode));
5109 finally
5110 MemStream.Free;
5111 end;
5112 end;
5113 if ComponentSavingOk then begin
5114 {$IFDEF IDE_DEBUG}
5115 debugln('SaveUnitComponent E ',CompResourceCode);
5116 {$ENDIF}
5117 // replace lazarus form resource code in include file (.lrs)
5118 if not (sfSaveToTestDir in Flags) then begin
5119 // if resource name has changed, delete old resource
5120 if (AnUnitInfo.ComponentName<>AnUnitInfo.ComponentResourceName)
5121 and (AnUnitInfo.ComponentResourceName<>'') then begin
5122 CodeToolBoss.RemoveLazarusResource(LRSCode,
5123 'T'+AnUnitInfo.ComponentResourceName);
5124 end;
5125 // add comment to resource file (if not already exists)
5126 if (not CodeToolBoss.AddLazarusResourceHeaderComment(LRSCode,LRSComment)) then
5127 begin
5128 ACaption:=lisResourceSaveError;
5129 AText:=Format(lisUnableToAddResourceHeaderCommentToResourceFile, [
5130 LineEnding, LRSCode.FileName, LineEnding]);
5131 Result:=IDEMessageDialog(ACaption,AText,mtError,[mbIgnore,mbAbort]);
5132 if Result<>mrIgnore then exit;
5133 end;
5134 // add resource to resource file
5135 if (not CodeToolBoss.AddLazarusResource(LRSCode,
5136 'T'+AnUnitInfo.ComponentName,CompResourceCode)) then
5137 begin
5138 ACaption:=lisResourceSaveError;
5139 AText:=Format(lisUnableToAddResourceTFORMDATAToResourceFileProbably,
5140 [AnUnitInfo.ComponentName, LineEnding, LRSCode.FileName, LineEnding] );
5141 Result:=IDEMessageDialog(ACaption, AText, mtError, [mbIgnore, mbAbort]);
5142 if Result<>mrIgnore then exit;
5143 end else begin
5144 AnUnitInfo.ComponentResourceName:=AnUnitInfo.ComponentName;
5145 end;
5146 end else begin
5147 LRSCode.Source:=CompResourceCode;
5148 end;
5149 end;
5150 end;
5151 if ComponentSavingOk then begin
5152 if (not AnUnitInfo.IsVirtual) or (sfSaveToTestDir in Flags) then
5153 begin
5154 // save lfm file
5155 LFMFilename:=AnUnitInfo.UnitResourceFileformat.GetUnitResourceFilename(AnUnitInfo.Filename,false);
5156 if AnUnitInfo.IsVirtual then
5157 LFMFilename:=AppendPathDelim(MainBuildBoss.GetTestBuildDirectory)+LFMFilename;
5158 if LFMCode=nil then begin
5159 LFMCode:=CodeToolBoss.CreateFile(LFMFilename);
5160 if LFMCode=nil then begin
5161 Result:=IDEQuestionDialog(lisUnableToCreateFile,
5162 Format(lisUnableToCreateFile2, [LFMFilename]),
5163 mtWarning, [mrIgnore, lisContinueWithoutLoadingForm,
5164 mrCancel, lisCancelLoadingUnit,
5165 mrAbort, lisAbortAllLoading]);
5166 if Result<>mrIgnore then exit;
5167 end;
5168 end;
5169 if (LFMCode<>nil) then begin
5170 {$IFDEF IDE_DEBUG}
5171 debugln('SaveUnitComponent E2 LFM=',LFMCode.Filename);
5172 {$ENDIF}
5173 if (ResType=rtRes) and (LFMCode.DiskEncoding<>EncodingUTF8) then
5174 begin
5175 // the .lfm file is used by fpcres, which only supports UTF8 without BOM
5176 DebugLn(['SaveUnitComponent fixing encoding of ',LFMCode.Filename,' from ',LFMCode.DiskEncoding,' to ',EncodingUTF8]);
5177 LFMCode.DiskEncoding:=EncodingUTF8;
5178 end;
5179
5180 Result:=mrOk;
5181 repeat
5182 try
5183 // transform binary to text
5184 TxtCompStream:=TExtMemoryStream.Create;
5185 if AnUnitInfo.ComponentLastLFMStreamSize>0 then
5186 TxtCompStream.Capacity:=AnUnitInfo.ComponentLastLFMStreamSize
5187 +LRSStreamChunkSize;
5188 try
5189 BinCompStream.Position:=0;
5190 AnUnitInfo.UnitResourceFileformat.BinStreamToTextStream(BinCompStream,TxtCompStream);
5191 AnUnitInfo.ComponentLastLFMStreamSize:=TxtCompStream.Size;
5192 // stream text to file
5193 TxtCompStream.Position:=0;
5194 LFMCode.LoadFromStream(TxtCompStream);
5195 Result:=SaveCodeBufferToFile(LFMCode,LFMCode.Filename,true);
5196 if not Result=mrOk then exit;
5197 Result:=mrCancel;
5198 finally
5199 TxtCompStream.Free;
5200 end;
5201 except
5202 on E: Exception do begin
5203 // added to get more feedback on issue 7009
5204 Debugln('SaveFileResources E3: ', E.Message);
5205 DumpExceptionBackTrace;
5206 ACaption:=lisStreamingError;
5207 AText:=Format(
5208 lisUnableToTransformBinaryComponentStreamOfTIntoText, [
5209 AnUnitInfo.ComponentName, AnUnitInfo.ComponentName])
5210 +LineEnding+E.Message;
5211 Result:=IDEMessageDialog(ACaption, AText, mtError,
5212 [mbAbort, mbRetry, mbIgnore]);
5213 if Result=mrAbort then exit;
5214 if Result=mrIgnore then Result:=mrOk;
5215 end;
5216 end;
5217 until Result<>mrRetry;
5218 end;
5219 end;
5220 end;
5221 // Now the most important file (.lfm) is saved.
5222 // Now save the secondary files
5223
5224 // save the .lrj file containing the list of all translatable strings of
5225 // the component
5226 if ComponentSavingOk
5227 and (Grubber<>nil) and (Grubber.Grubbed.Count>0)
5228 and (not (sfSaveToTestDir in Flags))
5229 and (not AnUnitInfo.IsVirtual) then begin
5230 LRJFilename:=ChangeFileExt(AnUnitInfo.Filename,'.lrj');
5231 DebugLn(['SaveUnitComponent save lrj: ',LRJFilename]);
5232 Result:=SaveStringToFile(LRJFilename,Grubber.Grubbed.Text,
5233 [mbIgnore,mbAbort],AnUnitInfo.Filename);
5234 if (Result<>mrOk) and (Result<>mrIgnore) then exit;
5235 end;
5236
5237 finally
5238 try
5239 FreeAndNil(BinCompStream);
5240 if DestroyDriver and (Writer<>nil) then Writer.Driver.Free;
5241 FreeAndNil(Writer);
5242 FreeAndNil(Grubber);
5243 FreeAndNil(UnitOwners);
5244 except
5245 on E: Exception do begin
5246 debugln('SaveUnitComponent Error cleaning up: ',E.Message);
5247 end;
5248 end;
5249 end;
5250 end;
5251 {$IFDEF IDE_DEBUG}
5252 if ResourceCode<>nil then
5253 debugln('SaveUnitComponent F ',ResourceCode.Modified);
5254 {$ENDIF}
5255 // save binary stream (.lrs)
5256 if LRSCode<>nil then begin
5257 if (not (sfSaveToTestDir in Flags)) then
5258 begin
5259 if (LRSCode.Modified) then begin
5260 if FilenameIsAbsolute(LRSCode.Filename) then
5261 LRSFilename:=LRSCode.Filename
5262 else if LRSFilename='' then
5263 LRSFilename:=MainBuildBoss.FindLRSFilename(AnUnitInfo,true);
5264 if (LRSFilename<>'') and FilenameIsAbsolute(LRSFilename) then
5265 begin
5266 Result:=ForceDirectoryInteractive(ExtractFilePath(LRSFilename),[mbRetry]);
5267 if not Result=mrOk then exit;
5268 Result:=SaveCodeBufferToFile(LRSCode,LRSFilename);
5269 if not Result=mrOk then exit;
5270 end;
5271 end;
5272 end else begin
5273 TestFilename:=MainBuildBoss.GetTestUnitFilename(AnUnitInfo);
5274 LRSFilename:=ChangeFileExt(TestFilename,ExtractFileExt(LRSCode.Filename));
5275 Result:=SaveCodeBufferToFile(LRSCode,LRSFilename);
5276 if not Result=mrOk then exit;
5277 end;
5278 end;
5279 // mark designer unmodified
5280 ADesigner:=FindRootDesigner(AnUnitInfo.Component);
5281 if ADesigner<>nil then
5282 ADesigner.DefaultFormBoundsValid:=false;
5283
5284 Result:=mrOk;
5285 {$IFDEF IDE_DEBUG}
5286 debugln('SaveUnitComponent G ',LFMCode<>nil);
5287 {$ENDIF}
5288 end;
5289
5290 function RemoveLooseEvents(AnUnitInfo: TUnitInfo): TModalResult;
5291 var
5292 ComponentModified: boolean;
5293 ActiveSrcEdit: TSourceEditor;
5294 ActiveUnitInfo: TUnitInfo;
5295 begin
5296 Result:=mrOk;
5297 if (AnUnitInfo.Component=nil) then exit;
5298 ActiveSrcEdit:=nil;
5299 if not MainIDE.BeginCodeTool(ActiveSrcEdit,ActiveUnitInfo,[]) then exit;
5300 // unselect methods in ObjectInspector1
5301 if (ObjectInspector1<>nil)
5302 and (ObjectInspector1.PropertyEditorHook.LookupRoot=AnUnitInfo.Component) then
5303 begin
5304 ObjectInspector1.EventGrid.ItemIndex:=-1;
5305 ObjectInspector1.FavoriteGrid.ItemIndex:=-1;
5306 end;
5307 //debugln('RemoveLooseEvents ',AnUnitInfo.Filename,' ',dbgsName(AnUnitInfo.Component));
5308 // remove dangling methods
5309 Result:=RemoveDanglingEvents(AnUnitInfo.Component, AnUnitInfo.Source, True,
5310 ComponentModified);
5311 // update ObjectInspector1
5312 if ComponentModified
5313 and (ObjectInspector1<>nil)
5314 and (ObjectInspector1.PropertyEditorHook.LookupRoot=AnUnitInfo.Component) then
5315 begin
5316 ObjectInspector1.EventGrid.RefreshPropertyValues;
5317 ObjectInspector1.FavoriteGrid.RefreshPropertyValues;
5318 end;
5319 end;
5320
5321 function RenameUnit(AnUnitInfo: TUnitInfo; NewFilename, NewUnitName: string;
5322 var LFMCode, LRSCode: TCodeBuffer): TModalResult;
5323 var
5324 NewSource: TCodeBuffer;
5325 NewLFMFilename, NewLRSFilename: String;
5326 NewFilePath, NewLRSFilePath: String;
5327 OldFilename, OldLFMFilename, OldLRSFilename, OldPPUFilename: String;
5328 OldFilePath, OldLRSFilePath: String;
5329 OldSourceCode, OldUnitPath: String;
5330 AmbiguousFilename, OutDir, S: string;
5331 NewHighlighter: TLazSyntaxHighlighter;
5332 AmbiguousFiles: TStringList;
5333 i: Integer;
5334 Owners: TFPList;
5335 OldFileExisted: Boolean;
5336 ConvTool: TConvDelphiCodeTool;
5337 AEditor: TSourceEditor;
5338 begin
5339 // Project is marked as changed already here.
5340 Project1.BeginUpdate(true);
5341 try
5342 // notify IDE addons
5343 Result:=MainIDEInterface.CallSaveEditorFileHandler(LazarusIDE,AnUnitInfo,
5344 sefsSaveAs,NewFilename);
5345 if Result<>mrOk then exit;
5346
5347 OldFilename:=AnUnitInfo.Filename;
5348 OldFilePath:=ExtractFilePath(OldFilename);
5349 OldLFMFilename:='';
5350 // ToDo: use UnitResources
5351 if FilenameHasPascalExt(OldFilename) then begin
5352 OldLFMFilename:=ChangeFileExt(OldFilename,'.lfm');
5353 if not FileExistsUTF8(OldLFMFilename) then
5354 OldLFMFilename:=ChangeFileExt(OldFilename,'.dfm');
5355 end;
5356 if NewUnitName='' then
5357 NewUnitName:=AnUnitInfo.Unit_Name;
5358 debugln(['Hint: (lazarus) RenameUnit ',AnUnitInfo.Filename,' NewUnitName=',NewUnitName,' OldUnitName=',AnUnitInfo.Unit_Name,' LFMCode=',LFMCode<>nil,' LRSCode=',LRSCode<>nil,' NewFilename="',NewFilename,'"']);
5359
5360 // check new resource file
5361 NewLFMFilename:='';
5362 if FilenameHasPascalExt(NewFilename) then
5363 NewLFMFilename:=ChangeFileExt(NewFilename,'.lfm');
5364 if AnUnitInfo.ComponentName='' then begin
5365 // unit has no component
5366 // -> remove lfm file, so that it will not be auto loaded on next open
5367 if (FileExistsUTF8(NewLFMFilename))
5368 and (not DeleteFileUTF8(NewLFMFilename))
5369 and (IDEMessageDialog(lisPkgMangDeleteFailed,
5370 Format(lisDeletingOfFileFailed, [NewLFMFilename]),
5371 mtError, [mbIgnore, mbCancel])=mrCancel)
5372 then
5373 exit(mrCancel);
5374 end;
5375
5376 // create new source with the new filename
5377 OldSourceCode:=AnUnitInfo.Source.Source;
5378 NewSource:=CodeToolBoss.CreateFile(NewFilename);
5379 if NewSource=nil then begin
5380 Result:=IDEMessageDialog(lisUnableToCreateFile,
5381 Format(lisCanNotCreateFile, [NewFilename]),
5382 mtError,[mbCancel,mbAbort]);
5383 exit;
5384 end;
5385 NewSource.Source:=OldSourceCode;
5386 if (AnUnitInfo.Source.DiskEncoding<>'') and (AnUnitInfo.Source.DiskEncoding<>EncodingUTF8)
5387 then begin
5388 NewSource.DiskEncoding:=AnUnitInfo.Source.DiskEncoding;
5389 InputHistories.FileEncodings[NewFilename]:=NewSource.DiskEncoding;
5390 end else
5391 InputHistories.FileEncodings.Remove(NewFilename);
5392
5393 // get final filename
5394 NewFilename:=NewSource.Filename;
5395 NewFilePath:=ExtractFilePath(NewFilename);
5396 EnvironmentOptions.RemoveFromRecentOpenFiles(OldFilename);
5397 EnvironmentOptions.AddToRecentOpenFiles(NewFilename);
5398 MainIDE.SetRecentFilesMenu;
5399
5400 // add new path to unit path
5401 if AnUnitInfo.IsPartOfProject and FilenameHasPascalExt(NewFilename)
5402 and (CompareFilenames(NewFilePath,Project1.Directory)<>0) then begin
5403 OldUnitPath:=Project1.CompilerOptions.GetUnitPath(false);
5404 if SearchDirectoryInSearchPath(OldUnitPath,NewFilePath,1)<1 then
5405 AddPathToBuildModes(NewFilePath, False);
5406 end;
5407
5408 // rename lfm file
5409 if FilenameIsAbsolute(NewLFMFilename) then begin
5410 if (LFMCode=nil)
5411 and (OldLFMFilename<>'')
5412 and FilenameIsAbsolute(OldLFMFilename) and FileExistsUTF8(OldLFMFilename) then
5413 LFMCode:=CodeToolBoss.LoadFile(OldLFMFilename,false,false);
5414 if (LFMCode<>nil) then begin
5415 Result:=SaveCodeBufferToFile(LFMCode,NewLFMFilename,true);
5416 if not (Result in [mrOk,mrIgnore]) then begin
5417 DebugLn(['RenameUnit SaveCodeBufferToFile failed for "',NewLFMFilename,'"']);
5418 exit;
5419 end;
5420 LFMCode:=CodeToolBoss.LoadFile(NewLFMFilename,true,false);
5421 if LFMCode<>nil then
5422 NewLFMFilename:=LFMCode.Filename;
5423 ConvTool:=TConvDelphiCodeTool.Create(NewSource);
5424 try
5425 if not ConvTool.RenameResourceDirectives then
5426 debugln(['RenameUnit WARNING: unable to rename resource directive in "',NewSource.Filename,'"']);
5427 finally
5428 ConvTool.Free;
5429 end;
5430 end;
5431 end;
5432
5433 // rename Resource file (.lrs)
5434 if (LRSCode<>nil) then begin
5435 // the resource include line in the code will be changed later after
5436 // changing the unitname
5437 if AnUnitInfo.IsPartOfProject
5438 and (not Project1.IsVirtual)
5439 and (pfLRSFilesInOutputDirectory in Project1.Flags) then begin
5440 NewLRSFilename:=MainBuildBoss.GetDefaultLRSFilename(AnUnitInfo);
5441 NewLRSFilename:=AppendPathDelim(ExtractFilePath(NewLRSFilename))
5442 +ExtractFileNameOnly(NewFilename)+ResourceFileExt;
5443 end else begin
5444 OldLRSFilePath:=ExtractFilePath(LRSCode.Filename);
5445 NewLRSFilePath:=OldLRSFilePath;
5446 if FilenameIsAbsolute(OldFilePath)
5447 and PathIsInPath(OldLRSFilePath,OldFilePath) then begin
5448 // resource code was in the same or in a sub directory of source
5449 // -> try to keep this relationship
5450 NewLRSFilePath:=NewFilePath
5451 +copy(LRSCode.Filename,length(OldFilePath)+1,length(LRSCode.Filename));
5452 if not DirPathExists(NewLRSFilePath) then
5453 NewLRSFilePath:=NewFilePath;
5454 end else begin
5455 // resource code was not in the same or in a sub directory of source
5456 // copy resource into the same directory as the source
5457 NewLRSFilePath:=NewFilePath;
5458 end;
5459 NewLRSFilename:=NewLRSFilePath+ExtractFileNameOnly(NewFilename)+ResourceFileExt;
5460 end;
5461 Result:=ForceDirectoryInteractive(ExtractFilePath(NewLRSFilename),[mbRetry,mbIgnore]);
5462 if Result=mrCancel then exit;
5463 if Result=mrOk then begin
5464 if not CodeToolBoss.SaveBufferAs(LRSCode,NewLRSFilename,LRSCode) then
5465 DebugLn(['RenameUnit CodeToolBoss.SaveBufferAs failed: NewResFilename="',NewLRSFilename,'"']);
5466 end;
5467
5468 {$IFDEF IDE_DEBUG}
5469 debugln(['RenameUnit C ',ResourceCode<>nil]);
5470 debugln([' NewResFilePath="',NewResFilePath,'" NewResFilename="',NewResFilename,'"']);
5471 if ResourceCode<>nil then debugln('*** ResourceFileName ',ResourceCode.Filename);
5472 {$ENDIF}
5473 end else begin
5474 NewLRSFilename:='';
5475 end;
5476 // rename unit name of jit class
5477 if (AnUnitInfo.Component<>nil) then
5478 FormEditor1.RenameJITComponentUnitname(AnUnitInfo.Component,NewUnitName);
5479 {$IFDEF IDE_DEBUG}
5480 if AnUnitInfo.Component<>nil then debugln('*** AnUnitInfo.Component ',dbgsName(AnUnitInfo.Component),' ClassUnitname=',GetClassUnitName(AnUnitInfo.Component.ClassType));
5481 debugln(['RenameUnit D ',ResourceCode<>nil]);
5482 {$ENDIF}
5483
5484 // set new codebuffer in unitinfo and sourceeditor
5485 AnUnitInfo.Source:=NewSource;
5486 if AnUnitInfo.IsPartOfProject then
5487 Project1.Modified:=true
5488 else
5489 Project1.SessionModified:=true;
5490 AnUnitInfo.ClearModifieds;
5491 for i := 0 to AnUnitInfo.EditorInfoCount -1 do begin
5492 AEditor := TSourceEditor(AnUnitInfo.EditorInfo[i].EditorComponent);
5493 if AEditor <> nil then begin
5494 // the code is not changed, therefore the marks are kept
5495 AEditor.CodeBuffer := NewSource;
5496 // change unitname on SourceNotebook
5497 S := CreateSrcEditPageName(NewUnitName, AnUnitInfo.Filename, AEditor);
5498 AEditor.PageName := S;
5499 end;
5500 end;
5501
5502 // change unitname in lpi and in main source file
5503 AnUnitInfo.Unit_Name:=NewUnitName;
5504 if LRSCode<>nil then begin
5505 // change resource filename in the source include directive
5506 if not CodeToolBoss.RenameMainInclude(AnUnitInfo.Source,
5507 ExtractFilename(LRSCode.Filename),false)
5508 then
5509 DebugLn(['RenameUnit CodeToolBoss.RenameMainInclude failed: AnUnitInfo.Source="',AnUnitInfo.Source,'" ResourceCode="',ExtractFilename(LRSCode.Filename),'"']);
5510 end;
5511
5512 // change syntax highlighter
5513 NewHighlighter:=FilenameToLazSyntaxHighlighter(NewFilename);
5514 AnUnitInfo.UpdateDefaultHighlighter(NewHighlighter);
5515 for i := 0 to AnUnitInfo.EditorInfoCount - 1 do
5516 if (AnUnitInfo.EditorInfo[i].EditorComponent <> nil) and
5517 (not AnUnitInfo.EditorInfo[i].CustomHighlighter)
5518 then
5519 TSourceEditor(AnUnitInfo.EditorInfo[i].EditorComponent).SyntaxHighlighterType :=
5520 AnUnitInfo.EditorInfo[i].SyntaxHighlighter;
5521
5522 // save file
5523 if not NewSource.IsVirtual then begin
5524 // notify packages
5525 Result:=MainIDEInterface.CallSaveEditorFileHandler(LazarusIDE,AnUnitInfo,sefsBeforeWrite);
5526 if Result<>mrOk then exit;
5527 // actual write
5528 Result:=AnUnitInfo.WriteUnitSource;
5529 if Result<>mrOk then exit;
5530 AnUnitInfo.Modified:=false;
5531 // notify packages
5532 Result:=MainIDEInterface.CallSaveEditorFileHandler(LazarusIDE,AnUnitInfo,sefsAfterWrite);
5533 if Result<>mrOk then exit;
5534 end;
5535
5536 // change lpks containing the file
5537 Result:=PkgBoss.OnRenameFile(OldFilename,AnUnitInfo.Filename,
5538 AnUnitInfo.IsPartOfProject);
5539 if Result=mrAbort then exit;
5540
5541 OldFileExisted:=FilenameIsAbsolute(OldFilename) and FileExistsUTF8(OldFilename);
5542
5543 // delete ambiguous files
5544 AmbiguousFiles:=
5545 FindFilesCaseInsensitive(NewFilePath,ExtractFilename(NewFilename),true);
5546 if AmbiguousFiles<>nil then begin
5547 try
5548 if (AmbiguousFiles.Count=1)
5549 and (CompareFilenames(OldFilePath,NewFilePath)=0)
5550 and (CompareFilenames(AmbiguousFiles[0],ExtractFilename(OldFilename))=0)
5551 then
5552 S:=Format(lisDeleteOldFile, [ExtractFilename(OldFilename)])
5553 else
5554 S:=Format(lisThereAreOtherFilesInTheDirectoryWithTheSameName,
5555 [LineEnding, LineEnding, AmbiguousFiles.Text, LineEnding]);
5556 Result:=IDEMessageDialog(lisAmbiguousFilesFound, S,
5557 mtWarning,[mbYes,mbNo,mbAbort]);
5558 if Result=mrAbort then exit;
5559 if Result=mrYes then begin
5560 NewFilePath:=AppendPathDelim(ExtractFilePath(NewFilename));
5561 for i:=0 to AmbiguousFiles.Count-1 do begin
5562 AmbiguousFilename:=NewFilePath+AmbiguousFiles[i];
5563 if (FileExistsUTF8(AmbiguousFilename))
5564 and (not DeleteFileUTF8(AmbiguousFilename))
5565 and (IDEMessageDialog(lisPkgMangDeleteFailed,
5566 Format(lisDeletingOfFileFailed, [AmbiguousFilename]),
5567 mtError, [mbIgnore, mbCancel])=mrCancel)
5568 then
5569 exit(mrCancel);
5570 end;
5571 end;
5572 finally
5573 AmbiguousFiles.Free;
5574 end;
5575 end;
5576
5577 // remove old path from unit path
5578 if AnUnitInfo.IsPartOfProject and FilenameHasPascalExt(OldFilename)
5579 and (OldFilePath<>'') then begin
5580 //DebugLn('RenameUnit OldFilePath="',OldFilePath,'" SourceDirs="',Project1.SourceDirectories.CreateSearchPathFromAllFiles,'"');
5581 if (SearchDirectoryInSearchPath(
5582 Project1.SourceDirectories.CreateSearchPathFromAllFiles,OldFilePath,1)<1)
5583 then
5584 //DebugLn('RenameUnit OldFilePath="',OldFilePath,'" UnitPath="',Project1.CompilerOptions.GetUnitPath(false),'"');
5585 if (SearchDirectoryInSearchPath(Project1.CompilerOptions.GetUnitPath(false),OldFilePath,1)<1)
5586 then
5587 if IDEMessageDialog(lisCleanUpUnitPath,
5588 Format(lisTheDirectoryIsNoLongerNeededInTheUnitPathRemoveIt,[OldFilePath,LineEnding]),
5589 mtConfirmation,[mbYes,mbNo])=mrYes
5590 then
5591 Project1.CompilerOptions.RemoveFromUnitPaths(OldUnitPath);
5592 end;
5593
5594 // delete old pas, .pp, .ppu
5595 if (CompareFilenames(NewFilename,OldFilename)<>0)
5596 and OldFileExisted then begin
5597 if IDEMessageDialog(lisDeleteOldFile2, Format(lisDeleteOldFile,[OldFilename]),
5598 mtConfirmation,[mbYes,mbNo])=mrYes then
5599 begin
5600 Result:=DeleteFileInteractive(OldFilename,[mbAbort]);
5601 if Result=mrAbort then exit;
5602 // delete old lfm
5603 //debugln(['RenameUnit NewLFMFilename=',NewLFMFilename,' exists=',FileExistsUTF8(NewLFMFilename),' Old=',OldLFMFilename,' exists=',FileExistsUTF8(OldLFMFilename)]);
5604 if FileExistsUTF8(NewLFMFilename) then begin
5605 // the new file has a lfm, so it is safe to delete the old
5606 // (if NewLFMFilename does not exist, it didn't belong to the unit
5607 // or there was an error during delete. Never delete files in doubt.)
5608 OldLFMFilename:=ChangeFileExt(OldFilename,'.lfm');
5609 if FileExistsUTF8(OldLFMFilename) then begin
5610 Result:=DeleteFileInteractive(OldLFMFilename,[mbAbort]);
5611 if Result=mrAbort then exit;
5612 end;
5613 end;
5614 // delete old lrs
5615 if (LRSCode<>nil) and FileExistsUTF8(LRSCode.Filename) then begin
5616 // the new file has a lrs, so it is safe to delete the old
5617 // (if the new lrs does not exist, it didn't belong to the unit
5618 // or there was an error during delete. Never delete files in doubt.)
5619 OldLRSFilename:=ChangeFileExt(OldFilename,ResourceFileExt);
5620 if FileExistsUTF8(OldLRSFilename) then begin
5621 Result:=DeleteFileInteractive(OldLRSFilename,[mbAbort]);
5622 if Result=mrAbort then exit;
5623 end;
5624 end;
5625 // delete ppu in source directory
5626 OldPPUFilename:=ChangeFileExt(OldFilename,'.ppu');
5627 if FileExistsUTF8(OldPPUFilename) then begin
5628 Result:=DeleteFileInteractive(OldPPUFilename,[mbAbort]);
5629 if Result=mrAbort then exit;
5630 end;
5631 OldPPUFilename:=ChangeFileExt(OldPPUFilename,'.o');
5632 if FileExistsUTF8(OldPPUFilename) then begin
5633 Result:=DeleteFileInteractive(OldPPUFilename,[mbAbort]);
5634 if Result=mrAbort then exit;
5635 end;
5636 Owners:=PkgBoss.GetOwnersOfUnit(NewFilename);
5637 try
5638 if Owners<>nil then begin
5639 for i:=0 to Owners.Count-1 do begin
5640 OutDir:='';
5641 if TObject(Owners[i]) is TProject then begin
5642 // delete old files in project output directory
5643 OutDir:=TProject(Owners[i]).CompilerOptions.GetUnitOutPath(false);
5644 end else if TObject(Owners[i]) is TLazPackage then begin
5645 // delete old files in package output directory
5646 OutDir:=TLazPackage(Owners[i]).CompilerOptions.GetUnitOutPath(false);
5647 end;
5648 if (OutDir<>'') and FilenameIsAbsolute(OutDir) then begin
5649 OldPPUFilename:=AppendPathDelim(OutDir)+ChangeFileExt(ExtractFilename(OldFilename),'.ppu');
5650 if FileExistsUTF8(OldPPUFilename) then begin
5651 Result:=DeleteFileInteractive(OldPPUFilename,[mbAbort]);
5652 if Result=mrAbort then exit;
5653 end;
5654 OldPPUFilename:=ChangeFileExt(OldPPUFilename,'.o');
5655 if FileExistsUTF8(OldPPUFilename) then begin
5656 Result:=DeleteFileInteractive(OldPPUFilename,[mbAbort]);
5657 if Result=mrAbort then exit;
5658 end;
5659 OldLRSFilename:=ChangeFileExt(OldPPUFilename,ResourceFileExt);
5660 if FileExistsUTF8(OldLRSFilename) then begin
5661 Result:=DeleteFileInteractive(OldLRSFilename,[mbAbort]);
5662 if Result=mrAbort then exit;
5663 end;
5664 end;
5665 end;
5666 end;
5667 finally
5668 Owners.Free;
5669 end;
5670 end;
5671 end;
5672
5673 // notify IDE addons
5674 Result:=MainIDEInterface.CallSaveEditorFileHandler(LazarusIDE,AnUnitInfo,
5675 sefsSavedAs,OldFilename);
5676 if Result<>mrOk then exit;
5677 finally
5678 Project1.EndUpdate;
5679 end;
5680 Result:=mrOk;
5681 end;
5682
5683 function RenameUnitLowerCase(AnUnitInfo: TUnitInfo; AskUser: boolean): TModalresult;
5684 var
5685 OldFilename: String;
5686 OldShortFilename: String;
5687 NewFilename: String;
5688 NewShortFilename: String;
5689 LFMCode, LRSCode: TCodeBuffer;
5690 NewUnitName: String;
5691 begin
5692 Result:=mrOk;
5693 OldFilename:=AnUnitInfo.Filename;
5694 // check if file is unit
5695 if not FilenameIsPascalUnit(OldFilename) then exit;
5696 // check if file is already lowercase (or it does not matter in current OS)
5697 OldShortFilename:=ExtractFilename(OldFilename);
5698 NewShortFilename:=lowercase(OldShortFilename);
5699 if CompareFilenames(OldShortFilename,NewShortFilename)=0 then exit;
5700 // create new filename
5701 NewFilename:=ExtractFilePath(OldFilename)+NewShortFilename;
5702
5703 // rename unit
5704 if AskUser then begin
5705 Result:=IDEQuestionDialog(lisFileNotLowercase,
5706 Format(lisTheUnitIsNotLowercaseTheFreePascalCompiler,
5707 [OldFilename, LineEnding, LineEnding+LineEnding]),
5708 mtConfirmation,[mrYes,mrIgnore,rsmbNo,mrAbort],'');
5709 if Result<>mrYes then exit;
5710 end;
5711 NewUnitName:=AnUnitInfo.Unit_Name;
5712 if NewUnitName='' then begin
5713 AnUnitInfo.ReadUnitNameFromSource(false);
5714 NewUnitName:=AnUnitInfo.CreateUnitName;
5715 end;
5716 LFMCode:=nil;
5717 LRSCode:=nil;
5718 Result:=RenameUnit(AnUnitInfo,NewFilename,NewUnitName,LFMCode,LRSCode);
5719 end;
5720
5721 function CheckLFMInEditor(LFMUnitInfo: TUnitInfo; Quiet: boolean): TModalResult;
5722 var
5723 LFMChecker: TLFMChecker;
5724 UnitFilename: String;
5725 PascalBuf: TCodeBuffer;
5726 i: integer;
5727 LFMFilename: String;
5728 SrcEdit: TSourceEditor;
5729 begin
5730 if (LFMUnitInfo<>nil)
5731 and FilenameHasPascalExt(LFMUnitInfo.Filename) then begin
5732 LFMFilename:=ChangeFileExt(LFMUnitInfo.Filename,'.lfm');
5733 if FileExistsInIDE(LFMFilename,[])
5734 and (OpenEditorFile(LFMFilename,-1,-1,nil,[])=mrOk)
5735 and (SourceEditorManager.ActiveEditor<>nil)
5736 then begin
5737 SrcEdit:=SourceEditorManager.ActiveEditor;
5738 LFMUnitInfo:=Project1.UnitInfoWithFilename(SrcEdit.FileName);
5739 end;
5740 end;
5741
5742 // check, if a .lfm file is opened in the source editor
5743 if (LFMUnitInfo=nil)
5744 or not ( FilenameExtIs(LFMUnitInfo.Filename,'lfm',true) or
5745 FilenameExtIs(LFMUnitInfo.Filename,'dfm') ) then
5746 begin
5747 if not Quiet then
5748 begin
5749 IDEMessageDialog(lisNoLFMFile,
5750 lisThisFunctionNeedsAnOpenLfmFileInTheSourceEditor,
5751 mtError,[mbCancel]);
5752 end;
5753 Result:=mrCancel;
5754 exit;
5755 end;
5756 // try to find the pascal unit
5757 for i:=Low(PascalFileExt) to High(PascalFileExt) do begin
5758 UnitFilename:=ChangeFileExt(LFMUnitInfo.Filename,PascalFileExt[i]);
5759 if FileExistsCached(UnitFilename) then
5760 break
5761 else
5762 UnitFilename:='';
5763 end;
5764 if UnitFilename='' then begin
5765 IDEMessageDialog(lisNoPascalFile,
5766 Format(lisUnableToFindPascalUnitPasPpForLfmFile,[LineEnding, LFMUnitInfo.Filename]),
5767 mtError,[mbCancel]);
5768 Result:=mrCancel;
5769 exit;
5770 end;
5771
5772 if MainIDE.ToolStatus<>itNone then begin
5773 DebugLn(['CheckLFMInEditor ToolStatus<>itNone']);
5774 Result:=mrCancel;
5775 exit;
5776 end;
5777 // load the pascal unit
5778 SaveEditorChangesToCodeCache(nil);
5779 Result:=LoadCodeBuffer(PascalBuf,UnitFilename,[],false);
5780 if Result<>mrOk then exit;
5781
5782 // open messages window
5783 SourceEditorManager.ClearErrorLines;
5784 if MessagesView<>nil then
5785 MessagesView.Clear;
5786 ArrangeSourceEditorAndMessageView(false);
5787
5788 // parse the LFM file and the pascal unit
5789 LFMChecker:=TLFMChecker.Create(PascalBuf,LFMUnitInfo.Source);
5790 try
5791 LFMChecker.ShowMessages:=true;
5792 LFMChecker.RootMustBeClassInUnit:=true;
5793 LFMChecker.RootMustBeClassInIntf:=true;
5794 LFMChecker.ObjectsMustExist:=true;
5795 if LFMChecker.Repair=mrOk then begin
5796 if not Quiet then begin
5797 IDEMessageDialog(lisLFMIsOk,
5798 lisClassesAndPropertiesExistValuesWereNotChecked,
5799 mtInformation,[mbOk],'');
5800 end;
5801 end else begin
5802 MainIDE.DoJumpToCompilerMessage(true);
5803 Result:=mrAbort;
5804 exit;
5805 end;
5806 finally
5807 LFMChecker.Free;
5808 end;
5809 Result:=mrOk;
5810 end;
5811
5812 function LoadResourceFile(AnUnitInfo: TUnitInfo; var LFMCode, LRSCode: TCodeBuffer;
5813 AutoCreateResourceCode, ShowAbort: boolean): TModalResult;
5814 var
5815 LFMFilename: string;
5816 LRSFilename: String;
5817 ResType: TResourceType;
5818 begin
5819 LFMCode:=nil;
5820 LRSCode:=nil;
5821 //DebugLn(['LoadResourceFile ',AnUnitInfo.Filename,' HasResources=',AnUnitInfo.HasResources,' IgnoreSourceErrors=',IgnoreSourceErrors,' AutoCreateResourceCode=',AutoCreateResourceCode]);
5822 // Load the lfm file (without parsing)
5823 if not AnUnitInfo.IsVirtual then begin // and (AnUnitInfo.Component<>nil)
5824 LFMFilename:=AnUnitInfo.UnitResourceFileformat.GetUnitResourceFilename(AnUnitInfo.Filename,true);
5825 if (FileExistsCached(LFMFilename)) then begin
5826 Result:=LoadCodeBuffer(LFMCode,LFMFilename,[lbfCheckIfText],ShowAbort);
5827 if not (Result in [mrOk,mrIgnore]) then
5828 exit;
5829 end;
5830 end;
5831 if AnUnitInfo.HasResources then begin
5832 //debugln('LoadResourceFile A "',AnUnitInfo.Filename,'" "',AnUnitInfo.ResourceFileName,'"');
5833 ResType:=MainBuildBoss.GetResourceType(AnUnitInfo);
5834 if ResType=rtLRS then begin
5835 LRSFilename:=MainBuildBoss.FindLRSFilename(AnUnitInfo,false);
5836 if LRSFilename<>'' then begin
5837 Result:=LoadCodeBuffer(LRSCode,LRSFilename,[lbfUpdateFromDisk],ShowAbort);
5838 if Result<>mrOk then exit;
5839 end else begin
5840 LRSFilename:=MainBuildBoss.GetDefaultLRSFilename(AnUnitInfo);
5841 if AutoCreateResourceCode then begin
5842 LRSCode:=CodeToolBoss.CreateFile(LRSFilename);
5843 end else begin
5844 DebugLn(['LoadResourceFile .lrs file not found of unit ',AnUnitInfo.Filename]);
5845 exit(mrCancel);
5846 end;
5847 end;
5848 end else begin
5849 LRSFilename:='';
5850 LRSCode:=nil;
5851 end;
5852 end;
5853 Result:=mrOk;
5854 end;
5855
5856 function LoadLFM(AnUnitInfo: TUnitInfo; OpenFlags: TOpenFlags;
5857 CloseFlags: TCloseFlags): TModalResult;
5858 // if there is a .lfm file, open the resource
5859 var
5860 ResFilename: string;
5861 LFMBuf: TCodeBuffer;
5862 CanAbort: boolean;
5863 begin
5864 CanAbort:=[ofProjectLoading,ofMultiOpen]*OpenFlags<>[];
5865 // Note: think about virtual and normal .lfm files.
5866 with AnUnitInfo.UnitResourceFileformat do
5867 ResFilename:=GetUnitResourceFilename(AnUnitInfo.Filename,true);
5868 LFMBuf:=nil;
5869 if not FileExistsInIDE(ResFilename,[pfsfOnlyEditorFiles]) then begin
5870 {$IFDEF IDE_DEBUG}
5871 debugln('LoadLFM there is no LFM file for "',AnUnitInfo.Filename,'"');
5872 {$ENDIF}
5873 exit(mrOk); // there is no LFM file -> ok
5874 end;
5875 // there is a lazarus form text file -> load it
5876 Result:=LoadIDECodeBuffer(LFMBuf,ResFilename,[lbfUpdateFromDisk],CanAbort);
5877 if Result<>mrOk then begin
5878 DebugLn(['LoadLFM LoadIDECodeBuffer failed']);
5879 exit;
5880 end;
5881 Result:=LoadLFM(AnUnitInfo,LFMBuf,OpenFlags,CloseFlags);
5882 end;
5883
5884 function LoadLFM(AnUnitInfo: TUnitInfo; LFMBuf: TCodeBuffer;
5885 OpenFlags: TOpenFlags; CloseFlags: TCloseFlags): TModalResult;
5886 const
5887 BufSize = 4096; // allocating mem in 4k chunks helps many mem managers
5888
5889 ShowCommands: array[TWindowState] of Integer =
5890 (SW_SHOWNORMAL, SW_MINIMIZE, SW_SHOWMAXIMIZED, SW_SHOWFULLSCREEN);
5891
5892 var
5893 TxtLFMStream, BinStream: TExtMemoryStream;
5894 NewComponent: TComponent;
5895 AncestorType: TComponentClass;
5896 DesignerForm: TCustomForm;
5897 NewClassName: String;
5898 LFMType: String;
5899 ACaption, AText: String;
5900 NewUnitName: String;
5901 AncestorUnitInfo, NestedUnitInfo, LFMUnitInfo: TUnitInfo;
5902 ReferencesLocked: Boolean;
5903 LCLVersion: string;
5904 MissingClasses: TStrings;
5905 LFMComponentName: string;
5906 i: Integer;
5907 NestedClassName: string;
5908 NestedClass: TComponentClass;
5909 DisableAutoSize: Boolean;
5910 PreventAutoSize: Boolean;
5911 NewControl: TControl;
5912 ARestoreVisible: Boolean;
5913 AncestorClass: TComponentClass;
5914 DsgControl: TCustomDesignControl;
5915 {$IF (FPC_FULLVERSION >= 30003)}
5916 DsgDataModule: TDataModule;
5917 {$ENDIF}
5918 begin
5919 {$IFDEF IDE_DEBUG}
5920 debugln('LoadLFM A ',AnUnitInfo.Filename,' IsPartOfProject=',dbgs(AnUnitInfo.IsPartOfProject),' ');
5921 {$ENDIF}
5922
5923 ReferencesLocked:=false;
5924 MissingClasses:=nil;
5925 NewComponent:=nil;
5926 try
5927 if (ofRevert in OpenFlags) and (AnUnitInfo.Component<>nil) then begin
5928 // the component must be destroyed and recreated => store references
5929 ReferencesLocked:=true;
5930 Project1.LockUnitComponentDependencies;
5931 Project1.UpdateUnitComponentDependencies;
5932
5933 // close old designer form
5934 Result:=CloseUnitComponent(AnUnitInfo,CloseFlags);
5935 if Result<>mrOk then begin
5936 DebugLn(['LoadLFM CloseUnitComponent failed']);
5937 exit;
5938 end;
5939 end;
5940
5941 // check installed packages
5942 if EnvironmentOptions.CheckPackagesOnFormCreate and
5943 (AnUnitInfo.Component = nil) and
5944 AnUnitInfo.IsPartOfProject and
5945 (not (ofProjectLoading in OpenFlags)) then
5946 begin
5947 // opening a form of the project -> check installed packages
5948 Result := PkgBoss.CheckProjectHasInstalledPackages(Project1,
5949 OpenFlags * [ofProjectLoading, ofQuiet] = []);
5950 if not (Result in [mrOk, mrIgnore]) then
5951 begin
5952 DebugLn(['LoadLFM PkgBoss.CheckProjectHasInstalledPackages failed']);
5953 exit;
5954 end;
5955 end;
5956 {$IFDEF VerboseLFMSearch}
5957 debugln('LoadLFM LFM file loaded, parsing "',LFMBuf.Filename,'" ...');
5958 {$ENDIF}
5959
5960 // someone created a .lfm file -> Update HasResources
5961 AnUnitInfo.HasResources:=true;
5962
5963 // find the classname of the LFM, and check for inherited form
5964 AnUnitInfo.UnitResourceFileformat.QuickCheckResourceBuffer(
5965 AnUnitInfo.Source,LFMBuf,LFMType,LFMComponentName,
5966 NewClassName,LCLVersion,MissingClasses);
5967
5968 {$IFDEF VerboseLFMSearch}
5969 debugln('LoadLFM LFM="',LFMBuf.Source,'"');
5970 {$ENDIF}
5971 if AnUnitInfo.Component=nil then begin
5972 // load/create new instance
5973
5974 if (NewClassName='') or (LFMType='') then begin
5975 DebugLn(['LoadLFM LFM file corrupt']);
5976 Result:=IDEMessageDialog(lisLFMFileCorrupt,
5977 Format(lisUnableToFindAValidClassnameIn, [LFMBuf.Filename]),
5978 mtError,[mbIgnore,mbCancel,mbAbort]);
5979 exit;
5980 end;
5981
5982 // load missing component classes (e.g. ancestor and frames)
5983 Result:=LoadAncestorDependencyHidden(AnUnitInfo,NewClassName,OpenFlags,
5984 AncestorType,AncestorUnitInfo);
5985 if Result<>mrOk then begin
5986 DebugLn(['LoadLFM DoLoadAncestorDependencyHidden failed for ',AnUnitInfo.Filename]);
5987 exit;
5988 end;
5989
5990 if MissingClasses<>nil then begin
5991 {$IFDEF VerboseLFMSearch}
5992 DebugLn(['LoadLFM has nested: ',AnUnitInfo.Filename]);
5993 {$ENDIF}
5994 for i:=MissingClasses.Count-1 downto 0 do begin
5995 NestedClassName:=MissingClasses[i];
5996 {$IFDEF VerboseLFMSearch}
5997 DebugLn(['LoadLFM nested ',i,' ',MissingClasses.Count,': ',NestedClassName]);
5998 {$ENDIF}
5999 if SysUtils.CompareText(NestedClassName,AncestorType.ClassName)=0 then
6000 begin
6001 MissingClasses.Delete(i);
6002 end else begin
6003 DebugLn(['LoadLFM loading nested class ',NestedClassName,' needed by ',AnUnitInfo.Filename]);
6004 NestedClass:=nil;
6005 NestedUnitInfo:=nil;
6006 Result:=LoadComponentDependencyHidden(AnUnitInfo,NestedClassName,
6007 OpenFlags,
6008 {$IFDEF EnableNestedComponentsWithoutLFM}
6009 false,
6010 {$ELSE}
6011 true,
6012 {$ENDIF}
6013 NestedClass,NestedUnitInfo,AncestorClass);
6014 if Result<>mrOk then begin
6015 DebugLn(['LoadLFM DoLoadComponentDependencyHidden NestedClassName=',NestedClassName,' failed for ',AnUnitInfo.Filename]);
6016 exit;
6017 end;
6018 if NestedClass<>nil then
6019 MissingClasses.Objects[i]:=TObject(Pointer(NestedClass))
6020 else if AncestorClass<>nil then
6021 MissingClasses.Objects[i]:=TObject(Pointer(AncestorClass));
6022 end;
6023 end;
6024 //DebugLn(['LoadLFM had nested: ',AnUnitInfo.Filename]);
6025 if AnUnitInfo.ComponentFallbackClasses<>nil then begin
6026 AnUnitInfo.ComponentFallbackClasses.Free;
6027 AnUnitInfo.ComponentFallbackClasses:=nil;
6028 end;
6029 AnUnitInfo.ComponentFallbackClasses:=MissingClasses;
6030 MissingClasses:=nil;
6031 end;
6032
6033 BinStream:=nil;
6034 try
6035 // convert text to binary format
6036 BinStream:=TExtMemoryStream.Create;
6037 TxtLFMStream:=TExtMemoryStream.Create;
6038 try
6039 {$IFDEF VerboseIDELFMConversion}
6040 DebugLn(['LoadLFM LFMBuf START =======================================']);
6041 DebugLn(LFMBuf.Source);
6042 DebugLn(['LoadLFM LFMBuf END =======================================']);
6043 {$ENDIF}
6044 LFMBuf.SaveToStream(TxtLFMStream);
6045 AnUnitInfo.ComponentLastLFMStreamSize:=TxtLFMStream.Size;
6046 TxtLFMStream.Position:=0;
6047
6048 try
6049 if AnUnitInfo.ComponentLastBinStreamSize>0 then
6050 BinStream.Capacity:=AnUnitInfo.ComponentLastBinStreamSize+BufSize;
6051 AnUnitInfo.UnitResourceFileformat.TextStreamToBinStream(TxtLFMStream, BinStream);
6052 AnUnitInfo.ComponentLastBinStreamSize:=BinStream.Size;
6053 BinStream.Position:=0;
6054
6055 {$IFDEF VerboseIDELFMConversion}
6056 DebugLn(['LoadLFM Binary START =======================================']);
6057 debugln(dbgMemStream(BinStream,BinStream.Size));
6058 DebugLn(['LoadLFM Binary END =======================================']);
6059 BinStream.Position:=0;
6060 {$ENDIF}
6061
6062 Result:=mrOk;
6063 except
6064 on E: Exception do begin
6065 DumpExceptionBackTrace;
6066 ACaption:=lisFormatError;
6067 AText:=Format(lisUnableToConvertTextFormDataOfFileIntoBinaryStream,
6068 [LineEnding, LFMBuf.Filename, LineEnding, E.Message]);
6069 Result:=IDEMessageDialog(ACaption, AText, mtError, [mbOk, mbCancel]);
6070 if Result=mrCancel then Result:=mrAbort;
6071 exit;
6072 end;
6073 end;
6074 finally
6075 TxtLFMStream.Free;
6076 end;
6077 if ([ofProjectLoading,ofLoadHiddenResource]*OpenFlags=[]) then
6078 FormEditor1.ClearSelection;
6079
6080 // create JIT component
6081 NewUnitName:=AnUnitInfo.Unit_Name;
6082 if NewUnitName='' then
6083 NewUnitName:=ExtractFileNameOnly(AnUnitInfo.Filename);
6084 DisableAutoSize:=true;
6085 NewComponent:=FormEditor1.CreateRawComponentFromStream(BinStream,
6086 AnUnitInfo.UnitResourceFileformat,
6087 AncestorType,copy(NewUnitName,1,255),true,true,DisableAutoSize,AnUnitInfo);
6088 if (NewComponent is TControl) then begin
6089 NewControl:=TControl(NewComponent);
6090 if ofLoadHiddenResource in OpenFlags then
6091 NewControl.ControlStyle:=NewControl.ControlStyle+[csNoDesignVisible];
6092 if DisableAutoSize then
6093 begin
6094 PreventAutoSize := (IDETabMaster <> nil)
6095 and (NewControl is TCustomDesignControl)
6096 and IDETabMaster.AutoSizeInShowDesigner(NewControl);
6097 if not PreventAutoSize then
6098 NewControl.EnableAutoSizing{$IFDEF DebugDisableAutoSizing}('TAnchorDockMaster Delayed'){$ENDIF};
6099 end;
6100 end;
6101
6102 if NewComponent is TCustomDesignControl then
6103 begin
6104 DsgControl := TCustomDesignControl(NewComponent);
6105 if (Project1.Scaled or EnvironmentOptions.ForceDPIScalingInDesignTime)
6106 and DsgControl.Scaled and (DsgControl.DesignTimePPI<>Screen.PixelsPerInch) then
6107 begin
6108 DsgControl.AutoAdjustLayout(lapAutoAdjustForDPI, DsgControl.DesignTimePPI, Screen.PixelsPerInch, 0, 0);
6109 DesignerProcs.ScaleNonVisual(DsgControl, DsgControl.DesignTimePPI, Screen.PixelsPerInch);
6110 DsgControl.DesignTimePPI := Screen.PixelsPerInch;
6111 end;
6112 DsgControl.PixelsPerInch := Screen.PixelsPerInch;
6113 end;
6114 {$IF (FPC_FULLVERSION >= 30003)} // TDataModule.DesignPPI was added in FPC 3.0.3
6115 if NewComponent is TDataModule then
6116 begin
6117 DsgDataModule := TDataModule(NewComponent);
6118 if (DsgDataModule.DesignPPI<>Screen.PixelsPerInch) then
6119 begin
6120 DesignerProcs.ScaleNonVisual(DsgDataModule, DsgDataModule.DesignPPI, Screen.PixelsPerInch);
6121 DsgDataModule.DesignOffset := Point(
6122 MulDiv(DsgDataModule.DesignOffset.x, Screen.PixelsPerInch, DsgDataModule.DesignPPI),
6123 MulDiv(DsgDataModule.DesignOffset.y, Screen.PixelsPerInch, DsgDataModule.DesignPPI));
6124 DsgDataModule.DesignSize := Point(
6125 MulDiv(DsgDataModule.DesignSize.x, Screen.PixelsPerInch, DsgDataModule.DesignPPI),
6126 MulDiv(DsgDataModule.DesignSize.y, Screen.PixelsPerInch, DsgDataModule.DesignPPI));
6127 DsgDataModule.DesignPPI := Screen.PixelsPerInch;
6128 end;
6129 end;
6130 {$ENDIF}
6131
6132 if NewComponent<>nil then
6133 AnUnitInfo.ResourceBaseClass:=GetComponentBaseClass(NewComponent.ClassType);
6134
6135 Project1.InvalidateUnitComponentDesignerDependencies;
6136 AnUnitInfo.Component:=NewComponent;
6137 if (AncestorUnitInfo<>nil) then
6138 AnUnitInfo.AddRequiresComponentDependency(AncestorUnitInfo,[ucdtAncestor]);
6139 if NewComponent<>nil then begin
6140 // component loaded, now load the referenced units
6141 Result:=MainIDE.DoFixupComponentReferences(AnUnitInfo.Component,OpenFlags);
6142 if Result<>mrOk then begin
6143 DebugLn(['LoadLFM DoFixupComponentReferences failed']);
6144 exit;
6145 end;
6146 end else begin
6147 // error streaming component -> examine lfm file
6148 DebugLn('ERROR: streaming failed lfm="',LFMBuf.Filename,'"');
6149 // open lfm file in editor
6150 if AnUnitInfo.OpenEditorInfoCount > 0 then
6151 Result:=OpenEditorFile(LFMBuf.Filename,
6152 AnUnitInfo.OpenEditorInfo[0].PageIndex+1,
6153 AnUnitInfo.OpenEditorInfo[0].WindowID, Nil,
6154 OpenFlags+[ofOnlyIfExists,ofQuiet,ofRegularFile], True)
6155 else
6156 Result:=OpenEditorFile(LFMBuf.Filename, -1, -1, nil,
6157 OpenFlags+[ofOnlyIfExists,ofQuiet,ofRegularFile]);
6158 if Result<>mrOk then begin
6159 DebugLn(['LoadLFM DoOpenEditorFile failed']);
6160 exit;
6161 end;
6162 LFMUnitInfo:=Project1.UnitWithEditorComponent(SourceEditorManager.ActiveEditor);
6163 Result:=CheckLFMInEditor(LFMUnitInfo, true);
6164 if Result=mrOk then Result:=mrCancel;
6165 exit;
6166 end;
6167 finally
6168 BinStream.Free;
6169 end;
6170 end else if SysUtils.CompareText(AnUnitInfo.Component.ClassName,NewClassName)<>0
6171 then begin
6172 // lfm and current designer are about different classes
6173 debugln(['LoadLFM unit="',AnUnitInfo.Filename,'": loaded component has class "',AnUnitInfo.Component.ClassName,'", lfm has class "',NewClassName,'"']);
6174 // keep old instance, add a designer, so user can see current component
6175 end else begin
6176 // make hidden component visible, keep old instance, add a designer
6177 DebugLn(['LoadLFM Creating designer for hidden component of ',AnUnitInfo.Filename]);
6178 end;
6179 finally
6180 MissingClasses.Free;
6181 if ReferencesLocked then begin
6182 if Project1<>nil then
6183 Project1.UnlockUnitComponentDependencies;
6184 end;
6185 end;
6186
6187 NewComponent:=AnUnitInfo.Component;
6188 // create the designer (if not already done)
6189 if ([ofProjectLoading,ofLoadHiddenResource]*OpenFlags=[]) then
6190 FormEditor1.ClearSelection;
6191 {$IFDEF IDE_DEBUG}
6192 DebugLn('SUCCESS: streaming lfm="',LFMBuf.Filename,'"');
6193 {$ENDIF}
6194 AnUnitInfo.ComponentName:=NewComponent.Name;
6195 AnUnitInfo.ComponentResourceName:=AnUnitInfo.ComponentName;
6196 DesignerForm := nil;
6197 MainIDE.LastFormActivated := nil;
6198 if not (ofLoadHiddenResource in OpenFlags) then
6199 begin
6200 DesignerForm := FormEditor1.GetDesignerForm(NewComponent);
6201 if (DesignerForm=nil) or (DesignerForm.Designer=nil) then
6202 DesignerForm := MainIDE.CreateDesignerForComponent(AnUnitInfo,NewComponent);
6203 end;
6204
6205 // select the new form (object inspector, formeditor, control selection)
6206 if (DesignerForm <> nil)
6207 and ([ofProjectLoading,ofLoadHiddenResource] * OpenFlags=[]) then
6208 begin
6209 MainIDE.DisplayState := dsForm;
6210 GlobalDesignHook.LookupRoot := NewComponent;
6211 TheControlSelection.AssignPersistent(NewComponent);
6212 end;
6213
6214 // show new form
6215 if DesignerForm <> nil then
6216 begin
6217 DesignerForm.ControlStyle := DesignerForm.ControlStyle - [csNoDesignVisible];
6218 if NewComponent is TControl then
6219 TControl(NewComponent).ControlStyle:= TControl(NewComponent).ControlStyle - [csNoDesignVisible];
6220 if (DesignerForm.WindowState in [wsMinimized]) then
6221 begin
6222 ARestoreVisible := DesignerForm.Visible;
6223 DesignerForm.Visible := False;
6224 DesignerForm.ShowOnTop;
6225 DesignerForm.Visible := ARestoreVisible;
6226 DesignerForm.WindowState := wsMinimized;
6227 end else
6228 if IDETabMaster = nil then
6229 LCLIntf.ShowWindow(DesignerForm.Handle, ShowCommands[AnUnitInfo.ComponentState]);
6230 MainIDE.LastFormActivated := DesignerForm;
6231 end;
6232
6233 {$IFDEF IDE_DEBUG}
6234 debugln('[LoadLFM] LFM end');
6235 {$ENDIF}
6236 Result:=mrOk;
6237 end;
6238
6239 function OpenComponent(const UnitFilename: string;
6240 OpenFlags: TOpenFlags; CloseFlags: TCloseFlags; out Component: TComponent): TModalResult;
6241 var
6242 AnUnitInfo: TUnitInfo;
6243 AFilename, LFMFilename: String;
6244 UnitCode, LFMCode: TCodeBuffer;
6245 begin
6246 if Project1=nil then exit(mrCancel);
6247 // try to find a unit name without expaning the path. this is required if unit is virtual
6248 // in other case file name will be expanded with the wrong path
6249 AFilename:=UnitFilename;
6250 AnUnitInfo:=Project1.UnitInfoWithFilename(AFilename);
6251 if AnUnitInfo = nil then
6252 begin
6253 AFilename:=TrimAndExpandFilename(UnitFilename);
6254 if (AFilename='') or (not FileExistsInIDE(AFilename,[])) then begin
6255 DebugLn(['OpenComponent file not found ',AFilename]);
6256 exit(mrCancel);
6257 end;
6258 AnUnitInfo:=Project1.UnitInfoWithFilename(AFilename);
6259 end;
6260 if (not (ofRevert in OpenFlags))
6261 and (AnUnitInfo<>nil) and (AnUnitInfo.Component<>nil) then begin
6262 // already open
6263 Component:=AnUnitInfo.Component;
6264 exit(mrOk);
6265 end;
6266
6267 // ToDo: use UnitResources
6268 LFMFilename:=ChangeFileExt(AFilename,'.lfm');
6269 if not FileExistsInIDE(LFMFilename,[]) then
6270 LFMFilename:=ChangeFileExt(AFilename,'.dfm');
6271 if not FileExistsInIDE(LFMFilename,[]) then begin
6272 DebugLn(['OpenComponent file not found ',LFMFilename]);
6273 exit(mrCancel);
6274 end;
6275
6276 // load unit source
6277 Result:=LoadCodeBuffer(UnitCode,AFilename,[lbfCheckIfText],true);
6278 if Result<>mrOk then begin
6279 debugln('OpenComponent Failed loading ',AFilename);
6280 exit;
6281 end;
6282
6283 // create unit info
6284 if AnUnitInfo=nil then begin
6285 AnUnitInfo:=TUnitInfo.Create(UnitCode);
6286 AnUnitInfo.ReadUnitNameFromSource(true);
6287 Project1.AddFile(AnUnitInfo,false);
6288 end;
6289
6290 // load lfm source
6291 Result:=LoadCodeBuffer(LFMCode,LFMFilename,[lbfCheckIfText],true);
6292 if Result<>mrOk then begin
6293 debugln('OpenComponent Failed loading ',LFMFilename);
6294 exit;
6295 end;
6296
6297 // load resource
6298 Result:=LoadLFM(AnUnitInfo,LFMCode,OpenFlags,CloseFlags);
6299 if Result<>mrOk then begin
6300 debugln('OpenComponent DoLoadLFM failed ',LFMFilename);
6301 exit;
6302 end;
6303
6304 Component:=AnUnitInfo.Component;
6305 if Component<>nil then
6306 Result:=mrOk
6307 else
6308 Result:=mrCancel;
6309 end;
6310
6311 function FindBaseComponentClass(AnUnitInfo: TUnitInfo; const AComponentClassName,
6312 DescendantClassName: string; out AComponentClass: TComponentClass): boolean;
6313 // returns false if an error occurred
6314 // Important: returns true even if AComponentClass=nil
6315 var
6316 ResFormat: TUnitResourcefileFormatClass;
6317 begin
6318 AComponentClass:=nil;
6319 // find the ancestor class
6320 ResFormat:=AnUnitInfo.UnitResourceFileformat;
6321 if ResFormat<>nil then
6322 begin
6323 AComponentClass:=ResFormat.FindComponentClass(AComponentClassName);
6324 if AComponentClass<>nil then
6325 exit(true);
6326 end;
6327 if AComponentClassName<>'' then
6328 begin
6329 if DescendantClassName<>'' then begin
6330 if CompareText(AComponentClassName,'TCustomForm')=0 then begin
6331 // this is a common user mistake
6332 IDEMessageDialog(lisCodeTemplError,
6333 Format(lisTheResourceClassDescendsFromProbablyThisIsATypoFor,
6334 [DescendantClassName, AComponentClassName]),
6335 mtError,[mbCancel]);
6336 exit(false);
6337 end
6338 else if CompareText(AComponentClassName,'TComponent')=0 then begin
6339 // this is not yet implemented
6340 IDEMessageDialog(lisCodeTemplError,
6341 Format(lisUnableToOpenDesignerTheClassDoesNotDescendFromADes,
6342 [LineEnding, DescendantClassName]),
6343 mtError,[mbCancel]);
6344 exit(false);
6345 end;
6346 end;
6347 // search in the registered base classes
6348 AComponentClass:=FormEditor1.FindDesignerBaseClassByName(AComponentClassName,true);
6349 end else begin
6350 // default is TForm
6351 AComponentClass:=BaseFormEditor1.StandardDesignerBaseClasses[DesignerBaseClassId_TForm];
6352 end;
6353 Result:=true;
6354 end;
6355
6356 function LoadAncestorDependencyHidden(AnUnitInfo: TUnitInfo;
6357 const aComponentClassName: string; OpenFlags: TOpenFlags;
6358 out AncestorClass: TComponentClass;
6359 out AncestorUnitInfo: TUnitInfo): TModalResult;
6360 var
6361 AncestorClsName, IgnoreBtnText, ClsName: String;
6362 CodeBuf: TCodeBuffer;
6363 GrandAncestorClass, DefAncestorClass: TComponentClass;
6364 ResFormat: TUnitResourcefileFormatClass;
6365 ClsUnitInfo: TUnitInfo;
6366 begin
6367 AncestorClass:=nil;
6368 AncestorUnitInfo:=nil;
6369
6370 // fallback ancestor is defined by the resource file format of the form/frame/component being loaded
6371 // this is offered to the user in case a lookup fails
6372 ResFormat:= AnUnitInfo.UnitResourceFileformat;
6373 if ResFormat<>nil then
6374 DefAncestorClass:=ResFormat.DefaultComponentClass
6375 else
6376 DefAncestorClass:=nil;
6377 // use TForm as default ancestor
6378 if DefAncestorClass=nil then
6379 DefAncestorClass:=BaseFormEditor1.StandardDesignerBaseClasses[DesignerBaseClassId_TForm];
6380 IgnoreBtnText:='';
6381 if DefAncestorClass<>nil then
6382 IgnoreBtnText:=Format(lisIgnoreUseAsAncestor, [DefAncestorClass.ClassName]);
6383
6384 // traverse the chain of ancestors until either:
6385 // - an error occurs
6386 // - FindBaseComponentClass locates an editor class
6387 // - LoadComponentDependencyHidden loads a full LFM
6388 // - no further class parents exist
6389 ClsName:=aComponentClassName;
6390 ClsUnitInfo:=AnUnitInfo;
6391 repeat
6392 // if Source is not already loaded, load from Filename
6393 if not Assigned(ClsUnitInfo.Source) then begin
6394 Result:=LoadCodeBuffer(CodeBuf,ClsUnitInfo.Filename,
6395 [lbfUpdateFromDisk,lbfCheckIfText],true);
6396 if Result<>mrOk then exit;
6397 ClsUnitInfo.Source:=CodeBuf;
6398 if FilenameIsPascalSource(ClsUnitInfo.Filename) then
6399 ClsUnitInfo.ReadUnitNameFromSource(true);
6400 end;
6401
6402 // get ancestor of ClsName from current ClsUnitInfo
6403 if CodeToolBoss.FindFormAncestor(ClsUnitInfo.Source,ClsName,AncestorClsName,true) then begin
6404 // is this ancestor a designer class?
6405 if not FindBaseComponentClass(ClsUnitInfo,AncestorClsName,ClsName,AncestorClass) then
6406 begin
6407 DebugLn(['LoadAncestorDependencyHidden FindUnitComponentClass failed for AncsClsName=',AncestorClsName]);
6408 exit(mrCancel);
6409 end;
6410
6411 if Assigned(AncestorClass) then
6412 break
6413 else begin
6414 // immediately go to next ancestor
6415 ClsName:=AncestorClsName;
6416 continue;
6417 end;
6418 end;
6419 // -> the declaration of ClsName is not in ClsUnitInfo, let LoadComponentDependencyHidden locate it
6420
6421 // try loading the ancestor (unit, lfm and component instance)
6422 Result:=LoadComponentDependencyHidden(ClsUnitInfo,ClsName,
6423 OpenFlags,false,AncestorClass,AncestorUnitInfo,GrandAncestorClass,
6424 IgnoreBtnText);
6425 if Result<>mrOk then begin
6426 DebugLn(['LoadAncestorDependencyHidden DoLoadComponentDependencyHidden failed ClsUnitInfo=',ClsUnitInfo.Filename]);
6427 end;
6428 case Result of
6429 mrAbort: exit;
6430 mrOk: ;
6431 mrIgnore: break;
6432 else
6433 // cancel
6434 exit(mrCancel);
6435 end;
6436
6437 // possible outcomes of LoadComponentDependencyHidden:
6438 if Assigned(AncestorClass) then
6439 // loaded something and got a component class for it -> done, everything is set
6440 break
6441 else if Assigned(AncestorUnitInfo) then
6442 // loaded the unit containing ClsName, but it does not have the ComponentClass -> let FindFormAncestor/FindBaseComponentClass try again
6443 ClsUnitInfo:= AncestorUnitInfo
6444 else begin
6445 // likely a bug: declaration is nowhere and was not caught by user interaction in LoadComponentDependencyHidden
6446 DebugLn(['LoadAncestorDependencyHidden DoLoadComponentDependencyHidden empty returns for ClsName=',ClsName, ' ClsUnitInfo=',ClsUnitInfo.Filename]);
6447 exit(mrCancel);
6448 end;
6449 until Assigned(AncestorClass) or (ClsName = '') or not Assigned(ClsUnitInfo);
6450
6451 if AncestorClass=nil then begin
6452 // nothing was found, clear any attempted references
6453 AncestorUnitInfo:= nil;
6454
6455 //DebugLn('LoadAncestorDependencyHidden Filename="',ClsUnitInfo.Filename,'" AncsClsName=',AncestorClsName,' AncestorClass=',dbgsName(AncestorClass));
6456 AncestorClass:=DefAncestorClass;
6457 end;
6458 Result:=mrOk;
6459 end;
6460
6461 function FindComponentClass(AnUnitInfo: TUnitInfo; const AComponentClassName: string;
6462 Quiet: boolean; out ComponentUnitInfo: TUnitInfo; out AComponentClass: TComponentClass;
6463 out LFMFilename: string; out AncestorClass: TComponentClass): TModalResult;
6464 { Possible results:
6465 mrOk:
6466 - AComponentClass<>nil and ComponentUnitInfo<>nil
6467 designer component
6468 - AComponentClass<>nil and ComponentUnitInfo=nil
6469 registered componentclass
6470 - AComponentClass=nil and ComponentUnitInfo<>nil
6471 componentclass does not exist, but the unit declaring AComponentClassName was found
6472 - LFMFilename<>''
6473 lfm of an used unit
6474 - AncestorClass<>nil
6475 componentclass does not exist, but the ancestor is a registered class
6476 mrCancel:
6477 not found
6478 mrAbort:
6479 not found, error already shown
6480 }
6481 var
6482 CTErrorMsg: String;
6483 CTErrorCode: TCodeBuffer;
6484 CTErrorLine: Integer;
6485 CTErrorCol: Integer;
6486
6487 procedure StoreCodetoolsError;
6488 begin
6489 {$IFDEF VerboseLFMSearch}
6490 debugln([' StoreCodetoolsError: ',CodeToolBoss.ErrorMessage]);
6491 {$ENDIF}
6492 if CTErrorMsg<>'' then exit;
6493 if CodeToolBoss.ErrorMessage<>'' then begin
6494 CTErrorMsg:=CodeToolBoss.ErrorMessage;
6495 CTErrorCode:=CodeToolBoss.ErrorCode;
6496 CTErrorLine:=CodeToolBoss.ErrorLine;
6497 CTErrorCol:=CodeToolBoss.ErrorColumn;
6498 end;
6499 end;
6500
6501 function TryUnitComponent(const UnitFilename: string;
6502 out TheModalResult: TModalResult): boolean;
6503 // returns true if the unit contains the component class and sets
6504 // TheModalResult to the result of the loading
6505 var
6506 CurUnitInfo: TUnitInfo;
6507 begin
6508 {$IFDEF VerboseLFMSearch}
6509 debugln([' TryUnitComponent UnitFilename="',UnitFilename,'"']);
6510 {$ENDIF}
6511 Result:=false;
6512 TheModalResult:=mrCancel;
6513 if not FilenameIsPascalUnit(UnitFilename) then exit;
6514
6515 CurUnitInfo:=Project1.UnitInfoWithFilename(UnitFilename);
6516 if (CurUnitInfo=nil) or (CurUnitInfo.Component=nil) then exit;
6517 // unit with loaded component found -> check if it is the right one
6518 //DebugLn(['FindComponentClass unit with a component found CurUnitInfo=',CurUnitInfo.Filename,' ',dbgsName(CurUnitInfo.Component)]);
6519 if SysUtils.CompareText(CurUnitInfo.Component.ClassName,AComponentClassName)<>0
6520 then exit;
6521 // component found (it was already loaded)
6522 ComponentUnitInfo:=CurUnitInfo;
6523 AComponentClass:=TComponentClass(ComponentUnitInfo.Component.ClassType);
6524 TheModalResult:=mrOk;
6525 Result:=true;
6526 end;
6527
6528 function TryRegisteredClasses(aClassName: string;
6529 out FoundComponentClass: TComponentClass;
6530 out TheModalResult: TModalResult): boolean;
6531 var
6532 RegComp: TRegisteredComponent;
6533 begin
6534 {$IFDEF VerboseLFMSearch}
6535 debugln([' TryRegisteredClasses aClassName="',aClassName,'"']);
6536 {$ENDIF}
6537 Result:=false;
6538 TheModalResult:=mrCancel;
6539 FoundComponentClass:=nil;
6540 if AnUnitInfo.UnitResourceFileformat<>nil then
6541 FoundComponentClass:=AnUnitInfo.UnitResourceFileformat.FindComponentClass(aClassName);
6542 if FoundComponentClass=nil then
6543 begin
6544 RegComp:=IDEComponentPalette.FindRegComponent(aClassName);
6545 if RegComp<>nil then
6546 FoundComponentClass:=RegComp.ComponentClass;
6547 end;
6548 if FoundComponentClass=nil then
6549 FoundComponentClass:=FormEditor1.FindDesignerBaseClassByName(aClassName,true);
6550 if FoundComponentClass<>nil then begin
6551 DebugLn(['FindComponentClass.TryRegisteredClasses found: ',FoundComponentClass.ClassName]);
6552 TheModalResult:=mrOk;
6553 Result:=true;
6554 end;
6555 end;
6556
6557 function TryLFM(const UnitFilename, AClassName: string;
6558 out TheModalResult: TModalResult): boolean;
6559 var
6560 CurLFMFilename: String;
6561 LFMCode: TCodeBuffer;
6562 LFMClassName: String;
6563 LFMType: String;
6564 begin
6565 {$IFDEF VerboseLFMSearch}
6566 debugln([' TryLFM UnitFilename="',UnitFilename,'" AClassName=',AClassName]);
6567 {$ENDIF}
6568 Result:=false;
6569 TheModalResult:=mrCancel;
6570 if not FilenameIsPascalSource(UnitFilename) then
6571 begin
6572 {$IFDEF VerboseLFMSearch}
6573 debugln([' TryLFM UnitFilename="',UnitFilename,'" is not a unit']);
6574 {$ENDIF}
6575 exit;
6576 end;
6577 // ToDo: use UnitResources
6578 CurLFMFilename:=ChangeFileExt(UnitFilename,'.lfm');
6579 if not FileExistsCached(CurLFMFilename) then
6580 begin
6581 {$IFDEF VerboseLFMSearch}
6582 debugln([' TryLFM CurLFMFilename="',CurLFMFilename,'" does not exist']);
6583 {$ENDIF}
6584 CurLFMFilename:=ChangeFileExt(UnitFilename,'.dfm');
6585 if not FileExistsCached(CurLFMFilename) then
6586 begin
6587 {$IFDEF VerboseLFMSearch}
6588 debugln([' TryLFM CurLFMFilename="',CurLFMFilename,'" does not exist']);
6589 {$ENDIF}
6590 exit;
6591 end;
6592 end;
6593 // load the lfm file
6594 TheModalResult:=LoadCodeBuffer(LFMCode,CurLFMFilename,[lbfCheckIfText],true);
6595 if TheModalResult<>mrOk then
6596 begin
6597 debugln('FindComponentClass Failed loading ',CurLFMFilename);
6598 exit;
6599 end;
6600 // read the LFM classname
6601 ReadLFMHeader(LFMCode.Source,LFMClassName,LFMType);
6602 if LFMType='' then ;
6603 if SysUtils.CompareText(LFMClassName,AClassName)<>0 then
6604 begin
6605 {$IFDEF VerboseLFMSearch}
6606 debugln([' TryLFM CurLFMFilename="',CurLFMFilename,'" LFMClassName="',LFMClassName,'" does not match']);
6607 {$ENDIF}
6608 exit;
6609 end;
6610
6611 // .lfm found
6612 LFMFilename:=CurLFMFilename;
6613 Result:=true;
6614 end;
6615
6616 procedure StoreComponentClassDeclaration(UnitFilename: string);
6617 begin
6618 // The Unit declaring AComponentClassName was located, save UnitInfo for return regardless of AComponentClass instance
6619 ComponentUnitInfo:= Project1.UnitInfoWithFilename(UnitFilename);
6620 if not Assigned(ComponentUnitInfo) then begin
6621 // File was not previously loaded, add reference to project (without loading source for now)
6622 ComponentUnitInfo:=TUnitInfo.Create(nil);
6623 ComponentUnitInfo.Filename:=UnitFilename;
6624 ComponentUnitInfo.IsPartOfProject:=false;
6625 Project1.AddFile(ComponentUnitInfo,false);
6626 end;
6627 end;
6628
6629 function TryFindDeclaration(out TheModalResult: TModalResult): boolean;
6630 var
6631 Tool: TCodeTool;
6632
6633 function FindTypeNode(Node: TCodeTreeNode; Level: integer): TCodeTreeNode;
6634 var
6635 TypeNode: TCodeTreeNode;
6636 Child: TCodeTreeNode;
6637 begin
6638 Result:=nil;
6639 if Node=nil then exit;
6640 if Node.Desc=ctnVarDefinition then begin
6641 TypeNode:=Tool.FindTypeNodeOfDefinition(Node);
6642 if (TypeNode=nil) or (TypeNode.Desc<>ctnIdentifier) then exit;
6643 if Tool.CompareSrcIdentifiers(TypeNode.StartPos,PChar(AComponentClassName))
6644 then exit(TypeNode);
6645 end else if Node.Desc=ctnTypeDefinition then begin
6646 if Tool.CompareSrcIdentifiers(Node.StartPos,PChar(AComponentClassName))
6647 then exit(Node);
6648 end;
6649 // increase level on identifier nodes
6650 if Node.Desc in AllIdentifierDefinitions then begin
6651 if Level=1 then exit; // ignore nested vars
6652 inc(Level);
6653 end;
6654 Child:=Node.FirstChild;
6655 while Child<>nil do begin
6656 Result:=FindTypeNode(Child,Level);
6657 if Result<>nil then exit;
6658 Child:=Child.NextBrother;
6659 end;
6660 end;
6661
6662 var
6663 Code: TCodeBuffer;
6664 Params: TFindDeclarationParams;
6665 NewNode: TCodeTreeNode;
6666 NewTool: TFindDeclarationTool;
6667 InheritedNode: TCodeTreeNode;
6668 ClassNode: TCodeTreeNode;
6669 AncestorNode: TCodeTreeNode;
6670 AncestorClassName: String;
6671 Node: TCodeTreeNode;
6672 ok: Boolean;
6673 begin
6674 Result:=false;
6675 TheModalResult:=mrCancel;
6676 // parse interface current unit
6677 Code:=CodeToolBoss.LoadFile(AnUnitInfo.Filename,false,false);
6678 if Code=nil then begin
6679 debugln(['FindComponentClass unable to load ',AnUnitInfo.Filename]);
6680 exit;
6681 end;
6682 if not CodeToolBoss.Explore(Code,Tool,false,true) then begin
6683 {$IFDEF VerboseLFMSearch}
6684 debugln([' CodeToolBoss.Explore failed: ',Code.Filename]);
6685 {$ENDIF}
6686 StoreCodetoolsError;
6687 exit;
6688 end;
6689 Params:=TFindDeclarationParams.Create;
6690 try
6691 ok:=false;
6692 try
6693 // search a class reference in the unit
6694 Node:=Tool.FindInterfaceNode;
6695 if Node=nil then
6696 Node:=Tool.Tree.Root;
6697 Node:=FindTypeNode(Node,0);
6698 if Node=nil then begin
6699 debugln('FindComponentClass Failed finding reference of ',AComponentClassName,' in ',Code.Filename);
6700 exit;
6701 end;
6702 if Node.Desc=ctnIdentifier then begin
6703 //debugln(['TryFindDeclaration found reference of ',AComponentClassName,' at ',Tool.CleanPosToStr(Node.StartPos)]);
6704 Params.ContextNode:=Node;
6705 Params.Flags:=[fdfSearchInParentNodes,fdfExceptionOnNotFound,
6706 fdfExceptionOnPredefinedIdent,
6707 fdfTopLvlResolving,fdfSearchInAncestors,
6708 fdfIgnoreCurContextNode];
6709 Params.SetIdentifier(Tool,@Tool.Src[Node.StartPos],nil);
6710 if not Tool.FindIdentifierInContext(Params) then begin
6711 debugln(['FindComponentClass find declaration failed at ',Tool.CleanPosToStr(Node.StartPos,true)]);
6712 exit;
6713 end;
6714 NewNode:=Params.NewNode;
6715 NewTool:=Params.NewCodeTool;
6716 end else begin
6717 NewNode:=Node;
6718 NewTool:=Tool;
6719 end;
6720 ok:=true;
6721 except
6722 on E: Exception do
6723 CodeToolBoss.HandleException(E);
6724 end;
6725 if not ok then begin
6726 {$IFDEF VerboseLFMSearch}
6727 debugln([' find declaration failed.']);
6728 {$ENDIF}
6729 StoreCodetoolsError;
6730 exit;
6731 end;
6732 // declaration found
6733 ClassNode:=NewNode.FirstChild;
6734 if (NewNode.Desc<>ctnTypeDefinition)
6735 or (ClassNode=nil) or (ClassNode.Desc<>ctnClass) then
6736 begin
6737 debugln(['FindComponentClass ',AComponentClassName,' is not a class at ',NewTool.CleanPosToStr(NewNode.StartPos,true)]);
6738 exit;
6739 end;
6740 // find inheritance list
6741 InheritedNode:=ClassNode.FirstChild;
6742 while (InheritedNode<>nil) and (InheritedNode.Desc<>ctnClassInheritance) do
6743 InheritedNode:=InheritedNode.NextBrother;
6744 if (InheritedNode=nil) or (InheritedNode.FirstChild=nil) then begin
6745 debugln(['FindComponentClass ',AComponentClassName,' is not a TComponent at ',NewTool.CleanPosToStr(NewNode.StartPos,true)]);
6746 exit;
6747 end;
6748 StoreComponentClassDeclaration(NewTool.MainFilename);
6749 AncestorNode:=InheritedNode.FirstChild;
6750 AncestorClassName:=GetIdentifier(@NewTool.Src[AncestorNode.StartPos]);
6751 //debugln(['TryFindDeclaration declaration of ',AComponentClassName,' found at ',NewTool.CleanPosToStr(NewNode.StartPos),' ancestor="',AncestorClassName,'"']);
6752
6753 // try unit component
6754 if TryUnitComponent(NewTool.MainFilename,TheModalResult) then
6755 exit(true);
6756
6757 // try lfm
6758 if TryLFM(NewTool.MainFilename,AComponentClassName,TheModalResult) then
6759 exit(true);
6760
6761 // search ancestor in registered classes
6762 if TryRegisteredClasses(AncestorClassName,AncestorClass,TheModalResult) then
6763 exit(true);
6764
6765 {$IFDEF VerboseLFMSearch}
6766 debugln(['TryFindDeclaration declaration of ',AComponentClassName,' found at ',NewTool.CleanPosToStr(NewNode.StartPos),' Ancestor="',AncestorClassName,'", but no lfm and no registered class found']);
6767 {$ENDIF}
6768 finally
6769 Params.Free;
6770 end;
6771 end;
6772
6773 function TryUsedUnitInterface(UnitFilename: string; out TheModalResult: TModalResult): boolean;
6774 var
6775 Code: TCodeBuffer;
6776 AncestorClassName: string;
6777 begin
6778 {$IFDEF VerboseLFMSearch}
6779 debugln([' TryUsedUnitInterface UnitFilename="',UnitFilename,'"']);
6780 {$ENDIF}
6781 Result:=false;
6782 TheModalResult:=mrCancel;
6783 if not FilenameIsPascalSource(UnitFilename) then
6784 begin
6785 {$IFDEF VerboseLFMSearch}
6786 debugln([' TryUsedUnitInterface UnitFilename="',UnitFilename,'" is not a unit']);
6787 {$ENDIF}
6788 exit;
6789 end;
6790 Code:=CodeToolBoss.LoadFile(UnitFilename,true,false);
6791 if Code=nil then begin
6792 debugln(['FindComponentClass unable to load ',AnUnitInfo.Filename]);
6793 exit;
6794 end;
6795 if not CodeToolBoss.FindFormAncestor(Code,AComponentClassName,AncestorClassName,true) then
6796 begin
6797 {$IFDEF VerboseLFMSearch}
6798 debugln([' TryUsedUnitInterface FindFormAncestor failed for "',AComponentClassName,'"']);
6799 {$ENDIF}
6800 StoreCodetoolsError;
6801 exit;
6802 end;
6803 if AncestorClassName='' then begin
6804 {$IFDEF VerboseLFMSearch}
6805 debugln([' TryUsedUnitInterface FindFormAncestor failed silently for "',AComponentClassName,'"']);
6806 {$ENDIF}
6807 exit;
6808 end;
6809 StoreComponentClassDeclaration(UnitFilename);
6810 if TryRegisteredClasses(AncestorClassName,AncestorClass,TheModalResult) then
6811 exit(true);
6812 end;
6813
6814 var
6815 UsedUnitFilenames: TStrings;
6816 i: Integer;
6817 begin
6818 Result:=mrCancel;
6819 AComponentClass:=nil;
6820 ComponentUnitInfo:=nil;
6821 AncestorClass:=nil;
6822 LFMFilename:='';
6823 CTErrorMsg:='';
6824 CTErrorCode:=nil;
6825 CTErrorLine:=0;
6826 CTErrorCol:=0;
6827
6828 if not IsValidIdent(AComponentClassName) then
6829 begin
6830 DebugLn(['FindComponentClass invalid component class name "',AComponentClassName,'"']);
6831 exit(mrCancel);
6832 end;
6833
6834 // search component lfm
6835 {$ifdef VerboseFormEditor}
6836 debugln('FindComponentClass START ',AnUnitInfo.Filename,' AComponentClassName=',AComponentClassName);
6837 {$endif}
6838 // first search the resource of AnUnitInfo
6839 if AnUnitInfo<>nil then begin
6840 if TryUnitComponent(AnUnitInfo.Filename,Result) then exit;
6841 end;
6842
6843 // then try registered global classes
6844 if TryRegisteredClasses(AComponentClassName,AComponentClass,Result) then exit;
6845
6846 // search in used units
6847 UsedUnitFilenames:=nil;
6848 try
6849 if not CodeToolBoss.FindUsedUnitFiles(AnUnitInfo.Source,UsedUnitFilenames)
6850 then begin
6851 MainIDE.DoJumpToCodeToolBossError;
6852 exit(mrCancel);
6853 end;
6854
6855 {$IFDEF VerboseLFMSearch}
6856 if (UsedUnitFilenames=nil) or (UsedUnitFilenames.Count=0) then
6857 debugln(['FindComponentClass unit has no main uses']);
6858 {$ENDIF}
6859
6860 if (UsedUnitFilenames<>nil) then begin
6861 // search for every used unit the .lfm file
6862 for i:=UsedUnitFilenames.Count-1 downto 0 do begin
6863 if TryLFM(UsedUnitFilenames[i],AComponentClassName,Result) then exit;
6864 end;
6865 // search class via codetools
6866 if TryFindDeclaration(Result) then exit;
6867 // search the class in every used unit
6868 for i:=UsedUnitFilenames.Count-1 downto 0 do begin
6869 if TryUsedUnitInterface(UsedUnitFilenames[i],Result) then exit;
6870 end;
6871 end;
6872 finally
6873 UsedUnitFilenames.Free;
6874 end;
6875
6876 // no 100% loadable match found, did we at least get a ComponentUnitInfo?
6877 if Assigned(ComponentUnitInfo) then
6878 // Return "located, but not loaded" information
6879 Result:= mrOK
6880 else
6881 Result:= mrCancel;
6882
6883 // not found
6884 if Quiet then exit;
6885
6886 // show codetool error
6887 if CTErrorMsg<>'' then begin
6888 CodeToolBoss.SetError(20170421203251,CTErrorCode,CTErrorLine,CTErrorCol,CTErrorMsg);
6889 MainIDE.DoJumpToCodeToolBossError;
6890 Result:=mrAbort;
6891 end;
6892 end;
6893
6894 function LoadComponentDependencyHidden(AnUnitInfo: TUnitInfo;
6895 const AComponentClassName: string; Flags: TOpenFlags; MustHaveLFM: boolean;
6896 out AComponentClass: TComponentClass; out ComponentUnitInfo: TUnitInfo;
6897 out AncestorClass: TComponentClass; const IgnoreBtnText: string): TModalResult;
6898 { Possible results:
6899 mrOk:
6900 - AComponentClass<>nil and ComponentUnitInfo<>nil
6901 designer component
6902 - AComponentClass<>nil and ComponentUnitInfo=nil
6903 registered componentclass
6904 - AComponentClass=nil and ComponentUnitInfo<>nil
6905 componentclass does not exist, but the unit declaring AComponentClassName was found
6906 - Only for MustHaveLFM=false: AncestorClass<>nil
6907 componentclass does not exist, but the ancestor is a registered class
6908 mrCancel:
6909 not found, skip this form
6910 mrAbort:
6911 not found, user wants to stop all pending operations
6912 mrIgnore:
6913 not found, user wants to skip this step and continue
6914 }
6915
6916 function TryLFM(LFMFilename: string): TModalResult;
6917 var
6918 UnitFilename: String;
6919 CurUnitInfo: TUnitInfo;
6920 LFMCode: TCodeBuffer;
6921 LFMClassName: String;
6922 LFMType: String;
6923 UnitCode: TCodeBuffer;
6924 begin
6925 // load lfm
6926 Result:=LoadCodeBuffer(LFMCode,LFMFilename,[lbfCheckIfText],true);
6927 if Result<>mrOk then begin
6928 {$IFDEF VerboseLFMSearch}
6929 debugln([' TryLFM LoadCodeBuffer failed ',LFMFilename]);
6930 {$ENDIF}
6931 exit;
6932 end;
6933 // check if the unit component is already loaded
6934 UnitFilename:=ChangeFileExt(LFMFilename,'.pas');
6935 CurUnitInfo:=Project1.UnitInfoWithFilename(UnitFilename);
6936 if CurUnitInfo=nil then begin
6937 UnitFilename:=ChangeFileExt(LFMFilename,'.pp');
6938 CurUnitInfo:=Project1.UnitInfoWithFilename(UnitFilename);
6939 end;
6940 ReadLFMHeader(LFMCode.Source,LFMClassName,LFMType);
6941 if CurUnitInfo=nil then
6942 begin
6943 // load unit source
6944 UnitFilename:=ChangeFileExt(LFMFilename,'.pas');
6945 if not FileExistsCached(UnitFilename) then
6946 UnitFilename:=ChangeFileExt(LFMFilename,'.pp');
6947 Result:=LoadCodeBuffer(UnitCode,UnitFilename,[lbfCheckIfText],true);
6948 if Result<>mrOk then
6949 exit;
6950 // create unit info
6951 CurUnitInfo:=TUnitInfo.Create(UnitCode);
6952 CurUnitInfo.ReadUnitNameFromSource(true);
6953 Project1.AddFile(CurUnitInfo,false);
6954 end
6955 else if (CurUnitInfo.Component<>nil) then
6956 begin
6957 // component already loaded
6958 if SysUtils.CompareText(CurUnitInfo.Component.ClassName,LFMClassName)<>0
6959 then begin
6960 {$IFDEF VerboseLFMSearch}
6961 debugln([' TryLFM ERROR lfmclass=',LFMClassName,' unit.component=',DbgSName(CurUnitInfo.Component)]);
6962 {$ENDIF}
6963 IDEMessageDialog('Error','Unable to load "'+LFMFilename+'".'
6964 +' The component '+DbgSName(CurUnitInfo.Component)
6965 +' is already loaded for unit "'+CurUnitInfo.Filename+'"'#13
6966 +'LFM contains a different class name "'+LFMClassName+'".',
6967 mtError,[mbCancel]);
6968 exit(mrAbort);
6969 end;
6970 ComponentUnitInfo:=CurUnitInfo;
6971 AComponentClass:=TComponentClass(ComponentUnitInfo.Component.ClassType);
6972 exit(mrOK);
6973 end;
6974
6975 // load resource hidden
6976 Result:=LoadLFM(CurUnitInfo,LFMCode,Flags+[ofLoadHiddenResource],[]);
6977 if Result=mrOk then
6978 begin
6979 ComponentUnitInfo:=CurUnitInfo;
6980 AComponentClass:=TComponentClass(ComponentUnitInfo.Component.ClassType);
6981 {$if defined(VerboseFormEditor) or defined(VerboseLFMSearch)}
6982 debugln('LoadComponentDependencyHidden Wanted=',AComponentClassName,' Class=',AComponentClass.ClassName);
6983 {$endif}
6984 end else begin
6985 debugln('LoadComponentDependencyHidden Failed to load component ',AComponentClassName);
6986 Result:=mrCancel;
6987 end;
6988 end;
6989
6990 var
6991 Quiet, HideAbort: Boolean;
6992 LFMFilename, MsgText: string;
6993 begin
6994 Result:=mrCancel;
6995 AComponentClass:=nil;
6996 Quiet:=([ofProjectLoading,ofQuiet]*Flags<>[]);
6997 HideAbort:=not (ofProjectLoading in Flags);
6998
6999 { Will be checked in FindComponentClass()
7000 if not IsValidIdent(AComponentClassName) then
7001 begin
7002 DebugLn(['LoadComponentDependencyHidden invalid component class name "',AComponentClassName,'"']);
7003 exit(mrCancel);
7004 end;
7005 }
7006
7007 // check for cycles
7008 if AnUnitInfo.LoadingComponent then begin
7009 Result:=IDEQuestionDialogAb(lisCodeTemplError,
7010 Format(lisUnableToLoadTheComponentClassBecauseItDependsOnIts, [AComponentClassName]),
7011 mtError, [mrCancel, lisCancelLoadingThisComponent], HideAbort);
7012 exit;
7013 end;
7014
7015 AnUnitInfo.LoadingComponent:=true;
7016 try
7017 // search component lfm
7018 {$if defined(VerboseFormEditor) or defined(VerboseLFMSearch)}
7019 debugln('LoadComponentDependencyHidden ',AnUnitInfo.Filename,' AComponentClassName=',AComponentClassName,
7020 ' AComponentClass=',dbgsName(AComponentClass));
7021 {$endif}
7022 Result:=FindComponentClass(AnUnitInfo,AComponentClassName,Quiet,
7023 ComponentUnitInfo,AComponentClass,LFMFilename,AncestorClass);
7024 { $if defined(VerboseFormEditor) or defined(VerboseLFMSearch)}
7025 debugln('LoadComponentDependencyHidden ',AnUnitInfo.Filename,' AComponentClassName=',AComponentClassName,
7026 ' AComponentClass=',dbgsName(AComponentClass),' AncestorClass=',DbgSName(AncestorClass),' LFMFilename=',LFMFilename);
7027 { $endif}
7028
7029 //- AComponentClass<>nil and ComponentUnitInfo<>nil
7030 // designer component
7031 //- AComponentClass<>nil and ComponentUnitInfo=nil
7032 // registered componentclass
7033 //- AComponentClass=nil and ComponentUnitInfo<>nil
7034 // componentclass does not exist, but the unit declaring AComponentClassName was found
7035 //- LFMFilename<>''
7036 // lfm of an used unit
7037 //- AncestorClass<>nil
7038 // componentclass does not exist, but the ancestor is a registered class
7039
7040 if (Result=mrOk) and (AComponentClass=nil) and (LFMFilename<>'') then
7041 exit(TryLFM(LFMFilename));
7042
7043 if MustHaveLFM and (AComponentClass=nil) then
7044 Result:=mrCancel;
7045 if Result=mrAbort then exit;
7046 if Result<>mrOk then begin
7047 MsgText:=Format(lisUnableToFindTheComponentClassItIsNotRegisteredViaR, [
7048 AComponentClassName, LineEnding, LineEnding, LineEnding, AnUnitInfo.Filename]);
7049 if IgnoreBtnText<>'' then
7050 Result:=IDEQuestionDialogAb(lisCodeTemplError, MsgText, mtError,
7051 [mrCancel, lisCancelLoadingThisComponent,
7052 mrIgnore, IgnoreBtnText], HideAbort)
7053 else
7054 Result:=IDEQuestionDialogAb(lisCodeTemplError, MsgText, mtError,
7055 [mrCancel, lisCancelLoadingThisComponent], HideAbort);
7056 end;
7057 finally
7058 AnUnitInfo.LoadingComponent:=false;
7059 end;
7060 end;
7061
7062 function LoadIDECodeBuffer(var ACodeBuffer: TCodeBuffer;
7063 const AFilename: string; Flags: TLoadBufferFlags; ShowAbort: boolean): TModalResult;
7064 begin
7065 if (Project1<>nil)
7066 and (Project1.UnitInfoWithFilename(AFilename,[pfsfOnlyEditorFiles])<>nil) then
7067 Exclude(Flags,lbfUpdateFromDisk);
7068 Result:=LoadCodeBuffer(ACodeBuffer,AFilename,Flags,ShowAbort);
7069 end;
7070
7071 function CloseUnitComponent(AnUnitInfo: TUnitInfo; Flags: TCloseFlags): TModalResult;
7072
7073 procedure FreeUnusedComponents;
7074 var
7075 CompUnitInfo: TUnitInfo;
7076 begin
7077 CompUnitInfo:=Project1.FirstUnitWithComponent;
7078 Project1.UpdateUnitComponentDependencies;
7079 while CompUnitInfo<>nil do begin
7080 //DebugLn(['FreeUnusedComponents ',CompUnitInfo.Filename,' ',dbgsName(CompUnitInfo.Component),' UnitComponentIsUsed=',UnitComponentIsUsed(CompUnitInfo,true)]);
7081 if not UnitComponentIsUsed(CompUnitInfo,true) then begin
7082 // close the unit component
7083 CloseUnitComponent(CompUnitInfo,Flags);
7084 // this has recursively freed all components, so exit here
7085 exit;
7086 end;
7087 CompUnitInfo:=CompUnitInfo.NextUnitWithComponent;
7088 end;
7089 end;
7090
7091 var
7092 OldDesigner: TIDesigner;
7093 AForm: TCustomForm;
7094 LookupRoot: TComponent;
7095 ComponentStillUsed: Boolean;
7096 begin
7097 LookupRoot:=AnUnitInfo.Component;
7098 if LookupRoot=nil then exit(mrOk);
7099 {$IFDEF VerboseIDEMultiForm}
7100 DebugLn(['CloseUnitComponent ',AnUnitInfo.Filename,' ',dbgsName(LookupRoot)]);
7101 {$ENDIF}
7102
7103 Project1.LockUnitComponentDependencies; // avoid circles
7104 try
7105 // save
7106 if (cfSaveFirst in Flags) and (AnUnitInfo.OpenEditorInfoCount > 0)
7107 and (not AnUnitInfo.IsReverting) then begin
7108 Result:=SaveEditorFile(AnUnitInfo.OpenEditorInfo[0].EditorComponent,[sfCheckAmbiguousFiles]);
7109 if Result<>mrOk then begin
7110 DebugLn(['CloseUnitComponent DoSaveEditorFile failed']);
7111 exit;
7112 end;
7113 end;
7114
7115 // close dependencies
7116 if cfCloseDependencies in Flags then begin
7117 {$IFDEF VerboseIDEMultiForm}
7118 DebugLn(['CloseUnitComponent cfCloseDependencies ',AnUnitInfo.Filename,' ',dbgsName(LookupRoot)]);
7119 {$ENDIF}
7120 Result:=CloseDependingUnitComponents(AnUnitInfo,Flags);
7121 if Result<>mrOk then begin
7122 DebugLn(['CloseUnitComponent CloseDependingUnitComponents failed']);
7123 exit;
7124 end;
7125 // now only soft dependencies are left. The component can be freed.
7126 end;
7127
7128 AForm:=FormEditor1.GetDesignerForm(LookupRoot);
7129 if AForm<>nil then
7130 OldDesigner:=AForm.Designer
7131 else
7132 OldDesigner:=nil;
7133 if MainIDE.LastFormActivated=AForm then
7134 MainIDE.LastFormActivated:=nil;
7135 ComponentStillUsed:=(not (cfCloseDependencies in Flags))
7136 and UnitComponentIsUsed(AnUnitInfo,false);
7137 {$IFDEF VerboseTFrame}
7138 DebugLn(['CloseUnitComponent ',AnUnitInfo.Filename,' ComponentStillUsed=',ComponentStillUsed,' UnitComponentIsUsed=',UnitComponentIsUsed(AnUnitInfo,false),' ',dbgs(AnUnitInfo.Flags),' DepAncestor=',AnUnitInfo.FindUsedByComponentDependency([ucdtAncestor])<>nil,' DepInline=',AnUnitInfo.FindUsedByComponentDependency([ucdtInlineClass])<>nil]);
7139 {$ENDIF}
7140 if (OldDesigner=nil) then begin
7141 // hidden component
7142 //DebugLn(['CloseUnitComponent freeing hidden component without designer: ',AnUnitInfo.Filename,' ',DbgSName(AnUnitInfo.Component)]);
7143 if ComponentStillUsed then begin
7144 // hidden component is still used => keep it
7145 {$IFDEF VerboseIDEMultiForm}
7146 DebugLn(['CloseUnitComponent hidden component is still used => keep it ',AnUnitInfo.Filename,' ',DbgSName(AnUnitInfo.Component)]);
7147 {$ENDIF}
7148 end else begin
7149 // hidden component is not used => free it
7150 {$IFDEF VerboseIDEMultiForm}
7151 DebugLn(['CloseUnitComponent hidden component is not used => free it ',AnUnitInfo.Filename,' ',DbgSName(AnUnitInfo.Component)]);
7152 {$ENDIF}
7153 try
7154 FormEditor1.DeleteComponent(LookupRoot,true);
7155 finally
7156 AnUnitInfo.Component:=nil;
7157 end;
7158 FreeUnusedComponents;
7159 end;
7160 end else begin
7161 // component with designer
7162 AnUnitInfo.LoadedDesigner:=false;
7163 if ComponentStillUsed then begin
7164 // free designer, keep component hidden
7165 {$IFDEF VerboseIDEMultiForm}
7166 DebugLn(['CloseUnitComponent hiding component and freeing designer: ',AnUnitInfo.Filename,' ',DbgSName(AnUnitInfo.Component)]);
7167 {$ENDIF}
7168 OldDesigner.PrepareFreeDesigner(false);
7169 end else begin
7170 // free designer and design form
7171 {$IFDEF VerboseIDEMultiForm}
7172 DebugLn(['CloseUnitComponent freeing component and designer: ',AnUnitInfo.Filename,' ',DbgSName(AnUnitInfo.Component)]);
7173 {$ENDIF}
7174 try
7175 OldDesigner.PrepareFreeDesigner(true);
7176 finally
7177 AnUnitInfo.Component:=nil;
7178 end;
7179 end;
7180 Project1.InvalidateUnitComponentDesignerDependencies;
7181 FreeUnusedComponents;
7182 end;
7183 finally
7184 Project1.UnlockUnitComponentDependencies;
7185 end;
7186 Result:=mrOk;
7187 end;
7188
7189 function CloseDependingUnitComponents(AnUnitInfo: TUnitInfo; Flags: TCloseFlags): TModalResult;
7190 var
7191 UserAsked: Boolean;
7192
7193 function CloseNext(var ModResult: TModalresult;
7194 Types: TUnitCompDependencyTypes): boolean;
7195 var
7196 DependingUnitInfo: TUnitInfo;
7197 DependenciesFlags: TCloseFlags;
7198 begin
7199 ModResult:=mrOk;
7200 repeat
7201 DependingUnitInfo:=Project1.UnitUsingComponentUnit(AnUnitInfo,Types);
7202 if DependingUnitInfo=nil then break;
7203 if (not UserAsked) and (not (cfQuiet in Flags))
7204 and (not DependingUnitInfo.IsReverting) then begin
7205 // ToDo: collect in advance all components to close and show user the list
7206 ModResult:=IDEQuestionDialog('Close component?',
7207 'Close component '+dbgsName(DependingUnitInfo.Component)+'?',
7208 mtConfirmation,[mrYes,mrAbort]);
7209 if ModResult<>mrYes then exit(false);
7210 UserAsked:=true;
7211 end;
7212 // close recursively
7213 DependenciesFlags:=Flags+[cfCloseDependencies];
7214 if cfSaveDependencies in Flags then
7215 Include(DependenciesFlags,cfSaveFirst);
7216 ModResult:=CloseUnitComponent(DependingUnitInfo,DependenciesFlags);
7217 if ModResult<>mrOk then exit(false);
7218 until false;
7219 ModResult:=mrOk;
7220 Result:=true;
7221 end;
7222
7223 begin
7224 Result:=mrOk;
7225 UserAsked:=false;
7226 Project1.LockUnitComponentDependencies;
7227 try
7228 // Important:
7229 // This function is called recursively.
7230 // It is important that first the hard, non cyclic dependencies
7231 // are freed in the correct order.
7232 // After that the soft, cyclic dependencies can be freed in any order.
7233
7234 // first close all descendants recursively
7235 // This must happen in the right order (descendants before ancestor)
7236 if not CloseNext(Result,[ucdtAncestor]) then exit;
7237
7238 // then close all nested descendants recursively
7239 // This must happen in the right order (nested descendants before ancestor)
7240 if not CloseNext(Result,[ucdtInlineClass]) then exit;
7241
7242 // then close all referring components
7243 // These can build cycles and can be freed in any order.
7244 if not CloseNext(Result,[ucdtProperty]) then exit;
7245 finally
7246 Project1.UnlockUnitComponentDependencies;
7247 end;
7248 Result:=mrOk;
7249 end;
7250
7251 function UnitComponentIsUsed(AnUnitInfo: TUnitInfo;
7252 CheckHasDesigner: boolean): boolean;
7253 // if CheckHasDesigner=true and AnUnitInfo has a designer (visible) return true
7254 // otherwise check if another unit needs AnUnitInfo
7255 var
7256 LookupRoot: TComponent;
7257 begin
7258 Result:=false;
7259 LookupRoot:=AnUnitInfo.Component;
7260 if LookupRoot=nil then exit;
7261 // check if a designer or another component uses this component
7262 Project1.UpdateUnitComponentDependencies;
7263 if Project1.UnitComponentIsUsed(AnUnitInfo,CheckHasDesigner) then
7264 exit(true);
7265 //DebugLn(['UnitComponentIsUsed ',AnUnitInfo.Filename,' ',dbgs(AnUnitInfo.Flags)]);
7266 end;
7267
7268 function RemoveFilesFromProject(UnitInfos: TFPList): TModalResult;
7269 var
7270 AnUnitInfo: TUnitInfo;
7271 ShortUnitName, UnitPath: String;
7272 ObsoleteUnitPaths, ObsoleteIncPaths: String;
7273 i: Integer;
7274 SomeRemoved: Boolean;
7275 begin
7276 Result:=mrOk;
7277 Assert(Assigned(UnitInfos));
7278 // check ToolStatus
7279 if (MainIDE.ToolStatus in [itCodeTools,itCodeToolAborting]) then begin
7280 debugln('RemoveUnitsFromProject wrong ToolStatus ',dbgs(ord(MainIDE.ToolStatus)));
7281 exit;
7282 end;
7283 // commit changes from source editor to codetools
7284 SaveEditorChangesToCodeCache(nil);
7285 SomeRemoved:=false;
7286 ObsoleteUnitPaths:='';
7287 ObsoleteIncPaths:='';
7288 Project1.BeginUpdate(true);
7289 try
7290 for i:=0 to UnitInfos.Count-1 do
7291 begin
7292 AnUnitInfo:=TUnitInfo(UnitInfos[i]);
7293 if not AnUnitInfo.IsPartOfProject then continue;
7294 UnitPath:=ChompPathDelim(ExtractFilePath(AnUnitInfo.Filename));
7295 AnUnitInfo.IsPartOfProject:=false;
7296 SomeRemoved:=true;
7297 Project1.Modified:=true;
7298 if FilenameIsPascalUnit(AnUnitInfo.Filename) then
7299 begin
7300 if FilenameIsAbsolute(AnUnitInfo.Filename) then
7301 ObsoleteUnitPaths:=MergeSearchPaths(ObsoleteUnitPaths,UnitPath);
7302 // remove from project's unit section
7303 if (Project1.MainUnitID>=0)
7304 and (pfMainUnitIsPascalSource in Project1.Flags)
7305 then begin
7306 ShortUnitName:=ExtractFileNameOnly(AnUnitInfo.Filename);
7307 if (ShortUnitName<>'') then begin
7308 if not CodeToolBoss.RemoveUnitFromAllUsesSections(
7309 Project1.MainUnitInfo.Source,ShortUnitName) then
7310 begin
7311 MainIDE.DoJumpToCodeToolBossError;
7312 exit(mrCancel);
7313 end;
7314 end;
7315 end;
7316 // remove CreateForm statement from project
7317 if (Project1.MainUnitID>=0) and (AnUnitInfo.ComponentName<>'')
7318 and (pfMainUnitHasCreateFormStatements in Project1.Flags) then
7319 // Do not care if this fails. A user may have removed the line from source.
7320 Project1.RemoveCreateFormFromProjectFile(AnUnitInfo.ComponentName);
7321 end;
7322 if FilenameExtIs(AnUnitInfo.Filename,'inc') then
7323 // include file
7324 if FilenameIsAbsolute(AnUnitInfo.Filename) then
7325 ObsoleteIncPaths:=MergeSearchPaths(ObsoleteIncPaths,UnitPath);
7326 end;
7327 if not SomeRemoved then exit; // No units were actually removed.
7328
7329 // removed directories still used for ObsoleteUnitPaths, ObsoleteIncPaths
7330 AnUnitInfo:=Project1.FirstPartOfProject;
7331 while AnUnitInfo<>nil do begin
7332 if FilenameIsAbsolute(AnUnitInfo.Filename) then begin
7333 UnitPath:=ChompPathDelim(ExtractFilePath(AnUnitInfo.Filename));
7334 if FilenameIsPascalUnit(AnUnitInfo.Filename) then
7335 ObsoleteUnitPaths:=RemoveSearchPaths(ObsoleteUnitPaths,UnitPath);
7336 if FilenameExtIs(AnUnitInfo.Filename,'inc') then
7337 ObsoleteIncPaths:=RemoveSearchPaths(ObsoleteIncPaths,UnitPath);
7338 end;
7339 AnUnitInfo:=AnUnitInfo.NextPartOfProject;
7340 end;
7341
7342 // check if compiler options contain paths of ObsoleteUnitPaths
7343 if ObsoleteUnitPaths<>'' then
7344 RemovePathFromBuildModes(ObsoleteUnitPaths, pcosUnitPath);
7345 // or paths of ObsoleteIncPaths
7346 if ObsoleteIncPaths<>'' then
7347 RemovePathFromBuildModes(ObsoleteIncPaths, pcosIncludePath);
7348
7349 finally
7350 // all changes were handled automatically by events, just clear the logs
7351 if SomeRemoved then
7352 CodeToolBoss.SourceCache.ClearAllSourceLogEntries;
7353 Project1.EndUpdate;
7354 end;
7355 end;
7356
7357 // methods for open project, create project from source
7358
7359 function CompleteLoadingProjectInfo: TModalResult;
7360 begin
7361 MainIDE.UpdateCaption;
7362 EnvironmentOptions.LastSavedProjectFile:=Project1.ProjectInfoFile;
7363 MainIDE.SaveEnvironment;
7364
7365 MainBuildBoss.SetBuildTargetProject1(false);
7366
7367 // load required packages
7368 PkgBoss.OpenProjectDependencies(Project1, MainIDE.IDEStarted);
7369 Project1.DefineTemplates.Active:=true;
7370 MainIDE.UpdateDefineTemplates;
7371 Result:=mrOk;
7372 end;
7373
7374 // Methods for 'save project'
7375
7376 function SaveProjectInfo(var Flags: TSaveFlags): TModalResult;
7377 var
7378 MainUnitInfo: TUnitInfo;
7379 MainUnitSrcEdit: TSourceEditor;
7380 DestFilename: String;
7381 SkipSavingMainSource: Boolean;
7382 begin
7383 Result:=mrOk;
7384 Project1.ActiveWindowIndexAtStart := SourceEditorManager.ActiveSourceWindowIndex;
7385
7386 // update source notebook page names
7387 UpdateSourceNames;
7388
7389 // find mainunit
7390 GetMainUnit(MainUnitInfo, MainUnitSrcEdit);
7391
7392 // save project specific settings of the source editor
7393 SaveSourceEditorProjectSpecificSettings;
7394
7395 if Project1.IsVirtual
7396 and (not (sfDoNotSaveVirtualFiles in Flags)) then
7397 Include(Flags,sfSaveAs);
7398 if ([sfSaveAs,sfSaveToTestDir]*Flags=[sfSaveAs]) then begin
7399 // let user choose a filename
7400 Result:=ShowSaveProjectAsDialog(sfSaveMainSourceAs in Flags);
7401 if Result<>mrOk then begin
7402 debugln(['Info: (lazarus) [SaveProjectInfo] ShowSaveProjectAsDialog failed']);
7403 exit;
7404 end;
7405 Flags:=Flags-[sfSaveAs,sfSaveMainSourceAs];
7406 end;
7407
7408 // update HasResources information
7409 UpdateProjectResourceInfo;
7410
7411 // save project info file
7412 //debugln(['SaveProjectInfo ',Project1.ProjectInfoFile,' Test=',sfSaveToTestDir in Flags,' Virt=',Project1.IsVirtual]);
7413 if (not (sfSaveToTestDir in Flags))
7414 and (not Project1.IsVirtual) then begin
7415 Result:=Project1.WriteProject([],'',EnvironmentOptions.BuildMatrixOptions);
7416 if Result=mrAbort then begin
7417 debugln(['Info: (lazarus) [SaveProjectInfo] Project1.WriteProject failed']);
7418 exit;
7419 end;
7420 EnvironmentOptions.LastSavedProjectFile:=Project1.ProjectInfoFile;
7421 IDEProtocolOpts.LastProjectLoadingCrashed := False;
7422 AddRecentProjectFile(Project1.ProjectInfoFile);
7423 MainIDE.SaveIncludeLinks;
7424 MainIDE.UpdateCaption;
7425 end;
7426
7427 // save main source
7428 if (MainUnitInfo<>nil) and (not (sfDoNotSaveVirtualFiles in flags)) then
7429 begin
7430 if not (sfSaveToTestDir in Flags) then
7431 DestFilename := MainUnitInfo.Filename
7432 else
7433 DestFilename := MainBuildBoss.GetTestUnitFilename(MainUnitInfo);
7434
7435 if MainUnitInfo.OpenEditorInfoCount > 0 then
7436 begin
7437 // loaded in source editor
7438 Result:=SaveEditorFile(MainUnitInfo.OpenEditorInfo[0].EditorComponent,
7439 [sfProjectSaving]+[sfSaveToTestDir,sfCheckAmbiguousFiles]*Flags);
7440 if Result=mrAbort then begin
7441 debugln(['Info: (lazarus) [SaveProjectInfo] SaveEditorFile MainUnitInfo failed "',DestFilename,'"']);
7442 exit;
7443 end;
7444 end else
7445 begin
7446 // not loaded in source editor (hidden)
7447 SkipSavingMainSource := false;
7448 if not (sfSaveToTestDir in Flags) and not MainUnitInfo.NeedsSaveToDisk then
7449 SkipSavingMainSource := true;
7450 if (not SkipSavingMainSource) and (MainUnitInfo.Source<>nil) then
7451 begin
7452 Result:=SaveCodeBufferToFile(MainUnitInfo.Source, DestFilename);
7453 if Result=mrAbort then begin
7454 debugln(['Info: (lazarus) [SaveProjectInfo] SaveEditorFile failed "',DestFilename,'"']);
7455 exit;
7456 end;
7457 end;
7458 end;
7459
7460 // clear modified flags
7461 if not (sfSaveToTestDir in Flags) then
7462 begin
7463 if (Result=mrOk) then begin
7464 if MainUnitInfo<>nil then MainUnitInfo.ClearModifieds;
7465 if MainUnitSrcEdit<>nil then MainUnitSrcEdit.Modified:=false;
7466 end;
7467 end;
7468 end;
7469 end;
7470
7471 procedure GetMainUnit(out MainUnitInfo: TUnitInfo; out MainUnitSrcEdit: TSourceEditor);
7472 begin
7473 MainUnitSrcEdit:=nil;
7474 if Project1.MainUnitID>=0 then begin
7475 MainUnitInfo:=Project1.MainUnitInfo;
7476 if MainUnitInfo.OpenEditorInfoCount > 0 then begin
7477 MainUnitSrcEdit := TSourceEditor(MainUnitInfo.OpenEditorInfo[0].EditorComponent);
7478 if MainUnitSrcEdit.Modified then
7479 MainUnitSrcEdit.UpdateCodeBuffer;
7480 end;
7481 end else
7482 MainUnitInfo:=nil;
7483 end;
7484
7485 procedure SaveSrcEditorProjectSpecificSettings(AnEditorInfo: TUnitEditorInfo);
7486 var
7487 ASrcEdit: TSourceEditor;
7488 begin
7489 ASrcEdit := TSourceEditor(AnEditorInfo.EditorComponent);
7490 if ASrcEdit=nil then exit;
7491 AnEditorInfo.TopLine:=ASrcEdit.EditorComponent.TopLine;
7492 AnEditorInfo.CursorPos:=ASrcEdit.EditorComponent.CaretXY;
7493 AnEditorInfo.FoldState := ASrcEdit.EditorComponent.FoldState;
7494 end;
7495
7496 procedure SaveSourceEditorProjectSpecificSettings;
7497 var
7498 i: Integer;
7499 begin
7500 for i := 0 to Project1.AllEditorsInfoCount - 1 do
7501 SaveSrcEditorProjectSpecificSettings(Project1.AllEditorsInfo[i]);
7502 end;
7503
7504 procedure UpdateProjectResourceInfo;
7505 var
7506 AnUnitInfo: TUnitInfo;
7507 LFMFilename: String;
7508 begin
7509 AnUnitInfo:=Project1.FirstPartOfProject;
7510 while AnUnitInfo<>nil do begin
7511 if (not AnUnitInfo.HasResources)
7512 and (not AnUnitInfo.IsVirtual) and FilenameHasPascalExt(AnUnitInfo.Filename)
7513 then begin
7514 LFMFilename:=ChangeFileExt(AnUnitInfo.Filename,'.lfm');
7515 if not FileExistsCached(LFMFilename) then
7516 LFMFilename:=ChangeFileExt(AnUnitInfo.Filename,'.dfm');
7517 AnUnitInfo.HasResources:=FileExistsCached(LFMFilename);
7518 end;
7519 AnUnitInfo:=AnUnitInfo.NextPartOfProject;
7520 end;
7521 end;
7522
7523 function ShowSaveProjectAsDialog(UseMainSourceFile: boolean): TModalResult;
7524 var
7525 MainUnitSrcEdit: TSourceEditor;
7526 MainUnitInfo: TUnitInfo;
7527 SaveDialog: TSaveDialog;
7528 NewBuf, OldBuf: TCodeBuffer;
7529 TitleWasDefault: Boolean;
7530 NewLPIFilename, NewProgramFN, NewProgramName, AFilename: String;
7531 AText, ACaption, Ext: string;
7532 OldSourceCode, OldProjectDir, prDir: string;
7533 begin
7534 Project1.BeginUpdate(false);
7535 try
7536 OldProjectDir:=Project1.Directory;
7537
7538 if Project1.MainUnitInfo = nil then
7539 UseMainSourceFile := False;
7540
7541 SaveDialog:=IDESaveDialogClass.Create(nil);
7542 try
7543 InputHistories.ApplyFileDialogSettings(SaveDialog);
7544 AFilename:='';
7545 // build a nice project info filename suggestion
7546 if UseMainSourceFile and (Project1.MainUnitID>=0) then
7547 AFilename:=Project1.MainUnitInfo.Unit_Name;
7548 if AFilename='' then
7549 AFilename:=ExtractFileName(Project1.ProjectInfoFile);
7550 if AFilename='' then
7551 AFilename:=ExtractFileName(Project1.MainFilename);
7552 if AFilename='' then
7553 AFilename:=Trim(Project1.GetTitle);
7554 if AFilename='' then
7555 AFilename:='project1';
7556 Ext := ExtractFileExt(AFilename);
7557 if UseMainSourceFile then
7558 begin
7559 if (Ext = '') or (not FilenameIsPascalSource(AFilename)) then
7560 AFilename := ChangeFileExt(AFilename, '.pas');
7561 end else
7562 begin
7563 if (Ext = '') or FilenameIsPascalSource(AFilename) then
7564 AFilename := ChangeFileExt(AFilename, '.lpi');
7565 end;
7566 Ext := ExtractFileExt(AFilename);
7567 SaveDialog.Title := Format(lisSaveProject, [Project1.GetTitleOrName, Ext]);
7568 SaveDialog.FileName := AFilename;
7569 // Note: add *.* filter, so users can see the files in the target directory
7570 SaveDialog.Filter := '*' + Ext + '|' + '*' + Ext
7571 + '|' + dlgFilterAll + ' (' + GetAllFilesMask + ')|' + GetAllFilesMask;
7572 SaveDialog.DefaultExt := Ext;
7573 if not Project1.IsVirtual then
7574 SaveDialog.InitialDir := Project1.Directory;
7575
7576 repeat
7577 Result:=mrCancel;
7578 NewLPIFilename:=''; // the project info file name
7579 NewProgramName:=''; // the pascal program identifier
7580 NewProgramFN:=''; // the program source filename
7581
7582 if not SaveDialog.Execute then
7583 exit; // user cancels
7584 AFilename:=ExpandFileNameUTF8(SaveDialog.FileName);
7585 Assert(FilenameIsAbsolute(AFilename),'ShowSaveProjectAsDialog: buggy ExpandFileNameUTF8');
7586
7587 // check program name
7588 NewProgramName:=ExtractFileNameOnly(AFilename);
7589 if (NewProgramName='') or (not IsValidUnitName(NewProgramName)) then begin
7590 Result:=IDEMessageDialog(lisInvalidProjectFilename,
7591 Format(lisisAnInvalidProjectNamePleaseChooseAnotherEGProject,[SaveDialog.Filename,LineEnding]),
7592 mtInformation,[mbRetry,mbAbort]);
7593 if Result=mrAbort then exit;
7594 continue; // try again
7595 end;
7596
7597 // append default extension
7598 if UseMainSourceFile then
7599 NewLPIFilename:=ChangeFileExt(AFilename,'.lpi')
7600 else
7601 begin
7602 NewLPIFilename:=AFilename;
7603 if ExtractFileExt(NewLPIFilename)='' then
7604 NewLPIFilename:=NewLPIFilename+'.lpi';
7605 end;
7606
7607 // apply naming conventions
7608 // rename to lowercase is not needed for main source
7609
7610 if Project1.MainUnitID >= 0 then
7611 begin
7612 // check mainunit filename
7613 Ext := ExtractFileExt(Project1.MainUnitInfo.Filename);
7614 if Ext = '' then Ext := '.pas';
7615 if UseMainSourceFile then
7616 NewProgramFN := ExtractFileName(AFilename)
7617 else
7618 NewProgramFN := NewProgramName + Ext;
7619 NewProgramFN := ExtractFilePath(NewLPIFilename) + NewProgramFN;
7620 if (CompareFilenames(NewLPIFilename, NewProgramFN) = 0) then
7621 begin
7622 ACaption:=lisChooseADifferentName;
7623 AText:=Format(lisTheProjectInfoFileIsEqualToTheProjectMainSource,[NewLPIFilename,LineEnding]);
7624 Result:=IDEMessageDialog(ACaption, AText, mtError, [mbAbort,mbRetry]);
7625 if Result=mrAbort then exit;
7626 continue; // try again
7627 end;
7628 // check program name
7629 if (Project1.IndexOfUnitWithName(NewProgramName,true,
7630 Project1.MainUnitInfo)>=0) then
7631 begin
7632 ACaption:=lisUnitIdentifierExists;
7633 AText:=Format(lisThereIsAUnitWithTheNameInTheProjectPleaseChoose,[NewProgramName,LineEnding]);
7634 Result:=IDEMessageDialog(ACaption,AText,mtError,[mbRetry,mbAbort]);
7635 if Result=mrAbort then exit;
7636 continue; // try again
7637 end;
7638 Result:=mrOk;
7639 end else begin
7640 NewProgramFN:='';
7641 Result:=mrOk;
7642 end;
7643 until Result<>mrRetry;
7644 finally
7645 InputHistories.StoreFileDialogSettings(SaveDialog);
7646 SaveDialog.Free;
7647 end;
7648
7649 //DebugLn(['ShowSaveProjectAsDialog NewLPI=',NewLPIFilename,' NewProgramName=',NewProgramName,' NewMainSource=',NewProgramFN]);
7650
7651 // check if info file or source file already exists
7652 // Note: if user confirms overwriting .lpi do not ask for overwriting .lpr
7653 if FileExistsUTF8(NewLPIFilename) then
7654 begin
7655 if IDESaveDialogClass.NeedOverwritePrompt then
7656 begin
7657 ACaption:=lisOverwriteFile;
7658 AText:=Format(lisAFileAlreadyExistsReplaceIt, [NewLPIFilename, LineEnding]);
7659 Result:=IDEMessageDialog(ACaption, AText, mtConfirmation, [mbOk, mbCancel]);
7660 if Result=mrCancel then exit;
7661 end;
7662 end
7663 else begin
7664 if FileExistsUTF8(NewProgramFN) then
7665 begin
7666 ACaption:=lisOverwriteFile;
7667 AText:=Format(lisAFileAlreadyExistsReplaceIt, [NewProgramFN, LineEnding]);
7668 Result:=IDEMessageDialog(ACaption, AText, mtConfirmation,[mbOk,mbCancel]);
7669 if Result=mrCancel then exit;
7670 end;
7671 end;
7672
7673 TitleWasDefault := Project1.TitleIsDefault(true);
7674 UpdateTargetFilename(NewProgramFN); // set new project target filename
7675
7676 // set new project filename
7677 Project1.ProjectInfoFile:=NewLPIFilename;
7678 EnvironmentOptions.AddToRecentProjectFiles(NewLPIFilename);
7679 MainIDE.SetRecentProjectFilesMenu;
7680
7681 // change main source
7682 if (Project1.MainUnitID >= 0) then
7683 begin
7684 GetMainUnit(MainUnitInfo, MainUnitSrcEdit);
7685 if not Project1.ProjResources.RenameDirectives(MainUnitInfo.Filename,NewProgramFN)
7686 then begin
7687 DebugLn(['ShowSaveProjectAsDialog failed renaming directives Old="',MainUnitInfo.Filename,'" New="',NewProgramFN,'"']);
7688 // silently ignore
7689 end;
7690
7691 // Save old source code, to prevent overwriting it,
7692 // if the file name didn't actually change.
7693 OldBuf := MainUnitInfo.Source;
7694 OldSourceCode := OldBuf.Source;
7695
7696 // switch MainUnitInfo.Source to new code
7697 NewBuf := CodeToolBoss.CreateFile(NewProgramFN);
7698 if NewBuf=nil then begin
7699 Result:=IDEMessageDialog(lisErrorCreatingFile,
7700 Format(lisUnableToCreateFile3, [LineEnding, NewProgramFN]),
7701 mtError, [mbCancel]);
7702 exit;
7703 end;
7704
7705 // copy the source to the new buffer
7706 NewBuf.Source:=OldSourceCode;
7707 if (OldBuf.DiskEncoding<>'') and (OldBuf.DiskEncoding<>EncodingUTF8) then
7708 begin
7709 NewBuf.DiskEncoding:=OldBuf.DiskEncoding;
7710 InputHistories.FileEncodings[NewProgramFN]:=NewBuf.DiskEncoding;
7711 end else
7712 InputHistories.FileEncodings[NewProgramFN]:='';
7713
7714 // assign the new buffer to the MainUnit
7715 MainUnitInfo.Source:=NewBuf;
7716 if MainUnitSrcEdit<>nil then
7717 MainUnitSrcEdit.CodeBuffer:=NewBuf;
7718
7719 // change program name
7720 MainUnitInfo.Unit_Name:=NewProgramName;
7721 MainUnitInfo.Modified:=true;
7722
7723 // update source notebook page names
7724 UpdateSourceNames;
7725 end;
7726
7727 // update paths
7728 prDir := Project1.Directory;
7729 with Project1.CompilerOptions do begin
7730 OtherUnitFiles:=RebaseSearchPath(OtherUnitFiles,OldProjectDir,prDir,true);
7731 IncludePath :=RebaseSearchPath(IncludePath,OldProjectDir,prDir,true);
7732 Libraries :=RebaseSearchPath(Libraries,OldProjectDir,prDir,true);
7733 ObjectPath :=RebaseSearchPath(ObjectPath,OldProjectDir,prDir,true);
7734 SrcPath :=RebaseSearchPath(SrcPath,OldProjectDir,prDir,true);
7735 DebugPath :=RebaseSearchPath(DebugPath,OldProjectDir,prDir,true);
7736 end;
7737 // change title
7738 if TitleWasDefault then begin
7739 Project1.Title:=Project1.GetDefaultTitle;
7740 // title does not need to be removed from source, because it was default
7741 end;
7742
7743 // invalidate cached substituted macros
7744 IncreaseCompilerParseStamp;
7745 finally
7746 Project1.EndUpdate;
7747 end;
7748 Result:=mrOk;
7749 //DebugLn(['ShowSaveProjectAsDialog END OK']);
7750 end;
7751
7752 function AskSaveProject(const ContinueText, ContinueBtn: string): TModalResult;
7753 var
7754 DataModified: Boolean;
7755 SrcModified: Boolean;
7756 begin
7757 if Project1=nil then exit(mrOk);
7758 if not SomethingOfProjectIsModified then exit(mrOk);
7759
7760 DataModified:=Project1.SomeDataModified(false) or Project1.HasProjectInfoFileChangedOnDisk;
7761 SrcModified:=SourceEditorManager.SomethingModified(false);
7762
7763 if Project1.IsVirtual
7764 and (not DataModified)
7765 and (not SrcModified) then begin
7766 // only session changed of a new project => ignore
7767 exit(mrOk)
7768 end;
7769
7770 if (Project1.SessionStorage=pssInProjectInfo)
7771 or DataModified
7772 then begin
7773 // lpi file will change => ask
7774 Result:=IDEQuestionDialog(lisProjectChanged,
7775 Format(lisSaveChangesToProject, [Project1.GetTitleOrName]),
7776 mtConfirmation, [mrYes,
7777 mrNoToAll, rsmbNo,
7778 mrCancel], '');
7779 if Result=mrNoToAll then exit(mrOk);
7780 if Result<>mrYes then exit(mrCancel);
7781 end
7782 else if SrcModified then
7783 begin
7784 // some non project files were changes in the source editor
7785 Result:=IDEQuestionDialog(lisSaveChangedFiles,lisSaveChangedFiles,
7786 mtConfirmation, [mrYes,
7787 mrNoToAll, rsmbNo,
7788 mrCancel], '');
7789 if Result=mrNoToAll then exit(mrOk);
7790 if Result<>mrYes then exit(mrCancel);
7791 end
7792 else begin
7793 // only session data changed
7794 if Project1.SessionStorage=pssNone then
7795 // session is not saved => skip
7796 exit(mrOk)
7797 else if not SomethingOfProjectIsModified then
7798 // no change
7799 exit(mrOk)
7800 else begin
7801 // session is saved separately
7802 if EnvironmentOptions.AskSaveSessionOnly then begin
7803 Result:=IDEQuestionDialog(lisProjectSessionChanged,
7804 Format(lisSaveSessionChangesToProject, [Project1.GetTitleOrName]),
7805 mtConfirmation, [mrYes,
7806 mrNoToAll, rsmbNo,
7807 mrCancel], '');
7808 if Result=mrNoToAll then exit(mrOk);
7809 if Result<>mrYes then exit(mrCancel);
7810 end;
7811 end;
7812 end;
7813 Result:=SaveProject([sfCanAbort]);
7814 if Result=mrAbort then exit;
7815 if Result<>mrOk then begin
7816 Result:=IDEQuestionDialog(lisChangesWereNotSaved, ContinueText,
7817 mtConfirmation, [mrOk, ContinueBtn, mrAbort]);
7818 if Result<>mrOk then exit(mrCancel);
7819 end;
7820 end;
7821
7822 function SaveEditorChangesToCodeCache(AEditor: TSourceEditorInterface): boolean;
7823 // save all open sources to code tools cache
7824
7825 procedure SaveChanges(SaveEditor: TSourceEditorInterface);
7826 var
7827 AnUnitInfo: TUnitInfo;
7828 begin
7829 AnUnitInfo := Project1.UnitWithEditorComponent(SaveEditor);
7830 if (AnUnitInfo<>nil) then
7831 begin
7832 //debugln(['SaveChanges ',AnUnitInfo.Filename,' ',SaveEditor.NeedsUpdateCodeBuffer]);
7833 if SaveEditor.NeedsUpdateCodeBuffer then
7834 begin
7835 SaveEditorChangesToCodeCache:=true;
7836 SaveEditor.UpdateCodeBuffer;
7837 //debugln(['SaveEditorChangesToCodeCache.SaveChanges ',AnUnitInfo.Filename,' Step=',TCodeBuffer(SaveEditor.CodeToolsBuffer).ChangeStep]);
7838 end;
7839 end;
7840 end;
7841
7842 var
7843 i: integer;
7844 begin
7845 Result:=false;
7846 //debugln(['SaveEditorChangesToCodeCache ']);
7847 if AEditor = nil then begin
7848 for i:=0 to SourceEditorManager.SourceEditorCount - 1 do
7849 SaveChanges(SourceEditorManager.SourceEditors[i]);
7850 end else begin
7851 SaveChanges(AEditor);
7852 end;
7853 end;
7854
7855 function ReplaceUnitUse(OldFilename, OldUnitName, NewFilename, NewUnitName: string;
7856 IgnoreErrors, Quiet, Confirm: boolean): TModalResult;
7857 // Replaces all references to a unit
7858 var
7859 OwnerList: TFPList;
7860 ExtraFiles: TStrings;
7861 Files: TStringList;
7862 OldCode: TCodeBuffer;
7863 OldCodeCreated: Boolean;
7864 PascalReferences: TAVLTree;
7865 i: Integer;
7866 MsgResult: TModalResult;
7867 OnlyEditorFiles: Boolean;
7868 aFilename: String;
7869 begin
7870 // compare unitnames case sensitive, maybe only the case changed
7871 if (CompareFilenames(OldFilename,NewFilename)=0) and (OldUnitName=NewUnitName) then
7872 exit(mrOk);
7873 // this was a new file, files on disk can not refer to it
7874 OnlyEditorFiles:=not FilenameIsAbsolute(OldFilename);
7875
7876 OwnerList:=nil;
7877 OldCode:=nil;
7878 OldCodeCreated:=false;
7879 PascalReferences:=nil;
7880 Files:=TStringList.Create;
7881 try
7882 if OnlyEditorFiles then begin
7883 // search only in open files
7884 for i:=0 to SourceEditorManagerIntf.UniqueSourceEditorCount-1 do begin
7885 aFilename:=SourceEditorManagerIntf.UniqueSourceEditors[i].FileName;
7886 if not FilenameIsPascalSource(aFilename) then continue;
7887 Files.Add(aFileName);
7888 end;
7889 // add project's main source file
7890 if (Project1<>nil) and (Project1.MainUnitID>=0) then
7891 Files.Add(Project1.MainFilename);
7892 end else begin
7893 // get owners of unit
7894 OwnerList:=PkgBoss.GetOwnersOfUnit(NewFilename);
7895 if OwnerList=nil then exit(mrOk);
7896 PkgBoss.ExtendOwnerListWithUsedByOwners(OwnerList);
7897 ReverseList(OwnerList);
7898
7899 // get source files of packages and projects
7900 ExtraFiles:=PkgBoss.GetSourceFilesOfOwners(OwnerList);
7901 try
7902 if ExtraFiles<>nil then
7903 Files.AddStrings(ExtraFiles);
7904 finally
7905 ExtraFiles.Free;
7906 end;
7907 end;
7908 for i:=Files.Count-1 downto 0 do begin
7909 if (CompareFilenames(Files[i],OldFilename)=0)
7910 or (CompareFilenames(Files[i],NewFilename)=0) then
7911 Files.Delete(i);
7912 end;
7913 //DebugLn(['ReplaceUnitUse ',Files.Text]);
7914
7915 // commit source editor to codetools
7916 SaveEditorChangesToCodeCache(nil);
7917
7918 // load or create old unit
7919 OldCode:=CodeToolBoss.LoadFile(OldFilename,true,false);
7920 if OldCode=nil then begin
7921 // create old file in memory so that unit search can find it
7922 OldCode:=CodeToolBoss.CreateFile(OldFilename);
7923 OldCodeCreated:=true;
7924 end;
7925
7926 // search pascal source references
7927 Result:=GatherUnitReferences(Files,OldCode,false,IgnoreErrors,true,PascalReferences);
7928 if (not IgnoreErrors) and (not Quiet) and (CodeToolBoss.ErrorMessage<>'') then
7929 MainIDE.DoJumpToCodeToolBossError;
7930 if Result<>mrOk then begin
7931 debugln('ReplaceUnitUse GatherUnitReferences failed');
7932 exit;
7933 end;
7934
7935 // replace
7936 if (PascalReferences<>nil) and (PascalReferences.Count>0) then begin
7937 if Confirm then begin
7938 MsgResult:=IDEQuestionDialog(lisUpdateReferences,
7939 Format(lisTheUnitIsUsedByOtherFilesUpdateReferencesAutomatic,
7940 [OldUnitName, LineEnding]),
7941 mtConfirmation, [mrYes,mrNo,mrYesToAll,mrNoToAll],'');
7942 case MsgResult of
7943 mrYes: ;
7944 mrYesToAll: EnvironmentOptions.UnitRenameReferencesAction:=urraAlways;
7945 mrNoToAll:
7946 begin
7947 EnvironmentOptions.UnitRenameReferencesAction:=urraNever;
7948 Result:=mrOk;
7949 exit;
7950 end;
7951 else
7952 Result:=mrOk;
7953 exit;
7954 end;
7955 end;
7956 if not CodeToolBoss.RenameIdentifier(PascalReferences,OldUnitName,NewUnitName)
7957 then begin
7958 if (not IgnoreErrors) and (not Quiet) then
7959 MainIDE.DoJumpToCodeToolBossError;
7960 debugln('ReplaceUnitUse unable to commit');
7961 if not IgnoreErrors then begin
7962 Result:=mrCancel;
7963 exit;
7964 end;
7965 end;
7966 end;
7967
7968 finally
7969 if OldCodeCreated then
7970 OldCode.IsDeleted:=true;
7971 CodeToolBoss.FreeTreeOfPCodeXYPosition(PascalReferences);
7972 OwnerList.Free;
7973 Files.Free;
7974 end;
7975 //PkgBoss.GetOwnersOfUnit(NewFilename);
7976 Result:=mrOk;
7977 end;
7978
7979 function DesignerUnitIsVirtual(aLookupRoot: TComponent): Boolean;
7980 var
7981 ActiveSourceEditor: TSourceEditor;
7982 ActiveUnitInfo: TUnitInfo;
7983 begin
7984 Assert(Assigned(aLookupRoot),'DesignerUnitIsVirtual: aLookupRoot is not assigned');
7985 MainIDE.GetUnitWithPersistent(aLookupRoot, ActiveSourceEditor, ActiveUnitInfo);
7986 Result := ActiveUnitInfo.IsVirtual;
7987 end;
7988
7989 end.
7990
7991