paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-07 15:56:00 +02:00
Code Issues Packages Projects Releases Wiki Activity

implemented adding files from directory in project inspector, fixed extrac proc checking overlapping blocks

Browse Source 
git-svn-id: trunk@6690 -
This commit is contained in:
mattias 2005-01-26 15:45:08 +00:00
parent 8815a1a07d
commit 945205ad3c
14 changed files with 512 additions and 141 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

44
components/codetools/extractproctool.pas
View File

@ -149,6 +149,7 @@ var
CursorNode: TCodeTreeNode;
BeginBlockNode: TCodeTreeNode;
BlockCleanEnd: Integer;
BlockCleanStart: LongInt;
ANode: TCodeTreeNode;
ProcLvl: Integer;
begin
@ -163,6 +164,7 @@ begin
if CaretToCleanPos(EndPos,CleanEndPos)<>0 then exit;
if CleanStartPos>=CleanEndPos then exit;
{$IFDEF CTDebug}
debugln('TExtractProcTool.CheckExtractProc Selection="',copy(Src,CleanStartPos,CleanEndPos-CleanStartPos),'"');
DebugLn('TExtractProcTool.CheckExtractProc node check ..');
{$ENDIF}
// check if in a Begin..End block
@ -178,24 +180,52 @@ begin
// check every block in selection
while true do begin
ReadNextAtom;
if (CurPos.StartPos>SrcLen) or (CurPos.StartPos>CursorNode.EndPos)
or (CurPos.StartPos>CleanStartPos) then
if (CurPos.EndPos>CleanEndPos) or (CurPos.StartPos>SrcLen)
or (CurPos.StartPos>CursorNode.EndPos) then
break;
if WordIsLogicalBlockStart.DoItUpperCase(UpperSrc,
//debugln('TExtractProcTool.CheckExtractProc A "',GetAtom,'"');
if WordIsBlockStatementStart.DoItUpperCase(UpperSrc,
CurPos.StartPos,CurPos.EndPos-CurPos.StartPos)
then begin
if not ReadTilBlockEnd(true,false) then exit;
//debugln('TExtractProcTool.CheckExtractProc WordIsBlockStatementStart "',GetAtom,'"');
BlockCleanStart:=CurPos.StartPos;
if not ReadTilBlockStatementEnd(true) then exit;
BlockCleanEnd:=CurPos.EndPos;
if BlockCleanEnd<CleanEndPos then exit;
debugln(copy(Src,BlockCleanStart,BlockCleanEnd-BlockCleanStart));
//debugln('TExtractProcTool.CheckExtractProc BlockEnd "',GetAtom,'" BlockCleanEnd=',dbgs(BlockCleanEnd),' CleanEndPos=',dbgs(CleanEndPos),' Result=',dbgs(Result),' BlockStartedInside=',dbgs(BlockCleanStart>=CleanStartPos));
if BlockCleanStart<CleanStartPos then begin
// this block started outside the selection
// -> it should end outside
if (BlockCleanEnd>=CleanStartPos) and (BlockCleanEnd<CleanEndPos) then
begin
// block overlaps selection
exit;
end;
if BlockCleanEnd>=CleanEndPos then begin
// set cursor back to block start
MoveCursorToCleanPos(BlockCleanStart);
ReadNextAtom;
end;
end else begin
// this block started inside the selection
// -> it should end inside
if (BlockCleanEnd>CleanEndPos) then begin
// block overlaps selection
exit;
end;
end;
//debugln('TExtractProcTool.CheckExtractProc Block ok');
end
else if WordIsLogicalBlockEnd.DoItUpperCase(UpperSrc,
else if WordIsBlockStatementEnd.DoItUpperCase(UpperSrc,
CurPos.StartPos,CurPos.EndPos-CurPos.StartPos)
then begin
// a block ended inside, that started outside
exit;
end
else if WordIsLogicalBlockMiddle.DoItUpperCase(UpperSrc,
else if WordIsBlockStatementMiddle.DoItUpperCase(UpperSrc,
CurPos.StartPos,CurPos.EndPos-CurPos.StartPos)
then begin
// a block ended inside, that started outside
exit;
end;
end;

37
components/codetools/keywordfunclists.pas
View File

@ -110,6 +110,9 @@ var
WordIsLogicalBlockStart,
WordIsLogicalBlockEnd,
WordIsLogicalBlockMiddle,
WordIsBlockStatementStart,
WordIsBlockStatementEnd,
WordIsBlockStatementMiddle,
WordIsBinaryOperator,
WordIsLvl1Operator, WordIsLvl2Operator, WordIsLvl3Operator, WordIsLvl4Operator,
WordIsBooleanOperator,
@ -1071,6 +1074,9 @@ begin
Add('}',{$ifdef FPC}@{$endif}AllwaysTrue);
Add('END',{$ifdef FPC}@{$endif}AllwaysTrue);
Add('UNTIL',{$ifdef FPC}@{$endif}AllwaysTrue);
Add('IMPLEMENTATION',{$ifdef FPC}@{$endif}AllwaysTrue);
Add('INITIALIZATION',{$ifdef FPC}@{$endif}AllwaysTrue);
Add('FINALIZATION',{$ifdef FPC}@{$endif}AllwaysTrue);
end;
WordIsLogicalBlockMiddle:=TKeyWordFunctionList.Create;
@ -1080,6 +1086,37 @@ begin
Add('EXCEPT',{$ifdef FPC}@{$endif}AllwaysTrue);
end;
WordIsBlockStatementStart:=TKeyWordFunctionList.Create;
KeyWordLists.Add(WordIsBlockStatementStart);
with WordIsBlockStatementStart do begin
Add('(',{$ifdef FPC}@{$endif}AllwaysTrue);
Add('[',{$ifdef FPC}@{$endif}AllwaysTrue);
Add('{',{$ifdef FPC}@{$endif}AllwaysTrue);
Add('ASM',{$ifdef FPC}@{$endif}AllwaysTrue);
Add('BEGIN',{$ifdef FPC}@{$endif}AllwaysTrue);
Add('CASE',{$ifdef FPC}@{$endif}AllwaysTrue);
Add('REPEAT',{$ifdef FPC}@{$endif}AllwaysTrue);
Add('TRY',{$ifdef FPC}@{$endif}AllwaysTrue);
Add('UNIT',{$ifdef FPC}@{$endif}AllwaysTrue);
end;
WordIsBlockStatementEnd:=TKeyWordFunctionList.Create;
KeyWordLists.Add(WordIsBlockStatementEnd);
with WordIsBlockStatementEnd do begin
Add(')',{$ifdef FPC}@{$endif}AllwaysTrue);
Add(']',{$ifdef FPC}@{$endif}AllwaysTrue);
Add('}',{$ifdef FPC}@{$endif}AllwaysTrue);
Add('END',{$ifdef FPC}@{$endif}AllwaysTrue);
Add('UNTIL',{$ifdef FPC}@{$endif}AllwaysTrue);
end;
WordIsBlockStatementMiddle:=TKeyWordFunctionList.Create;
KeyWordLists.Add(WordIsBlockStatementMiddle);
with WordIsBlockStatementMiddle do begin
Add('FINALLY',{$ifdef FPC}@{$endif}AllwaysTrue);
Add('EXCEPT',{$ifdef FPC}@{$endif}AllwaysTrue);
end;
WordIsBinaryOperator:=TKeyWordFunctionList.Create;
KeyWordLists.Add(WordIsBinaryOperator);
with WordIsBinaryOperator do begin

14
components/codetools/pascalparsertool.pas
View File

@ -184,6 +184,7 @@ type
function ReadSubRange(ExceptionOnError: boolean): boolean;
function ReadTilBlockEnd(StopOnBlockMiddlePart,
CreateNodes: boolean): boolean;
function ReadTilBlockStatementEnd(ExceptionOnNotFound: boolean): boolean;
function ReadBackTilBlockEnd(StopOnBlockMiddlePart: boolean): boolean;
function ReadTilVariableEnd(ExceptionOnError: boolean): boolean;
function ReadTilStatementEnd(ExceptionOnError,
@ -1947,6 +1948,19 @@ begin
until false;
end;
function TPascalParserTool.ReadTilBlockStatementEnd(
ExceptionOnNotFound: boolean): boolean;
begin
if CurPos.Flag in [cafRoundBracketOpen,cafEdgedBracketOpen] then
Result:=ReadTilBracketClose(ExceptionOnNotFound)
else if WordIsBlockStatementStart.DoItUpperCase(UpperSrc,
CurPos.StartPos,CurPos.EndPos-CurPos.StartPos)
then
Result:=ReadTilBlockEnd(false,false)
else
Result:=false;
end;
function TPascalParserTool.ReadBackTilBlockEnd(
StopOnBlockMiddlePart: boolean): boolean;
// read begin..end, try..finally, case..end, repeat..until, asm..end blocks

4
components/codetools/stdcodetools.pas
View File

@ -3448,7 +3448,7 @@ begin
// jump backward to matching bracket
if not ReadBackwardTilAnyBracketClose then exit;
end
else if WordIsLogicalBlockStart.DoItUpperCase(UpperSrc,
else if WordIsBlockStatementStart.DoItUpperCase(UpperSrc,
CurPos.StartPos,CurPos.EndPos-CurPos.StartPos) then
begin
// block start found
@ -3545,7 +3545,7 @@ begin
// jump backward to matching bracket
if not ReadBackwardTilAnyBracketClose then exit;
end
else if WordIsLogicalBlockStart.DoItUpperCase(UpperSrc,
else if WordIsBlockStatementStart.DoItUpperCase(UpperSrc,
CurPos.StartPos,CurPos.EndPos-CurPos.StartPos) then
begin
// block start found

386
ide/addtoprojectdlg.pas
View File

@ -39,7 +39,7 @@ uses
ComCtrls, StdCtrls, ExtCtrls, Menus, Dialogs, Graphics, FileUtil,
{$IFNDEF VER1_0}AVL_Tree{$ELSE}OldAvLTree{$ENDIF},
LazarusIDEStrConsts, IDEProcs, IDEOptionDefs, EnvironmentOpts,
Project, PackageDefs, PackageSystem;
Project, PackageDefs, PackageSystem, InputHistory;
type
TAddToProjectType = (
@ -51,15 +51,18 @@ type
public
AddType: TAddToProjectType;
Dependency: TPkgDependency;
Files: TList; // list of TUnitInfo
FileNames: TStrings;
destructor Destroy; override;
end;
{ TAddToProjectDialog }
TAddToProjectDialog = class(TForm)
// notebook
NoteBook: TNoteBook;
AddFilePage: TPage;
AddEditorFilePage: TPage;
NewDependPage: TPage;
AddFilesPage: TPage;
// add file page
AddFileLabel: TLabel;
AddFileListBox: TListBox;
@ -74,14 +77,29 @@ type
DependMaxVersionEdit: TEdit;
NewDependButton: TButton;
CancelDependButton: TButton;
// add files page
FilesListView: TListView;
FilesBrowseButton: TButton;
FilesShortenButton: TButton;
FilesDeleteButton: TButton;
FilesAddButton: TButton;
procedure AddFileButtonClick(Sender: TObject);
procedure AddFilePageResize(Sender: TObject);
procedure AddToProjectDialogClose(Sender: TObject;
var CloseAction: TCloseAction);
procedure NewDependButtonClick(Sender: TObject);
procedure NewDependPageResize(Sender: TObject);
procedure FilesAddButtonClick(Sender: TObject);
procedure FilesBrowseButtonClick(Sender: TObject);
procedure FilesDeleteButtonClick(Sender: TObject);
procedure FilesShortenButtonClick(Sender: TObject);
private
fPackages: TAVLTree;// tree of TLazPackage or TPackageLink
function CheckAddingFile(NewFiles: TStringList; var NewFilename: string
): TModalResult;
procedure SetupAddEditorFilePage;
procedure SetupAddRequirementPage;
procedure SetupAddFilesPage;
procedure SetupComponents;
procedure OnIteratePackages(APackageID: TLazPackageID);
public
@ -253,66 +271,25 @@ procedure TAddToProjectDialog.AddFileButtonClick(Sender: TObject);
var
i: Integer;
NewFilename: string;
NewUnitName: String;
NewFiles: TList;
NewFile: TUnitInfo;
j: Integer;
OtherFile: TUnitInfo;
OtherUnitName: String;
ConflictFile: TUnitInfo;
NewFiles: TStringList;
begin
try
NewFiles:=TList.Create;
NewFiles:=TStringList.Create;
for i:=0 to AddFileListBox.Items.Count-1 do begin
if not AddFileListBox.Selected[i] then continue;
NewFilename:=AddFileListBox.Items[i];
// expand filename
if not FilenameIsAbsolute(NewFilename) then
NewFilename:=
TrimFilename(TheProject.ProjectDirectory+PathDelim+NewFilename);
NewFile:=TheProject.UnitInfoWithFilename(NewFilename);
if NewFile=nil then continue;
// check unit name
if FilenameIsPascalUnit(NewFilename) then begin
// check unitname is valid pascal identifier
NewUnitName:=ExtractFileNameOnly(NewFilename);
if (NewUnitName='') or not (IsValidIdent(NewUnitName)) then begin
MessageDlg(lisProjAddInvalidPascalUnitName,
Format(lisProjAddTheUnitNameIsNotAValidPascalIdentifier, ['"',
NewUnitName, '"']),
mtWarning,[mbIgnore,mbCancel],0);
exit;
end;
// check if unitname already exists in project
ConflictFile:=TheProject.UnitWithUnitname(NewUnitName);
if ConflictFile<>nil then begin
MessageDlg(lisProjAddUnitNameAlreadyExists,
Format(lisProjAddTheUnitNameAlreadyExistsInTheProject, ['"',
NewUnitName, '"', #13, '"', ConflictFile.Filename, '"']),
mtWarning,[mbCancel],0);
exit;
end;
// check if unitname already exists in selection
for j:=0 to NewFiles.Count-1 do begin
OtherFile:=TUnitInfo(NewFiles[j]);
if FilenameIsPascalUnit(OtherFile.Filename) then begin
OtherUnitName:=ExtractFileNameOnly(OtherFile.Filename);
if AnsiCompareText(OtherUnitName,NewUnitName)=0 then begin
MessageDlg(lisProjAddUnitNameAlreadyExists,
Format(lisProjAddTheUnitNameAlreadyExistsInTheSelection, ['"',
NewUnitName, '"', #13, '"', OtherFile.Filename, '"']),
mtWarning,[mbCancel],0);
exit;
end;
end;
end;
case CheckAddingFile(NewFiles, NewFilename) of
mrOk: ;
mrIgnore: continue;
else
exit;
end;
NewFiles.Add(NewFile);
NewFiles.Add(NewFilename);
end;
// everything ok
AddResult:=TAddToProjectResult.Create;
AddResult.AddType:=a2pFiles;
AddResult.Files:=NewFiles;
AddResult.FileNames:=NewFiles;
NewFiles:=nil;
finally
NewFiles.Free;
@ -357,56 +334,130 @@ begin
SetBounds(x+NewDependButton.Width+10,y,80,Height);
end;
procedure TAddToProjectDialog.FilesAddButtonClick(Sender: TObject);
var
i: Integer;
NewFilename: string;
NewFiles: TStringList;
begin
try
NewFiles:=TStringList.Create;
for i:=0 to FilesListView.Items.Count-1 do begin
NewFilename:=FilesListView.Items[i].Caption;
case CheckAddingFile(NewFiles, NewFilename) of
mrOk: ;
mrIgnore: continue;
else
exit;
end;
NewFiles.Add(NewFilename);
end;
// everything ok
AddResult:=TAddToProjectResult.Create;
AddResult.AddType:=a2pFiles;
AddResult.FileNames:=NewFiles;
NewFiles:=nil;
finally
NewFiles.Free;
end;
ModalResult:=mrOk;
end;
procedure TAddToProjectDialog.FilesBrowseButtonClick(Sender: TObject);
var
OpenDialog: TOpenDialog;
AFilename: string;
i: Integer;
NewListItem: TListItem;
NewPgkFileType: TPkgFileType;
ADirectory: String;
begin
OpenDialog:=TOpenDialog.Create(nil);
try
InputHistories.ApplyFileDialogSettings(OpenDialog);
ADirectory:=TheProject.ProjectDirectory;
if not FilenameIsAbsolute(ADirectory) then ADirectory:='';
if ADirectory<>'' then
OpenDialog.InitialDir:=ADirectory;
OpenDialog.Title:=lisOpenFile;
OpenDialog.Options:=OpenDialog.Options
+[ofFileMustExist,ofPathMustExist,ofAllowMultiSelect];
if OpenDialog.Execute then begin
for i:=0 to OpenDialog.Files.Count-1 do begin
AFilename:=CleanAndExpandFilename(OpenDialog.Files[i]);
if FileExists(AFilename) then begin
if ADirectory<>'' then
AFilename:=CreateRelativePath(AFilename,ADirectory);
NewListItem:=FilesListView.Items.Add;
NewListItem.Caption:=AFilename;
NewPgkFileType:=FileNameToPkgFileType(AFilename);
NewListItem.SubItems.Add(GetPkgFileTypeLocalizedName(NewPgkFileType));
end;
end;
end;
InputHistories.StoreFileDialogSettings(OpenDialog);
finally
OpenDialog.Free;
end;
end;
procedure TAddToProjectDialog.FilesDeleteButtonClick(Sender: TObject);
var
i: Integer;
begin
for i:=FilesListView.Items.Count-1 downto 0 do
if FilesListView.Items[i].Selected then
FilesListView.Items.Delete(i);
end;
procedure TAddToProjectDialog.FilesShortenButtonClick(Sender: TObject);
var
SwitchToAbsolute: Boolean;
i: Integer;
Filename: String;
ADirectory: String;
begin
if FilesListView.Items.Count=0 then exit;
if (TheProject=nil)
or (not FilenameIsAbsolute(TheProject.ProjectDirectory)) then exit;
ADirectory:=TheProject.ProjectDirectory;
SwitchToAbsolute:=not FilenameIsAbsolute(FilesListView.Items[0].Caption);
for i:=0 to FilesListView.Items.Count-1 do begin
Filename:=FilesListView.Items[i].Caption;
if SwitchToAbsolute then
Filename:=CreateAbsolutePath(Filename,ADirectory)
else
Filename:=CreateRelativePath(Filename,ADirectory);
FilesListView.Items[i].Caption:=Filename;
end;
end;
procedure TAddToProjectDialog.SetupComponents;
begin
NoteBook:=TNoteBook.Create(Self);
with NoteBook do begin
Name:='NoteBook';
Parent:=Self;
Pages.Add('Add File');
AddFilePage:=Page[0];
Pages.Add(lisProjAddEditorFile);
AddEditorFilePage:=Page[0];
Pages.Add(lisProjAddNewRequirement);
NewDependPage:=Page[1];
Pages.Add(lisProjAddFiles);
AddFilesPage:=Page[2];
PageIndex:=0;
Align:=alClient;
end;
AddFilePage.OnResize:=@AddFilePageResize;
AddEditorFilePage.OnResize:=@AddFilePageResize;
NewDependPage.OnResize:=@NewDependPageResize;
AddFileLabel:=TLabel.Create(Self);
with AddFileLabel do begin
Name:='AddFileLabel';
Parent:=AddFilePage;
Caption:=lisProjAddAddFileToProject;
end;
AddFileListBox:=TListBox.Create(Self);
with AddFileListBox do begin
Name:='AddFileListBox';
Parent:=AddFilePage;
MultiSelect:=true;
end;
AddFileButton:=TButton.Create(Self);
with AddFileButton do begin
Name:='AddFileButton';
Parent:=AddFilePage;
Caption:=lisLazBuildOk;
OnClick:=@AddFileButtonClick;
end;
CancelAddFileButton:=TButton.Create(Self);
with CancelAddFileButton do begin
Name:='CancelAddFileButton';
Parent:=AddFilePage;
Caption:=dlgCancel;
ModalResult:=mrCancel;
end;
// add required package
SetupAddEditorFilePage;
SetupAddRequirementPage;
SetupAddFilesPage;
end;
procedure TAddToProjectDialog.SetupAddRequirementPage;
begin
DependPkgNameLabel:=TLabel.Create(Self);
with DependPkgNameLabel do begin
Name:='DependPkgNameLabel';
@ -466,12 +517,169 @@ begin
end;
end;
procedure TAddToProjectDialog.SetupAddFilesPage;
var
CurColumn: TListColumn;
begin
FilesListView:=TListView.Create(Self);
with FilesListView do begin
Name:='FilesListView';
Parent:=AddFilesPage;
MultiSelect:=true;
ViewStyle:=vsReport;
CurColumn:=Columns.Add;
CurColumn.Width:=200;
CurColumn.Caption:=lisA2PFilename2;
CurColumn:=Columns.Add;
CurColumn.Caption:=dlgEnvType;
Align:=alTop;
end;
FilesBrowseButton:=TButton.Create(Self);
with FilesBrowseButton do begin
Name:='FilesBrowseButton';
Parent:=AddFilesPage;
Caption:=lisPathEditBrowse;
AutoSize:=true;
Anchors:=[akLeft,akBottom];
Left:=5;
AnchorParallel(akBottom,5,Parent);
OnClick:=@FilesBrowseButtonClick;
end;
FilesListView.AnchorToNeighbour(akBottom,5,FilesBrowseButton);
FilesShortenButton:=TButton.Create(Self);
with FilesShortenButton do begin
Name:='FilesShortenButton';
Parent:=AddFilesPage;
Caption:=lisA2PSwitchPaths;
AutoSize:=true;
AnchorToNeighbour(akLeft,5,FilesBrowseButton);
AnchorVerticalCenterTo(FilesBrowseButton);
OnClick:=@FilesShortenButtonClick;
end;
FilesDeleteButton:=TButton.Create(Self);
with FilesDeleteButton do begin
Name:='FilesDeleteButton';
Parent:=AddFilesPage;
Caption:=dlgEdDelete;
AutoSize:=true;
AnchorToNeighbour(akLeft,5,FilesShortenButton);
AnchorVerticalCenterTo(FilesBrowseButton);
OnClick:=@FilesDeleteButtonClick;
end;
FilesAddButton:=TButton.Create(Self);
with FilesAddButton do begin
Name:='FilesAddButton';
Parent:=AddFilesPage;
Caption:=lisA2PAddFilesToPackage;
AutoSize:=true;
AnchorToNeighbour(akLeft,5,FilesDeleteButton);
AnchorVerticalCenterTo(FilesBrowseButton);
OnClick:=@FilesAddButtonClick;
end;
end;
procedure TAddToProjectDialog.OnIteratePackages(APackageID: TLazPackageID);
begin
if (fPackages.Find(APackageID)=nil) then
fPackages.Add(APackageID);
end;
procedure TAddToProjectDialog.SetupAddEditorFilePage;
begin
AddFileLabel:=TLabel.Create(Self);
with AddFileLabel do begin
Name:='AddFileLabel';
Parent:=AddEditorFilePage;
Caption:=lisProjAddAddFileToProject;
end;
AddFileListBox:=TListBox.Create(Self);
with AddFileListBox do begin
Name:='AddFileListBox';
Parent:=AddEditorFilePage;
MultiSelect:=true;
end;
AddFileButton:=TButton.Create(Self);
with AddFileButton do begin
Name:='AddFileButton';
Parent:=AddEditorFilePage;
Caption:=lisLazBuildOk;
OnClick:=@AddFileButtonClick;
end;
CancelAddFileButton:=TButton.Create(Self);
with CancelAddFileButton do begin
Name:='CancelAddFileButton';
Parent:=AddEditorFilePage;
Caption:=dlgCancel;
ModalResult:=mrCancel;
end;
end;
function TAddToProjectDialog.CheckAddingFile(NewFiles: TStringList;
var NewFilename: string): TModalResult;
var
ConflictFile: TUnitInfo;
OtherUnitName: String;
OtherFile: string;
j: Integer;
NewFile: TUnitInfo;
NewUnitName: String;
begin
Result:=mrCancel;
// expand filename
if not FilenameIsAbsolute(NewFilename) then
NewFilename:=
TrimFilename(TheProject.ProjectDirectory+PathDelim+NewFilename);
// check if file is already part of project
NewFile:=TheProject.UnitInfoWithFilename(NewFilename);
if (NewFile<>nil) and NewFile.IsPartOfProject then begin
Result:=mrIgnore;
exit;
end;
// check unit name
if FilenameIsPascalUnit(NewFilename) then begin
// check unitname is valid pascal identifier
NewUnitName:=ExtractFileNameOnly(NewFilename);
if (NewUnitName='') or not (IsValidIdent(NewUnitName)) then begin
MessageDlg(lisProjAddInvalidPascalUnitName,
Format(lisProjAddTheUnitNameIsNotAValidPascalIdentifier, ['"',
NewUnitName, '"']),
mtWarning, [mbIgnore, mbCancel], 0);
exit;
end;
// check if unitname already exists in project
ConflictFile:=TheProject.UnitWithUnitname(NewUnitName);
if ConflictFile<>nil then begin
MessageDlg(lisProjAddUnitNameAlreadyExists,
Format(lisProjAddTheUnitNameAlreadyExistsInTheProject, ['"',
NewUnitName, '"', #13, '"', ConflictFile.Filename, '"']),
mtWarning, [mbCancel, mbIgnore], 0);
exit;
end;
// check if unitname already exists in selection
for j:=0 to NewFiles.Count-1 do begin
OtherFile:=NewFiles[j];
if FilenameIsPascalUnit(OtherFile) then begin
OtherUnitName:=ExtractFileNameOnly(OtherFile);
if CompareText(OtherUnitName, NewUnitName)=0 then begin
MessageDlg(lisProjAddUnitNameAlreadyExists,
Format(lisProjAddTheUnitNameAlreadyExistsInTheSelection, ['"',
NewUnitName, '"', #13, '"', OtherFile, '"']),
mtWarning, [mbCancel], 0);
exit;
end;
end;
end;
end;
Result:=mrOk;
end;
constructor TAddToProjectDialog.Create(TheOwner: TComponent);
begin
inherited Create(TheOwner);
@ -540,7 +748,7 @@ end;
destructor TAddToProjectResult.Destroy;
begin
Files.Free;
FileNames.Free;
inherited Destroy;
end;

2
ide/compileroptions.pp
View File

@ -1783,7 +1783,7 @@ Processor specific options:
// unit path
CurUnitPath:=GetUnitPath(true);
debugln('TBaseCompilerOptions.MakeOptionsString A ',dbgsName(Self),' CurUnitPath="',CurUnitPath,'"');
//debugln('TBaseCompilerOptions.MakeOptionsString A ',dbgsName(Self),' CurUnitPath="',CurUnitPath,'"');
// always add the current directory to the unit path, so that the compiler
// checks for changed files in the directory
CurUnitPath:=CurUnitPath+';.';

2
ide/lazarusidestrconsts.pas
View File

@ -1907,6 +1907,8 @@ resourcestring
lisProjAddTheUnitNameAlreadyExistsInTheSelection = 'The unit name %s%s%s '
+'already exists in the selection%swith file: %s%s%s.';
lisProjAddNewRequirement = 'New Requirement';
lisProjAddFiles = 'Add files';
lisProjAddEditorFile = 'Add editor files';
lisProjAddAddFileToProject = 'Add file to project:';
lisProjAddPackageName = 'Package Name:';
lisProjAddMinimumVersionOptional = 'Minimum Version (optional):';

5
ide/main.pp
View File

@ -10710,7 +10710,7 @@ begin
ShortUnitName:=AnUnitInfo.UnitName;
if (ShortUnitName<>'') then begin
Dummy:=CodeToolBoss.AddUnitToMainUsesSection(
Project1.MainUnitInfo.Source,ShortUnitName,'');
Project1.MainUnitInfo.Source,ShortUnitName,'');
ApplyCodeToolChanges;
if Dummy then begin
Project1.MainUnitInfo.Modified:=true;
@ -11380,6 +11380,9 @@ end.
{ =============================================================================
$Log$
Revision 1.839 2005/01/26 15:45:07 mattias
implemented adding files from directory in project inspector, fixed extrac proc checking overlapping blocks
Revision 1.838 2005/01/25 01:14:19 mattias
implemented automatic redirecting of package output directory and filestate cache

15
ide/projectinspector.pas
View File

@ -216,8 +216,9 @@ end;
procedure TProjectInspectorForm.AddBitBtnClick(Sender: TObject);
var
AddResult: TAddToProjectResult;
NewFile: TUnitInfo;
i: Integer;
NewFilename: string;
NewFile: TUnitInfo;
begin
if ShowAddToProjectDlg(LazProject,AddResult)<>mrOk then exit;
@ -225,8 +226,16 @@ begin
a2pFiles:
begin
BeginUpdate;
for i:=0 to AddResult.Files.Count-1 do begin
NewFile:=TUnitInfo(AddResult.Files[i]);
for i:=0 to AddResult.FileNames.Count-1 do begin
NewFilename:=AddResult.FileNames[i];
NewFile:=LazProject.UnitInfoWithFilename(NewFilename);
if NewFile<>nil then begin
if NewFile.IsPartOfProject then continue;
end else begin
NewFile:=TUnitInfo.Create(nil);
NewFile.Filename:=NewFilename;
LazProject.AddFile(NewFile,false);
end;
NewFile.IsPartOfProject:=true;
if Assigned(OnAddUnitToProject) then begin
if OnAddUnitToProject(Self,NewFile)<>mrOk then break;

75
lcl/controls.pp
View File

@ -1120,6 +1120,8 @@ type
function AutoSizeDelayed: boolean; virtual;
procedure AnchorToNeighbour(Side: TAnchorKind; Space: integer;
Sibling: TControl);
procedure AnchorParallel(Side: TAnchorKind; Space: integer;
Sibling: TControl);
procedure AnchorHorizontalCenterTo(Sibling: TControl);
procedure AnchorVerticalCenterTo(Sibling: TControl);
procedure SetBounds(aLeft, aTop, aWidth, aHeight: integer); virtual;
@ -2660,7 +2662,7 @@ begin
Position:=0;
OwnerParent:=FOwner.Parent;
if OwnerParent=nil then begin
// AnchorSide is only between siblings allowed
// AnchorSide is only between siblings or its direct parent allowed
ReferenceControl:=nil;
exit;
end;
@ -2675,10 +2677,11 @@ begin
ReferenceControl:=nil;
exit;
end;
// check sibling
if (ReferenceControl.Parent<>OwnerParent) then begin
// not a sibling -> invalid AnchorSide
// check if ReferenceControl is valid
if (ReferenceControl.Parent<>OwnerParent)
and (ReferenceControl<>OwnerParent) then begin
// not a sibling and not the parent -> invalid AnchorSide
ReferenceControl:=nil;
exit;
end;
@ -2695,25 +2698,39 @@ begin
asrTop:
if Kind in [akLeft,akRight] then begin
// anchor to left side of ReferenceControl
Position:=ReferenceControl.Left;
if ReferenceControl=OwnerParent then
Position:=0
else
Position:=ReferenceControl.Left;
if Kind=akLeft then begin
// anchor left of ReferenceControl and left of Owner
inc(Position,OwnerBorderSpacing);
end else begin
// anchor left of ReferenceControl and right of Owner
OwnerBorderSpacing:=Max(OwnerBorderSpacing,
if ReferenceControl=OwnerParent then
OwnerBorderSpacing:=Max(OwnerBorderSpacing,
OwnerParent.ChildSizing.LeftRightSpacing)
else
OwnerBorderSpacing:=Max(OwnerBorderSpacing,
ReferenceControl.BorderSpacing.GetSpace(akLeft));
dec(Position,OwnerBorderSpacing);
end;
end else begin
// anchor to top side of ReferenceControl
Position:=ReferenceControl.Top;
if ReferenceControl=OwnerParent then
Position:=0
else
Position:=ReferenceControl.Top;
if Kind=akTop then begin
// anchor top of ReferenceControl and top of Owner
inc(Position,OwnerBorderSpacing);
end else begin
// anchor top of ReferenceControl and bottom of Owner
OwnerBorderSpacing:=Max(OwnerBorderSpacing,
if ReferenceControl=OwnerParent then
OwnerBorderSpacing:=Max(OwnerBorderSpacing,
OwnerParent.ChildSizing.TopBottomSpacing)
else
OwnerBorderSpacing:=Max(OwnerBorderSpacing,
ReferenceControl.BorderSpacing.GetSpace(akTop));
dec(Position,OwnerBorderSpacing);
end;
@ -2722,10 +2739,17 @@ begin
asrBottom:
if Kind in [akLeft,akRight] then begin
// anchor to right side of ReferenceControl
Position:=ReferenceControl.Left+ReferenceControl.Width;
if ReferenceControl=OwnerParent then
Position:=OwnerParent.ClientWidth
else
Position:=ReferenceControl.Left+ReferenceControl.Width;
if Kind=akLeft then begin
// anchor right of ReferenceControl and left of Owner
OwnerBorderSpacing:=Max(OwnerBorderSpacing,
if ReferenceControl=OwnerParent then
OwnerBorderSpacing:=Max(OwnerBorderSpacing,
OwnerParent.ChildSizing.LeftRightSpacing)
else
OwnerBorderSpacing:=Max(OwnerBorderSpacing,
ReferenceControl.BorderSpacing.GetSpace(akRight));
inc(Position,OwnerBorderSpacing);
end else begin
@ -2734,10 +2758,17 @@ begin
end;
end else begin
// anchor to bottom side of ReferenceControl
Position:=ReferenceControl.Top+ReferenceControl.Height;
if ReferenceControl=OwnerParent then
Position:=OwnerParent.ClientHeight
else
Position:=ReferenceControl.Top+ReferenceControl.Height;
if Kind=akTop then begin
// anchor bottom of ReferenceControl and top of Owner
OwnerBorderSpacing:=Max(OwnerBorderSpacing,
if ReferenceControl=OwnerParent then
OwnerBorderSpacing:=Max(OwnerBorderSpacing,
OwnerParent.ChildSizing.TopBottomSpacing)
else
OwnerBorderSpacing:=Max(OwnerBorderSpacing,
ReferenceControl.BorderSpacing.GetSpace(akBottom));
inc(Position,OwnerBorderSpacing);
end else begin
@ -2749,14 +2780,20 @@ begin
asrCenter:
if Kind in [akLeft,akRight] then begin
// center horizontally
Position:=ReferenceControl.Left+(ReferenceControl.Width div 2);
if ReferenceControl=OwnerParent then
Position:=OwnerParent.ClientWidth div 2
else
Position:=ReferenceControl.Left+(ReferenceControl.Width div 2);
if Kind=akLeft then
dec(Position,FOwner.Width div 2)
else
inc(Position,FOwner.Width div 2);
end else begin
// center vertically
Position:=ReferenceControl.Top+(ReferenceControl.Height div 2);
if ReferenceControl=OwnerParent then
Position:=OwnerParent.ClientHeight div 2
else
Position:=ReferenceControl.Top+(ReferenceControl.Height div 2);
if Kind=akTop then
dec(Position,FOwner.Height div 2)
else
@ -2770,7 +2807,10 @@ begin
exit;
end;
// ReferenceControl is not visible -> try next
NextReferenceSide:=ReferenceControl.AnchorSide[
if ReferenceControl=OwnerParent then
NextReferenceSide:=nil
else
NextReferenceSide:=ReferenceControl.AnchorSide[
AnchorReferenceSide[Kind,ReferenceSide]];
if (NextReferenceSide=nil) then begin
ReferenceControl:=nil;
@ -2855,6 +2895,9 @@ end.
{ =============================================================================
$Log$
Revision 1.277 2005/01/26 15:45:08 mattias
implemented adding files from directory in project inspector, fixed extrac proc checking overlapping blocks
Revision 1.276 2005/01/25 09:58:16 mattias
fixed fpc 1.0.10 compilation

22
lcl/include/control.inc
View File

@ -3259,6 +3259,25 @@ begin
Anchors:=Anchors+[Side];
end;
procedure TControl.AnchorParallel(Side: TAnchorKind; Space: integer;
Sibling: TControl);
begin
case Side of
akLeft: BorderSpacing.Left:=Space;
akTop: BorderSpacing.Top:=Space;
akRight: BorderSpacing.Right:=Space;
akBottom: BorderSpacing.Bottom:=Space;
end;
case Side of
akLeft: AnchorSide[Side].Side:=asrLeft;
akTop: AnchorSide[Side].Side:=asrTop;
akRight: AnchorSide[Side].Side:=asrRight;
akBottom: AnchorSide[Side].Side:=asrBottom;
end;
AnchorSide[Side].Control:=Sibling;
Anchors:=Anchors+[Side];
end;
{------------------------------------------------------------------------------
procedure TControl.AnchorHorizontalCenterTo(Sibling: TControl);
@ -3430,6 +3449,9 @@ end;
{ =============================================================================
$Log$
Revision 1.242 2005/01/26 15:45:08 mattias
implemented adding files from directory in project inspector, fixed extrac proc checking overlapping blocks
Revision 1.241 2005/01/24 12:23:11 mattias
fixed TColorButton.Paint

6
lcl/include/wincontrol.inc
View File

@ -168,10 +168,11 @@ var
end;
Result:=DefaultPosition;
CurAnchorSide:=Control.AnchorSide[Kind];
//debugln('GetAnchorSidePosition Self=',DbgSName(Self),' Control=',DbgSName(Control),' ',dbgs(CurAnchorSide.Control<>nil));
//debugln('GetAnchorSidePosition A Self=',DbgSName(Self),' Control=',DbgSName(Control),' ',DbgSName(CurAnchorSide.Control));
CurAnchorSide.GetSidePosition(ReferenceControl,ReferenceSide,Position);
if ReferenceControl<>nil then
Result:=Position;
//debugln('GetAnchorSidePosition B Self=',DbgSName(Self),' Control=',DbgSName(Control),' ',dbgs(Result));
AnchorSideCacheValid[Kind]:=true;
AnchorSideCache[Kind]:=Result;
end;
@ -4386,6 +4387,9 @@ end;
{ =============================================================================
$Log$
Revision 1.308 2005/01/26 15:45:08 mattias
implemented adding files from directory in project inspector, fixed extrac proc checking overlapping blocks
Revision 1.307 2005/01/25 09:58:16 mattias
fixed fpc 1.0.10 compilation

22
packager/addtopackagedlg.pas
View File

@ -184,7 +184,6 @@ type
procedure AutoCompleteNewComponentUnitName;
procedure UpdateAddUnitInfo;
procedure UpdateAddFileInfo;
function FileNameToPkgFileType(const AFilename: string): TPkgFileType;
function SwitchRelativeAbsoluteFilename(const Filename: string): string;
public
Params: TAddToPkgResult;
@ -872,7 +871,7 @@ begin
OpenDialog.Options:=OpenDialog.Options
+[ofFileMustExist,ofPathMustExist,ofAllowMultiSelect];
if OpenDialog.Execute then begin
for i:=0 to OpenDialog.Files.COunt-1 do begin
for i:=0 to OpenDialog.Files.Count-1 do begin
AFilename:=CleanAndExpandFilename(OpenDialog.Files[i]);
if FileExists(AFilename) then begin
LazPackage.ShortenFilename(AFilename,true);
@ -1724,25 +1723,6 @@ begin
AddFileTypeRadioGroup.ItemIndex:=i;
end;
function TAddToPackageDlg.FileNameToPkgFileType(const AFilename: string
): TPkgFileType;
begin
if CompareFileExt(AFilename,'.lfm',true)=0 then
Result:=pftLFM
else if CompareFileExt(AFilename,'.lrs',true)=0 then
Result:=pftLRS
else if CompareFileExt(AFilename,'.inc',true)=0 then
Result:=pftInclude
else if CompareFileExt(AFilename,'.pas',true)=0 then
Result:=pftUnit
else if CompareFileExt(AFilename,'.pp',true)=0 then
Result:=pftUnit
else if FileIsText(AFilename) then
Result:=pftText
else
Result:=pftBinary;
end;
function TAddToPackageDlg.SwitchRelativeAbsoluteFilename(const Filename: string
): string;
begin

19
packager/packagedefs.pas
View File

@ -807,6 +807,7 @@ function PkgFileTypeIdentToType(const s: string): TPkgFileType;
function LazPackageTypeIdentToType(const s: string): TLazPackageType;
function GetPkgFileTypeLocalizedName(FileType: TPkgFileType): string;
function NameToAutoUpdatePolicy(const s: string): TPackageUpdatePolicy;
function FileNameToPkgFileType(const AFilename: string): TPkgFileType;
procedure SortDependencyList(Dependencies: TList);
procedure LoadPkgDependencyList(XMLConfig: TXMLConfig; const ThePath: string;
@ -872,6 +873,24 @@ begin
Result:=pupAsNeeded;
end;
function FileNameToPkgFileType(const AFilename: string): TPkgFileType;
begin
if CompareFileExt(AFilename,'.lfm',true)=0 then
Result:=pftLFM
else if CompareFileExt(AFilename,'.lrs',true)=0 then
Result:=pftLRS
else if CompareFileExt(AFilename,'.inc',true)=0 then
Result:=pftInclude
else if CompareFileExt(AFilename,'.pas',true)=0 then
Result:=pftUnit
else if CompareFileExt(AFilename,'.pp',true)=0 then
Result:=pftUnit
else if FileIsText(AFilename) then
Result:=pftText
else
Result:=pftBinary;
end;
procedure LoadPkgDependencyList(XMLConfig: TXMLConfig; const ThePath: string;
var First: TPkgDependency; ListType: TPkgDependencyList; Owner: TObject;
HoldPackages: boolean);