mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-11-20 11:39:36 +01:00
ide: package editor: added menu item add new disk files
This commit is contained in:
mattias
parent
095aa3167f
commit
09068e7f4e
@ -16,7 +16,7 @@ object PackageEditorForm: TPackageEditorForm
|
||||
OnCreate = FormCreate
|
||||
OnDestroy = FormDestroy
|
||||
OnDropFiles = FormDropFiles
|
||||
LCLVersion = '2.3.0.0'
|
||||
LCLVersion = '3.99.0.0'
|
||||
object ToolBar: TToolBar
|
||||
Left = 0
|
||||
Height = 48
|
||||
@ -32,19 +32,19 @@ object PackageEditorForm: TPackageEditorForm
|
||||
object PropsGroupBox: TGroupBox
|
||||
Left = 0
|
||||
Height = 216
|
||||
Top = 216
|
||||
Top = 222
|
||||
Width = 464
|
||||
Align = alBottom
|
||||
Caption = 'PropsGroupBox'
|
||||
ClientHeight = 186
|
||||
ClientWidth = 460
|
||||
ClientHeight = 200
|
||||
ClientWidth = 462
|
||||
ParentFont = False
|
||||
TabOrder = 3
|
||||
object PropsPageControl: TPageControl
|
||||
Left = 0
|
||||
Height = 186
|
||||
Height = 200
|
||||
Top = 0
|
||||
Width = 460
|
||||
Width = 462
|
||||
ActivePage = CommonOptionsTabSheet
|
||||
Align = alClient
|
||||
ParentFont = False
|
||||
@ -59,8 +59,8 @@ object PackageEditorForm: TPackageEditorForm
|
||||
end
|
||||
object StatusBar: TStatusBar
|
||||
Left = 0
|
||||
Height = 23
|
||||
Top = 432
|
||||
Height = 17
|
||||
Top = 438
|
||||
Width = 464
|
||||
Panels = <>
|
||||
ParentFont = False
|
||||
@ -69,7 +69,7 @@ object PackageEditorForm: TPackageEditorForm
|
||||
Cursor = crVSplit
|
||||
Left = 0
|
||||
Height = 5
|
||||
Top = 211
|
||||
Top = 217
|
||||
Width = 464
|
||||
Align = alBottom
|
||||
ResizeAnchor = akBottom
|
||||
@ -207,7 +207,7 @@ object PackageEditorForm: TPackageEditorForm
|
||||
end
|
||||
object ItemsTreeView: TTreeView
|
||||
Left = 0
|
||||
Height = 134
|
||||
Height = 140
|
||||
Top = 77
|
||||
Width = 464
|
||||
Align = alClient
|
||||
@ -251,6 +251,10 @@ object PackageEditorForm: TPackageEditorForm
|
||||
Default = True
|
||||
OnClick = mnuAddDiskFileClick
|
||||
end
|
||||
object mnuAddNewDiskFiles: TMenuItem
|
||||
Caption = 'Add new disk files...'
|
||||
OnClick = mnuAddNewDiskFilesClick
|
||||
end
|
||||
object MenuItem1: TMenuItem
|
||||
Caption = '-'
|
||||
end
|
||||
|
||||
@ -40,7 +40,7 @@ uses
|
||||
// LazControls
|
||||
TreeFilterEdit,
|
||||
// Codetools
|
||||
CodeToolManager, CodeCache,
|
||||
CodeToolManager, CodeCache, DirectoryCacher, FileProcs,
|
||||
// LazUtils
|
||||
FileUtil, LazFileUtils, LazFileCache, AvgLvlTree, LazLoggerBase, LazTracer,
|
||||
// BuildIntf
|
||||
@ -65,6 +65,7 @@ var
|
||||
// General actions for the Files and Required packages root nodes.
|
||||
// Duplicates actions found under the "Add" button.
|
||||
PkgEditMenuAddDiskFile: TIDEMenuCommand;
|
||||
PkgEditMenuAddNewDiskFiles: TIDEMenuCommand;
|
||||
PkgEditMenuAddNewFile: TIDEMenuCommand;
|
||||
PkgEditMenuAddNewComp: TIDEMenuCommand;
|
||||
PkgEditMenuAddNewReqr: TIDEMenuCommand;
|
||||
@ -145,6 +146,7 @@ type
|
||||
|
||||
TPackageEditorForm = class(TBasePackageEditor,IFilesEditorInterface)
|
||||
MenuItem1: TMenuItem;
|
||||
mnuAddNewDiskFiles: TMenuItem;
|
||||
mnuAddFPMakeReq: TMenuItem;
|
||||
mnuAddDiskFile: TMenuItem;
|
||||
mnuAddNewFile: TMenuItem;
|
||||
@ -211,6 +213,7 @@ type
|
||||
procedure ItemsTreeViewKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
|
||||
procedure mnuAddDiskFileClick(Sender: TObject);
|
||||
procedure mnuAddFPMakeReqClick(Sender: TObject);
|
||||
procedure mnuAddNewDiskFilesClick(Sender: TObject);
|
||||
procedure mnuAddNewCompClick(Sender: TObject);
|
||||
procedure mnuAddNewReqrClick(Sender: TObject);
|
||||
procedure mnuAddNewFileClick(Sender: TObject);
|
||||
@ -596,8 +599,10 @@ var
|
||||
i: Integer;
|
||||
NodeData: TPENodeData;
|
||||
Item: TObject;
|
||||
YesToAll: TYesToAllList;
|
||||
begin
|
||||
BeginUpdate;
|
||||
YesToAll:=TYesToAllList.Create;
|
||||
try
|
||||
for i:=ItemsTreeView.SelectionCount-1 downto 0 do
|
||||
begin
|
||||
@ -608,7 +613,8 @@ begin
|
||||
PkgFile:=TPkgFile(Item);
|
||||
AFilename:=PkgFile.GetFullFilename;
|
||||
if TPkgFileCheck.ReAddingUnit(LazPackage, PkgFile.FileType, AFilename,
|
||||
PackageEditors.OnGetIDEFileInfo)<>mrOk then exit;
|
||||
PackageEditors.OnGetIDEFileInfo,YesToAll)<>mrOk then
|
||||
exit;
|
||||
//PkgFile.Filename:=AFilename;
|
||||
Assert(PkgFile.Filename=AFilename, 'TPackageEditorForm.ReAddMenuItemClick: Unexpected Filename.');
|
||||
LazPackage.UnremovePkgFile(PkgFile);
|
||||
@ -624,6 +630,7 @@ begin
|
||||
end;
|
||||
LazPackage.Modified:=True;
|
||||
finally
|
||||
YesToAll.Free;
|
||||
EndUpdate;
|
||||
end;
|
||||
end;
|
||||
@ -748,6 +755,8 @@ begin
|
||||
// Files root node
|
||||
SetItem(PkgEditMenuAddDiskFile, @mnuAddDiskFileClick, UserSelection=[pstFilesNode],
|
||||
Writable);
|
||||
SetItem(PkgEditMenuAddNewDiskFiles, @mnuAddNewDiskFilesClick, UserSelection=[pstFilesNode],
|
||||
Writable);
|
||||
SetItem(PkgEditMenuAddNewFile, @mnuAddNewFileClick, UserSelection=[pstFilesNode],
|
||||
Writable);
|
||||
SetItem(PkgEditMenuAddNewComp, @mnuAddNewCompClick, UserSelection=[pstFilesNode],
|
||||
@ -1001,6 +1010,118 @@ begin
|
||||
ShowAddFPMakeDepDialog
|
||||
end;
|
||||
|
||||
procedure TPackageEditorForm.mnuAddNewDiskFilesClick(Sender: TObject);
|
||||
var
|
||||
Files: TFilenameToStringTree;
|
||||
|
||||
procedure CollectFile(const aFilename: string; CheckType: TPkgFileType);
|
||||
var
|
||||
Ext: String;
|
||||
IDEFileFlags: TIDEFileStateFlags;
|
||||
begin
|
||||
if CompareFilenames(aFilename,'fpmake.pp')=0 then exit;
|
||||
if CompareFilenames(aFilename,LazPackage.GetSrcFilename)=0 then exit;
|
||||
|
||||
case CheckType of
|
||||
pftUnit:
|
||||
if not FilenameIsPascalUnit(aFilename) then exit;
|
||||
pftInclude:
|
||||
begin
|
||||
Ext:=ExtractFileExt(aFilename);
|
||||
if IsPascalIncExt(PChar(Ext))=pietNone then exit;
|
||||
end;
|
||||
end;
|
||||
if LazPackage.FindPkgFile(aFilename,true,true)<>nil then
|
||||
exit; // already in package
|
||||
if PackageGraph.FindFileInAllPackages(aFilename,true,false)<>nil then
|
||||
exit; // already in a package
|
||||
PackageEditors.OnGetIDEFileInfo(Self,aFilename,[ifsPartOfProject],IDEFileFlags);
|
||||
if ifsPartOfProject in IDEFileFlags then
|
||||
exit;
|
||||
|
||||
if Files.Contains(aFilename) then exit;
|
||||
Files.Add(aFilename,'');
|
||||
end;
|
||||
|
||||
procedure CollectFiles(const SearchPath: string; CheckType: TPkgFileType);
|
||||
var
|
||||
p, i: Integer;
|
||||
Dir: String;
|
||||
Cache: TCTDirectoryBaseCache;
|
||||
StarCache: TCTStarDirectoryCache;
|
||||
DirCache: TCTDirectoryCache;
|
||||
begin
|
||||
p:=1;
|
||||
repeat
|
||||
Dir:=GetNextDirectoryInSearchPath(SearchPath,p);
|
||||
if Dir='' then break;
|
||||
Cache:=CodeToolBoss.DirectoryCachePool.GetBaseCache(Dir);
|
||||
if Cache=nil then continue;
|
||||
if Cache is TCTStarDirectoryCache then
|
||||
begin
|
||||
StarCache:=TCTStarDirectoryCache(Cache);
|
||||
for i:=0 to StarCache.Listing.Count-1 do
|
||||
CollectFile(StarCache.Listing.GetSubDirFilename(i),CheckType);
|
||||
end else if Cache is TCTDirectoryCache then begin
|
||||
DirCache:=TCTDirectoryCache(Cache);
|
||||
for i:=0 to DirCache.Listing.Count-1 do
|
||||
CollectFile(DirCache.Directory+DirCache.Listing.GetFilename(i),CheckType);
|
||||
end;
|
||||
until false;
|
||||
end;
|
||||
|
||||
var
|
||||
aFilename, NewUnitName, Msg: String;
|
||||
Item: PStringToStringItem;
|
||||
Code: TCodeBuffer;
|
||||
NewFileType: TPkgFileType;
|
||||
NewFlags: TPkgFileFlags;
|
||||
begin
|
||||
if LazPackage.IsVirtual then exit;
|
||||
if TPkgFileCheck.ReadOnlyOk(LazPackage)<>mrOK then exit;
|
||||
|
||||
Files:=TFilenameToStringTree.Create(true);
|
||||
try
|
||||
// collect missing units from unit path
|
||||
CollectFiles(LazPackage.GetUnitPath(false),pftUnit);
|
||||
|
||||
// collect missing include files from include path
|
||||
CollectFiles(LazPackage.GetIncludePath(false),pftInclude);
|
||||
|
||||
if Files.Count=0 then
|
||||
begin
|
||||
IDEMessageDialog('No file missing','All .pas, .pp, .p, .inc in unit/include path are already in a project/package.',mtInformation,[mbOk]);
|
||||
exit;
|
||||
end;
|
||||
|
||||
Msg:='Add the following files:';
|
||||
for Item in Files do begin
|
||||
aFilename:=Item^.Name;
|
||||
Msg+=LineEnding+CreateRelativePath(aFilename,LazPackage.Directory,true,false);
|
||||
end;
|
||||
if IDEMessageDialog('Add new disk files?',Msg,mtConfirmation,[mbOk,mbCancel])<>mrOk then exit;
|
||||
|
||||
for Item in Files do begin
|
||||
aFilename:=Item^.Name;
|
||||
NewFlags:=[];
|
||||
Code:=CodeToolBoss.LoadFile(aFilename,true,false);
|
||||
NewUnitName:='';
|
||||
if FilenameIsPascalUnit(aFilename) then
|
||||
NewUnitName:=CodeToolBoss.GetSourceName(Code,false);
|
||||
if NewUnitName<>'' then
|
||||
NewFileType:=pftUnit
|
||||
else
|
||||
NewFileType:=pftInclude;
|
||||
if CodeToolBoss.HasInterfaceRegisterProc(Code) then
|
||||
Include(NewFlags,pffHasRegisterProc);
|
||||
LazPackage.AddFile(aFilename,NewUnitName,NewFileType,NewFlags,cpNormal);
|
||||
end;
|
||||
|
||||
finally
|
||||
Files.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TPackageEditorForm.mnuAddNewCompClick(Sender: TObject);
|
||||
begin
|
||||
ShowNewCompDialog;
|
||||
@ -1374,11 +1495,14 @@ procedure TPackageEditorForm.FormDropFiles(Sender: TObject;
|
||||
var
|
||||
i: Integer;
|
||||
NewFilename, NewUnitPaths, NewIncPaths: String;
|
||||
YesToAll: TYesToAllList;
|
||||
r: TModalResult;
|
||||
begin
|
||||
{$IFDEF VerbosePkgEditDrag}
|
||||
debugln(['TPackageEditorForm.FormDropFiles ',length(FileNames)]);
|
||||
{$ENDIF}
|
||||
if length(FileNames)=0 then exit;
|
||||
YesToAll:=TYesToAllList.Create;
|
||||
BeginUpdate;
|
||||
try
|
||||
NewUnitPaths:='';
|
||||
@ -1386,15 +1510,19 @@ begin
|
||||
for i:=0 to high(Filenames) do
|
||||
begin
|
||||
NewFilename:=FileNames[i];
|
||||
if TPkgFileCheck.AddingUnit(LazPackage, NewFilename,
|
||||
PackageEditors.OnGetIDEFileInfo)=mrOK then
|
||||
LazPackage.AddFileByName(NewFilename, NewUnitPaths, NewIncPaths);
|
||||
r:=TPkgFileCheck.AddingUnit(LazPackage, NewFilename,
|
||||
PackageEditors.OnGetIDEFileInfo,YesToAll);
|
||||
if r=mrOK then
|
||||
LazPackage.AddFileByName(NewFilename, NewUnitPaths, NewIncPaths)
|
||||
else if r=mrAbort then
|
||||
break;
|
||||
end;
|
||||
//UpdateAll(false);
|
||||
// extend unit and include search path
|
||||
if not LazPackage.ExtendUnitSearchPath(NewUnitPaths) then exit;
|
||||
if not LazPackage.ExtendIncSearchPath(NewIncPaths) then exit;
|
||||
finally
|
||||
YesToAll.Free;
|
||||
EndUpdate;
|
||||
end;
|
||||
end;
|
||||
@ -1464,9 +1592,12 @@ var
|
||||
OpenDialog: TOpenDialog;
|
||||
i: Integer;
|
||||
NewFilename, NewUnitPaths, NewIncPaths: String;
|
||||
r: TModalResult;
|
||||
YesToAll: TYesToAllList;
|
||||
begin
|
||||
// is readonly
|
||||
if TPkgFileCheck.ReadOnlyOk(LazPackage)<>mrOK then exit;
|
||||
YesToAll:=nil;
|
||||
OpenDialog:=TOpenDialog.Create(nil);
|
||||
try
|
||||
InputHistories.ApplyFileDialogSettings(OpenDialog);
|
||||
@ -1486,12 +1617,16 @@ begin
|
||||
InputHistories.StoreFileDialogSettings(OpenDialog);
|
||||
NewUnitPaths:='';
|
||||
NewIncPaths:='';
|
||||
YesToAll:=TYesToAllList.Create;
|
||||
for i:=0 to OpenDialog.Files.Count-1 do
|
||||
begin
|
||||
NewFilename:=OpenDialog.Files[i];
|
||||
if TPkgFileCheck.AddingUnit(LazPackage, NewFilename,
|
||||
PackageEditors.OnGetIDEFileInfo)=mrOK then
|
||||
LazPackage.AddFileByName(NewFilename, NewUnitPaths, NewIncPaths);
|
||||
r:=TPkgFileCheck.AddingUnit(LazPackage, NewFilename,
|
||||
PackageEditors.OnGetIDEFileInfo,YesToAll);
|
||||
if r=mrOK then
|
||||
LazPackage.AddFileByName(NewFilename, NewUnitPaths, NewIncPaths)
|
||||
else if r=mrAbort then
|
||||
break;
|
||||
end;
|
||||
//UpdateAll(false);
|
||||
// extend unit and include search path
|
||||
@ -1499,6 +1634,7 @@ begin
|
||||
if not LazPackage.ExtendIncSearchPath(NewIncPaths) then exit;
|
||||
end;
|
||||
finally
|
||||
YesToAll.Free;
|
||||
OpenDialog.Free;
|
||||
end;
|
||||
end;
|
||||
@ -1785,6 +1921,7 @@ begin
|
||||
MoreBitBtn.DropdownMenu := MorePopupMenu;
|
||||
|
||||
mnuAddDiskFile.Caption := lisPckEditAddFilesFromFileSystem;
|
||||
mnuAddNewDiskFiles.Caption := 'Add Missing Files from File System'; // todo resourcestring
|
||||
mnuAddNewFile.Caption := lisA2PNewFile;
|
||||
mnuAddNewComp.Caption := lisMenuNewComponent;
|
||||
mnuAddNewReqr.Caption := lisProjAddNewRequirement;
|
||||
@ -2175,7 +2312,7 @@ begin
|
||||
pftText: Result:=ImageIndexText;
|
||||
pftBinary: Result:=ImageIndexBinary;
|
||||
else
|
||||
Result:=-1;
|
||||
Result:=-1{%H-};
|
||||
end;
|
||||
end
|
||||
else if Item is TPkgDependency then
|
||||
|
||||
@ -21,6 +21,15 @@ uses
|
||||
|
||||
type
|
||||
|
||||
{ TYesToAllList }
|
||||
|
||||
TYesToAllList = class(TStringList)
|
||||
public
|
||||
function Inc(Name: string): integer;
|
||||
end;
|
||||
|
||||
{ TProjPackFileCheck }
|
||||
|
||||
TProjPackFileCheck = class
|
||||
protected
|
||||
class function UnitNameOk(const AFilename, AUnitFilename: string): TModalResult;
|
||||
@ -32,18 +41,18 @@ type
|
||||
TPkgFileCheck = class(TProjPackFileCheck)
|
||||
private
|
||||
class function NormalizeFN(LazPackage: TLazPackage; var AFilename: string): TModalResult;
|
||||
class function FileExistsOk(LazPackage: TLazPackage; const AFilename: string): TModalResult;
|
||||
class function FileExistsOk(LazPackage: TLazPackage; const AFilename: string; YesToAll: TYesToAllList): TModalResult;
|
||||
class function PartOfProjectOk(const AFilename: string;
|
||||
OnGetIDEFileInfo: TGetIDEFileStateEvent): TModalResult;
|
||||
OnGetIDEFileInfo: TGetIDEFileStateEvent; YesToAll: TYesToAllList): TModalResult;
|
||||
class function UniqueUnitOk(LazPackage: TLazPackage;
|
||||
const AUnitFilename: string): TModalResult;
|
||||
const AUnitFilename: string; YesToAll: TYesToAllList): TModalResult;
|
||||
public
|
||||
class function ReadOnlyOk(LazPackage: TLazPackage): TModalResult;
|
||||
class function AddingUnit(LazPackage: TLazPackage; const AFilename: string;
|
||||
OnGetIDEFileInfo: TGetIDEFileStateEvent): TModalResult;
|
||||
OnGetIDEFileInfo: TGetIDEFileStateEvent; YesToAll: TYesToAllList): TModalResult; // ok=success, cancel=fail, abort=fail and stop multi add
|
||||
class function ReAddingUnit(LazPackage: TLazPackage;
|
||||
FileTyp: TPkgFileType; const AFilename: string;
|
||||
OnGetIDEFileInfo: TGetIDEFileStateEvent): TModalResult;
|
||||
OnGetIDEFileInfo: TGetIDEFileStateEvent; YesToAll: TYesToAllList): TModalResult;
|
||||
class function AddingDependency(LazPackage: TLazPackage;
|
||||
NewDependency: TPkgDependency; WarnIfAlreadyThere: boolean): TModalResult;
|
||||
end;
|
||||
@ -77,6 +86,14 @@ begin
|
||||
Result := TPrjFileCheck.AddingDependency(AProjPack as TProject, ADependency) = mrOK;
|
||||
end;
|
||||
|
||||
{ TYesToAllList }
|
||||
|
||||
function TYesToAllList.Inc(Name: string): integer;
|
||||
begin
|
||||
Result:=StrToIntDef(Values[Name],0)+1;
|
||||
Values[Name]:=IntToStr(Result);
|
||||
end;
|
||||
|
||||
{ TProjPackFileCheck }
|
||||
|
||||
class function TProjPackFileCheck.UnitNameOk(const AFilename, AUnitFilename: string): TModalResult;
|
||||
@ -130,7 +147,7 @@ begin
|
||||
end;
|
||||
|
||||
class function TPkgFileCheck.FileExistsOk(LazPackage: TLazPackage;
|
||||
const AFilename: string): TModalResult;
|
||||
const AFilename: string; YesToAll: TYesToAllList): TModalResult;
|
||||
var
|
||||
PkgFile: TPkgFile;
|
||||
Msg: String;
|
||||
@ -139,6 +156,7 @@ begin
|
||||
// check if file exists
|
||||
if not FileExistsUTF8(AFilename) then
|
||||
begin
|
||||
if YesToAll.Inc('FileNotFound')<4 then
|
||||
IDEMessageDialog(lisFileNotFound, Format(lisPkgMangFileNotFound,[AFilename]),
|
||||
mtError, [mbCancel]);
|
||||
exit;
|
||||
@ -147,6 +165,7 @@ begin
|
||||
PkgFile:=LazPackage.FindPkgFile(AFilename,true,false);
|
||||
if PkgFile<>nil then
|
||||
begin
|
||||
if YesToAll.Inc('FileAlreadyInPackage')>2 then exit;
|
||||
Msg:=Format(lisA2PFileAlreadyExistsInThePackage, [AFilename]);
|
||||
if PkgFile.Filename<>AFilename then
|
||||
Msg:=Msg+LineEnding+Format(lisA2PExistingFile2, [PkgFile.Filename]);
|
||||
@ -157,7 +176,8 @@ begin
|
||||
end;
|
||||
|
||||
class function TPkgFileCheck.PartOfProjectOk(const AFilename: string;
|
||||
OnGetIDEFileInfo: TGetIDEFileStateEvent): TModalResult;
|
||||
OnGetIDEFileInfo: TGetIDEFileStateEvent; YesToAll: TYesToAllList
|
||||
): TModalResult;
|
||||
var
|
||||
IDEFileFlags: TIDEFileStateFlags;
|
||||
begin
|
||||
@ -166,6 +186,7 @@ begin
|
||||
OnGetIDEFileInfo(nil,AFilename,[ifsPartOfProject],IDEFileFlags);
|
||||
if ifsPartOfProject in IDEFileFlags then
|
||||
begin
|
||||
if YesToAll.Inc('MixingProjectAndPackage')>1 then exit;
|
||||
IDEMessageDialog(lisA2PFileIsUsed,
|
||||
Format(lisA2PTheFileIsPartOfTheCurrentProjectItIsABadIdea,[AFilename,LineEnding]),
|
||||
mtError,[mbCancel]);
|
||||
@ -175,10 +196,11 @@ begin
|
||||
end;
|
||||
|
||||
class function TPkgFileCheck.UniqueUnitOk(LazPackage: TLazPackage;
|
||||
const AUnitFilename: string): TModalResult;
|
||||
const AUnitFilename: string; YesToAll: TYesToAllList): TModalResult;
|
||||
// This is called only for Pascal units.
|
||||
var
|
||||
PkgFile: TPkgFile;
|
||||
i: Integer;
|
||||
begin
|
||||
Result:=mrCancel;
|
||||
// check if unitname already exists in package
|
||||
@ -186,30 +208,64 @@ begin
|
||||
if PkgFile<>nil then
|
||||
begin
|
||||
// a unit with this name already exists in this package => warn
|
||||
i:=YesToAll.Inc('UnitnameExistsInPkg');
|
||||
if i=1 then
|
||||
begin
|
||||
if IDEMessageDialog(lisA2PUnitnameAlreadyExists,
|
||||
Format(lisA2PTheUnitnameAlreadyExistsInThisPackage,[AUnitFilename]),
|
||||
mtError,[mbCancel,mbIgnore]) <> mrIgnore then
|
||||
exit;
|
||||
end else if i<100000 then begin
|
||||
if IDEMessageDialog(lisA2PUnitnameAlreadyExists,
|
||||
Format(lisA2PTheUnitnameAlreadyExistsInThisPackage,[AUnitFilename]),
|
||||
mtError,[mbCancel,mbYesToAll]) = mrYesToAll then
|
||||
YesToAll.Values['UnitnameExistsInPkg']:='100000'
|
||||
else
|
||||
exit;
|
||||
end;
|
||||
end
|
||||
else begin
|
||||
PkgFile:=PackageGraph.FindUnit(LazPackage,AUnitFilename,true,true);
|
||||
if (PkgFile<>nil) and (PkgFile.LazPackage<>LazPackage) then
|
||||
begin
|
||||
// there is already a unit with this name in another package => warn
|
||||
i:=YesToAll.Inc('UnitnameExistsInOtherPkg');
|
||||
if i=1 then
|
||||
begin
|
||||
if IDEMessageDialog(lisA2PUnitnameAlreadyExists,
|
||||
Format(lisA2PTheUnitnameAlreadyExistsInThePackage,
|
||||
[AUnitFilename, LineEnding, PkgFile.LazPackage.IDAsString]),
|
||||
mtWarning,[mbCancel,mbIgnore]) <> mrIgnore then
|
||||
exit;
|
||||
end else if i<100000 then begin
|
||||
if IDEMessageDialog(lisA2PUnitnameAlreadyExists,
|
||||
Format(lisA2PTheUnitnameAlreadyExistsInThePackage,
|
||||
[AUnitFilename, LineEnding, PkgFile.LazPackage.IDAsString]),
|
||||
mtWarning,[mbCancel,mbYesToAll]) = mrYesToAll then
|
||||
YesToAll.Values['UnitnameExistsInOtherPkg']:='100000'
|
||||
else
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
// check if unitname is a componentclass
|
||||
if IDEComponentPalette.FindRegComponent(AUnitFilename)<>nil then
|
||||
begin
|
||||
i:=YesToAll.Inc('UnitnameIsCompName');
|
||||
if i=1 then
|
||||
begin
|
||||
if IDEMessageDialog(lisA2PAmbiguousUnitName,
|
||||
Format(lisA2PTheUnitNameIsTheSameAsAnRegisteredComponent,[AUnitFilename,LineEnding]),
|
||||
mtWarning,[mbCancel,mbIgnore]) <> mrIgnore then
|
||||
exit;
|
||||
end else if i<100000 then begin
|
||||
if IDEMessageDialog(lisA2PAmbiguousUnitName,
|
||||
Format(lisA2PTheUnitNameIsTheSameAsAnRegisteredComponent,[AUnitFilename,LineEnding]),
|
||||
mtWarning,[mbCancel,mbYesToAll]) = mrYesToAll then
|
||||
YesToAll.Values['UnitnameIsCompName']:='100000'
|
||||
else
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
Result:=mrOK;
|
||||
end;
|
||||
@ -222,23 +278,24 @@ begin
|
||||
IDEMessageDialog(lisAF2PPackageIsReadOnly,
|
||||
Format(lisAF2PThePackageIsReadOnly, [LazPackage.IDAsString]),
|
||||
mtError,[mbCancel]);
|
||||
exit(mrCancel);
|
||||
exit(mrAbort);
|
||||
end;
|
||||
Result:=mrOK;
|
||||
end;
|
||||
|
||||
class function TPkgFileCheck.AddingUnit(LazPackage: TLazPackage;
|
||||
const AFilename: string; OnGetIDEFileInfo: TGetIDEFileStateEvent): TModalResult;
|
||||
const AFilename: string; OnGetIDEFileInfo: TGetIDEFileStateEvent;
|
||||
YesToAll: TYesToAllList): TModalResult;
|
||||
var
|
||||
NewFileType: TPkgFileType;
|
||||
UnitFilename: String;
|
||||
begin
|
||||
Assert(FilenameIsAbsolute(AFilename), 'TPkgFileCheck.AddingUnit: Not absolute Filename.');
|
||||
// file exists
|
||||
Result:=FileExistsOk(LazPackage, AFilename);
|
||||
Result:=FileExistsOk(LazPackage, AFilename, YesToAll);
|
||||
if Result<>mrOK then exit;
|
||||
// file is part of project
|
||||
Result:=PartOfProjectOk(AFilename, OnGetIDEFileInfo);
|
||||
Result:=PartOfProjectOk(AFilename, OnGetIDEFileInfo, YesToAll);
|
||||
if Result<>mrOK then exit;
|
||||
|
||||
NewFileType:=FileNameToPkgFileType(AFilename);
|
||||
@ -249,23 +306,24 @@ begin
|
||||
Result:=UnitNameOk(AFilename, UnitFilename);
|
||||
if Result<>mrOK then exit;
|
||||
// unit is unique
|
||||
Result:=UniqueUnitOk(LazPackage, UnitFilename);
|
||||
Result:=UniqueUnitOk(LazPackage, UnitFilename, YesToAll);
|
||||
if Result<>mrOK then exit;
|
||||
Result:=mrOK; // ok
|
||||
end;
|
||||
|
||||
class function TPkgFileCheck.ReAddingUnit(LazPackage: TLazPackage;
|
||||
FileTyp: TPkgFileType; const AFilename: string;
|
||||
OnGetIDEFileInfo: TGetIDEFileStateEvent): TModalResult;
|
||||
OnGetIDEFileInfo: TGetIDEFileStateEvent; YesToAll: TYesToAllList
|
||||
): TModalResult;
|
||||
var
|
||||
UnitFilename: String;
|
||||
begin
|
||||
Assert(FilenameIsAbsolute(AFilename), 'TPkgFileCheck.ReAddingUnit: Not absolute Filename.');
|
||||
// file exists
|
||||
Result:=FileExistsOk(LazPackage, AFilename);
|
||||
Result:=FileExistsOk(LazPackage, AFilename, YesToAll);
|
||||
if Result<>mrOK then exit;
|
||||
// file is part of project
|
||||
Result:=PartOfProjectOk(AFilename, OnGetIDEFileInfo);
|
||||
Result:=PartOfProjectOk(AFilename, OnGetIDEFileInfo, YesToAll);
|
||||
if Result<>mrOK then exit;
|
||||
if not (FileTyp in [pftUnit, pftMainUnit, pftVirtualUnit]) then
|
||||
exit(mrOK); // Further checks only for Pascal units.
|
||||
@ -274,7 +332,7 @@ begin
|
||||
Result:=UnitNameOk(AFilename, UnitFilename);
|
||||
if Result<>mrOK then exit;
|
||||
// unit is unique
|
||||
Result:=UniqueUnitOk(LazPackage, UnitFilename);
|
||||
Result:=UniqueUnitOk(LazPackage, UnitFilename, YesToAll);
|
||||
if Result<>mrOK then exit;
|
||||
Result:=mrOK; // ok
|
||||
end;
|
||||
|
||||
Loading…
Reference in New Issue
Block a user