implemented searching and editing virtual units

git-svn-id: trunk@6042 -
This commit is contained in:
mattias 2004-09-22 12:43:18 +00:00
parent 1ccd761115
commit 317a590852
11 changed files with 499 additions and 21 deletions

3
.gitattributes vendored
View File

@ -1536,6 +1536,9 @@ packager/packagesystem.pas svneol=native#text/pascal
packager/pkggraphexplorer.pas svneol=native#text/pascal
packager/pkgmanager.pas svneol=native#text/pascal
packager/pkgoptionsdlg.pas svneol=native#text/pascal
packager/pkgvirtualuniteditor.lfm svneol=native#text/plain
packager/pkgvirtualuniteditor.lrs svneol=native#text/pascal
packager/pkgvirtualuniteditor.pas svneol=native#text/pascal
packager/registerfcl.pas svneol=native#text/pascal
packager/registerideintf.pas svneol=native#text/pascal
packager/registerlcl.pas svneol=native#text/pascal

View File

@ -1145,6 +1145,9 @@ var
StartNode: TCodeTreeNode;
SectionNode: TCodeTreeNode;
Node: TCodeTreeNode;
BestNodeIsForwardDecaration: Boolean;
CurNodeIsForwardDeclaration: Boolean;
BestNode: TCodeTreeNode;
begin
Result:=false;
if Identifier='' then exit;
@ -1153,14 +1156,19 @@ begin
if StartNode=nil then exit;
SectionNode:=StartNode.FirstChild;
if SectionNode=nil then exit;
BestNode:=nil;
BestNodeIsForwardDecaration:=false;
while SectionNode<>nil do begin
if SectionNode.Desc in AllDefinitionSections then begin
Node:=SectionNode.FirstChild;
while Node<>nil do begin
if Node.Desc in AllIdentifierDefinitions then begin
if CompareSrcIdentifiers(Node.StartPos,PChar(Identifier)) then begin
Result:=JumpToNode(Node,NewPos,NewTopLine,false);
exit;
CurNodeIsForwardDeclaration:=NodeIsForwardDeclaration(Node);
if (BestNode=nil) or BestNodeIsForwardDecaration then begin
BestNode:=Node;
BestNodeIsForwardDecaration:=CurNodeIsForwardDeclaration;
end;
end;
end;
Node:=Node.NextBrother;
@ -1168,6 +1176,8 @@ begin
end;
SectionNode:=SectionNode.NextBrother;
end;
if BestNode<>nil then
Result:=JumpToNode(BestNode,NewPos,NewTopLine,false);
end;
function TFindDeclarationTool.FindDeclarationInUsesSection(

View File

@ -4,9 +4,13 @@
<Name Value="DBFLaz"/>
<Author Value="Michael Van Canneyt"/>
<CompilerOptions>
<Version Value="2"/>
<SearchPaths>
<UnitOutputDirectory Value="lib/"/>
</SearchPaths>
<CodeGeneration>
<Generate Value="Faster"/>
</CodeGeneration>
<Other>
<CompilerPath Value="$(CompPath)"/>
</Other>

View File

@ -1,7 +1,7 @@
{ This file was automatically created by Lazarus. Do not edit!
{ This file was automatically created by Lazarus. Do not edit!
This source is only used to compile and install
the package DBFLaz 0.1.1.
}
}
unit DBFLaz;
@ -18,5 +18,5 @@ begin
end;
initialization
RegisterPackage('DBFLaz', @Register)
RegisterPackage('DBFLaz', @Register);
end.

View File

@ -4904,7 +4904,9 @@ function TMainIDE.DoOpenMainUnit(ProjectLoading: boolean): TModalResult;
var MainUnitInfo: TUnitInfo;
OpenFlags: TOpenFlags;
begin
{$IFDEF IDE_VERBOSE}
debugln('[TMainIDE.DoOpenMainUnit] A ProjectLoading=',BoolToStr(ProjectLoading),' MainUnitID=',IntToStr(Project1.MainUnitID));
{$ENDIF}
Result:=mrCancel;
if Project1.MainUnitID<0 then exit;
MainUnitInfo:=Project1.MainUnitInfo;
@ -4923,7 +4925,6 @@ begin
Result:=DoOpenFileInSourceNoteBook(MainUnitInfo,-1,OpenFlags);
if Result<>mrOk then exit;
// build a nice pagename for the sourcenotebook
Result:=mrOk;
{$IFDEF IDE_VERBOSE}
writeln('[TMainIDE.DoOpenMainUnit] END');
@ -8226,6 +8227,9 @@ var
SearchPath: String;
SearchFile: String;
begin
{$IFDEF VerboseFindSourceFile}
writeln('TMainIDE.FindSourceFile Filename="',AFilename,'" BaseDirectory="',BaseDirectory,'"');
{$ENDIF}
if FilenameIsAbsolute(AFilename) then begin
if FileExists(AFilename) then
Result:=AFilename
@ -10809,6 +10813,9 @@ end.
{ =============================================================================
$Log$
Revision 1.776 2004/09/22 12:43:17 mattias
implemented searching and editing virtual units
Revision 1.775 2004/09/21 10:05:26 mattias
fixed disable at designtime and bounding TProgressBar position

View File

@ -624,7 +624,10 @@ type
procedure LongenFilename(var AFilename: string);
function FindPkgFile(const AFilename: string;
ResolveLinks, IgnoreRemoved: boolean): TPkgFile;
function FindUnit(const TheUnitName: string): TPkgFile;
function FindUnit(const TheUnitName: string; IgnoreRemoved: boolean): TPkgFile;
function FindUnit(const TheUnitName: string; IgnoreRemoved: boolean;
IgnorePkgFile: TPkgFile): TPkgFile;
function FindRemovedPkgFile(const AFilename: string): TPkgFile;
function AddFile(const NewFilename, NewUnitName: string;
NewFileType: TPkgFileType; NewFlags: TPkgFileFlags;
@ -637,6 +640,7 @@ type
function GetFileDialogInitialDir(const DefaultDirectory: string): string;
procedure MoveFile(CurIndex, NewIndex: integer);
procedure SortFiles;
procedure FixFilesCaseSensitivity;
// required dependencies (plus removed required dependencies)
function FindDependencyByName(const PkgName: string): TPkgDependency;
function RequiredDepByIndex(Index: integer): TPkgDependency;
@ -2409,8 +2413,19 @@ begin
Result:=nil;
end;
function TLazPackage.FindUnit(const TheUnitName: string): TPkgFile;
begin
Result:=FindUnit(TheUnitName,true);
end;
function TLazPackage.FindUnit(const TheUnitName: string;
IgnoreRemoved: boolean): TPkgFile;
begin
Result:=FindUnit(TheUnitName,IgnoreRemoved,nil);
end;
function TLazPackage.FindUnit(const TheUnitName: string;
IgnoreRemoved: boolean; IgnorePkgFile: TPkgFile): TPkgFile;
var
Cnt: Integer;
i: Integer;
@ -2419,12 +2434,14 @@ begin
Cnt:=FileCount;
for i:=0 to Cnt-1 do begin
Result:=Files[i];
if IgnorePkgFile=Result then continue;
if AnsiCompareText(Result.UnitName,TheUnitName)=0 then exit;
end;
if not IgnoreRemoved then begin
Cnt:=RemovedFilesCount;
for i:=0 to Cnt-1 do begin
Result:=RemovedFiles[i];
if IgnorePkgFile=Result then continue;
if AnsiCompareText(Result.UnitName,TheUnitName)=0 then exit;
end;
end;
@ -2569,6 +2586,97 @@ begin
end;
end;
procedure TLazPackage.FixFilesCaseSensitivity;
var
SrcDirs: TStringList;
function IndexOfFileInStringList(List: TStringList;
const Filename: string; OnlyExact: boolean): integer;
begin
// first search for exact match
Result:=List.Count-1;
while (Result>=0) do begin
if (Filename=List[Result]) then exit;
dec(Result);
end;
if OnlyExact then exit;
// then search for case insensitive match
Result:=List.Count-1;
while (Result>=0) and (AnsiCompareText(Filename,List[Result])<>0) do
dec(Result);
end;
function AddDirectoryListing(const ADirectory: string): TStringList;
var
SrcDirID: Integer;
FileInfo: TSearchRec;
begin
if SrcDirs=nil then
SrcDirs:=TStringList.Create;
// search directory listing
SrcDirID:=IndexOfFileInStringList(SrcDirs,ADirectory,true);
if SrcDirID>=0 then begin
Result:=TStringList(SrcDirs.Objects[SrcDirID]);
exit;
end;
// create new directory listing
Result:=TStringList.Create;
if SysUtils.FindFirst(AppendPathDelim(ADirectory)+GetAllFilesMask,
faAnyFile,FileInfo)=0
then begin
repeat
// check if special file
if (FileInfo.Name='.') or (FileInfo.Name='..') then continue;
Result.Add(FileInfo.Name);
//debugln('AddDirectoryListing ',FileInfo.Name);
until SysUtils.FindNext(FileInfo)<>0;
end;
SysUtils.FindClose(FileInfo);
SrcDirs.AddObject(ADirectory,Result);
end;
var
Cnt: Integer;
i: Integer;
CurFile: TPkgFile;
CurShortFilename: String;
DirListID: LongInt;
DirListing: TStringList;
NewShortFilename: string;
NewFilename: String;
CurDir: String;
begin
Cnt:=FileCount;
SrcDirs:=nil;
try
for i:=0 to Cnt-1 do begin
CurFile:=Files[i];
CurDir:=CurFile.Directory;
//debugln('TLazPackage.FixFilesCaseSensitivity A ',dbgs(i),' CurFile.Filename=',CurFile.Filename);
DirListing:=AddDirectoryListing(CurDir);
CurShortFilename:=ExtractFilename(CurFile.Filename);
DirListID:=IndexOfFileInStringList(DirListing,CurShortFilename,false);
//debugln('TLazPackage.FixFilesCaseSensitivity B ',dbgs(i),' CurShortFilename=',CurShortFilename,' DirListID=',dbgs(DirListID));
if DirListID<0 then continue;
NewShortFilename:=DirListing[DirListID];
//debugln('TLazPackage.FixFilesCaseSensitivity New ',dbgs(i),' NewShortFilename=',NewShortFilename);
if CurShortFilename<>NewShortFilename then begin
// case changes
NewFilename:=
AppendPathDelim(ExtractFilePath(CurFile.Filename))+NewShortFilename;
//debugln('TLazPackage.FixFilesCaseSensitivity New ',dbgs(i),' NewFilename=',NewFilename);
CurFile.Filename:=NewFilename;
end;
end;
finally
if SrcDirs<>nil then begin
for i:=0 to SrcDirs.Count-1 do
SrcDirs.Objects[i].Free;
SrcDirs.Free;
end;
end;
end;
procedure TLazPackage.RemoveRemovedDependency(Dependency: TPkgDependency);
begin
Dependency.RemoveFromList(FFirstRemovedDependency,pdlRequires);

View File

@ -42,11 +42,13 @@ uses
Graphics, LCLType, LCLProc, Menus, Dialogs, FileCtrl, Laz_XMLCfg, AVL_Tree,
IDEProcs, LazConf, LazarusIDEStrConsts, IDEOptionDefs, IDEDefs,
CompilerOptions, CompilerOptionsDlg, ComponentReg, PackageDefs, PkgOptionsDlg,
AddToPackageDlg, PackageSystem;
AddToPackageDlg, PkgVirtualUnitEditor, PackageSystem;
type
TOnOpenFile =
function(Sender: TObject; const Filename: string): TModalResult of object;
TOnOpenPkgFile =
function(Sender: TObject; PkgFile: TPkgFile): TModalResult of object;
TOnOpenPackage =
function(Sender: TObject; APackage: TLazPackage): TModalResult of object;
TOnSavePackage =
@ -123,22 +125,23 @@ type
procedure CallRegisterProcCheckBoxClick(Sender: TObject);
procedure ChangeFileTypeMenuItemClick(Sender: TObject);
procedure CompileAllCleanClick(Sender: TObject);
procedure CompileCleanClick(Sender: TObject);
procedure CompileBitBtnClick(Sender: TObject);
procedure CompileCleanClick(Sender: TObject);
procedure CompilerOptionsBitBtnClick(Sender: TObject);
procedure FilePropsGroupBoxResize(Sender: TObject);
procedure FilesPopupMenuPopup(Sender: TObject);
procedure FilesTreeViewDblClick(Sender: TObject);
procedure FilesTreeViewSelectionChanged(Sender: TObject);
procedure FixFilesCaseMenuItemClick(Sender: TObject);
procedure HelpBitBtnClick(Sender: TObject);
procedure InstallBitBtnClick(Sender: TObject);
procedure MaxVersionEditChange(Sender: TObject);
procedure MinVersionEditChange(Sender: TObject);
procedure MoreBitBtnClick(Sender: TObject);
procedure MoveDependencyUpClick(Sender: TObject);
procedure MoveDependencyDownClick(Sender: TObject);
procedure MoveFileUpMenuItemClick(Sender: TObject);
procedure MoveDependencyUpClick(Sender: TObject);
procedure MoveFileDownMenuItemClick(Sender: TObject);
procedure MoveFileUpMenuItemClick(Sender: TObject);
procedure OpenFileMenuItemClick(Sender: TObject);
procedure OptionsBitBtnClick(Sender: TObject);
procedure PackageEditorFormClose(Sender: TObject; var CloseAction: TCloseAction);
@ -149,14 +152,15 @@ type
procedure RegisteredListBoxDrawItem(Control: TWinControl; Index: Integer;
ARect: TRect; State: TOwnerDrawState);
procedure RemoveBitBtnClick(Sender: TObject);
procedure EditVirtualUnitMenuItemClick(Sender: TObject);
procedure RevertClick(Sender: TObject);
procedure SaveBitBtnClick(Sender: TObject);
procedure SaveAsClick(Sender: TObject);
procedure SaveBitBtnClick(Sender: TObject);
procedure SortFilesMenuItemClick(Sender: TObject);
procedure UninstallClick(Sender: TObject);
procedure ViewPkgSourceClick(Sender: TObject);
procedure UseMaxVersionCheckBoxClick(Sender: TObject);
procedure UseMinVersionCheckBoxClick(Sender: TObject);
procedure ViewPkgSourceClick(Sender: TObject);
private
FLazPackage: TLazPackage;
FilesNode: TTreeNode;
@ -183,12 +187,15 @@ type
public
constructor Create(TheOwner: TComponent); override;
destructor Destroy; override;
procedure DoSave(SaveAs: boolean);
procedure DoCompile(CompileClean, CompileRequired: boolean);
procedure DoRevert;
procedure DoPublishProject;
procedure DoFixFilesCase;
procedure DoMoveCurrentFile(Offset: integer);
procedure DoPublishProject;
procedure DoEditVirtualUnit;
procedure DoRevert;
procedure DoSave(SaveAs: boolean);
procedure DoSortFiles;
procedure DoOpenPkgFile(PkgFile: TPkgFile);
public
property LazPackage: TLazPackage read FLazPackage write SetLazPackage;
end;
@ -210,6 +217,7 @@ type
FOnInstallPackage: TOnInstallPackage;
FOnOpenFile: TOnOpenFile;
FOnOpenPackage: TOnOpenPackage;
FOnOpenPkgFile: TOnOpenPkgFile;
FOnPublishPackage: TOnPublishPackage;
FOnRevertPackage: TOnRevertPackage;
FOnSavePackage: TOnSavePackage;
@ -231,6 +239,7 @@ type
function FindEditor(Pkg: TLazPackage): TPackageEditorForm;
function OpenEditor(Pkg: TLazPackage): TPackageEditorForm;
function OpenFile(Sender: TObject; const Filename: string): TModalResult;
function OpenPkgFile(Sender: TObject; PkgFile: TPkgFile): TModalResult;
function OpenDependency(Sender: TObject;
Dependency: TPkgDependency): TModalResult;
procedure DoFreeEditor(Pkg: TLazPackage);
@ -251,6 +260,8 @@ type
property OnCreateNewFile: TOnCreateNewPkgFile read FOnCreateNewFile
write FOnCreateNewFile;
property OnOpenFile: TOnOpenFile read FOnOpenFile write FOnOpenFile;
property OnOpenPkgFile: TOnOpenPkgFile read FOnOpenPkgFile
write FOnOpenPkgFile;
property OnOpenPackage: TOnOpenPackage read FOnOpenPackage
write FOnOpenPackage;
property OnGetIDEFileInfo: TGetIDEFileStateEvent read FOnGetIDEFileInfo
@ -490,14 +501,19 @@ begin
AddPopupMenuItem('Move file down', @MoveFileDownMenuItemClick,
(FileIndex<LazPackage.FileCount-1) and Writable);
AddFileTypeMenuItem;
if CurFile.FileType=pftVirtualUnit then
AddPopupMenuItem('Edit Virtual Unit',@EditVirtualUnitMenuItemClick,
Writable);
end else begin
AddPopupMenuItem(lisOpenFile, @OpenFileMenuItemClick, true);
AddPopupMenuItem(lisPckEditReAddFile, @ReAddMenuItemClick,
AddBitBtn.Enabled);
end;
end;
if LazPackage.FileCount>1 then
if LazPackage.FileCount>1 then begin
AddPopupMenuItem('Sort files', @SortFilesMenuItemClick, Writable);
AddPopupMenuItem('Fix Files Case', @FixFilesCaseMenuItemClick, Writable);
end;
if CurDependency<>nil then begin
if (not Removed) then begin
@ -644,13 +660,13 @@ begin
if CurNode.Parent<>nil then begin
if CurNode.Parent=FilesNode then begin
CurFile:=LazPackage.Files[NodeIndex];
PackageEditors.OpenFile(Self,CurFile.Filename);
DoOpenPkgFile(CurFile);
end else if CurNode.Parent=RequiredPackagesNode then begin
CurDependency:=LazPackage.RequiredDepByIndex(NodeIndex);
PackageEditors.OpenDependency(Self,CurDependency);
end else if CurNode.Parent=RemovedFilesNode then begin
CurFile:=LazPackage.RemovedFiles[NodeIndex];
PackageEditors.OpenFile(Self,CurFile.Filename);
DoOpenPkgFile(CurFile);
end else if CurNode.Parent=RemovedRequiredNode then begin
CurDependency:=LazPackage.RemovedDepByIndex(NodeIndex);
PackageEditors.OpenDependency(Self,CurDependency);
@ -778,6 +794,11 @@ begin
end;
end;
procedure TPackageEditorForm.EditVirtualUnitMenuItemClick(Sender: TObject);
begin
DoEditVirtualUnit;
end;
procedure TPackageEditorForm.RevertClick(Sender: TObject);
begin
DoRevert;
@ -798,6 +819,11 @@ begin
DoSortFiles;
end;
procedure TPackageEditorForm.FixFilesCaseMenuItemClick(Sender: TObject);
begin
DoFixFilesCase;
end;
procedure TPackageEditorForm.UninstallClick(Sender: TObject);
begin
PackageEditors.UninstallPackage(LazPackage);
@ -1808,6 +1834,17 @@ begin
UpdateAll;
end;
procedure TPackageEditorForm.DoEditVirtualUnit;
var
Removed: boolean;
CurFile: TPkgFile;
begin
CurFile:=GetCurrentFile(Removed);
if (CurFile=nil) or Removed then exit;
if ShowEditVirtualPackageDialog(CurFile)=mrOk then
UpdateAll;
end;
procedure TPackageEditorForm.DoMoveCurrentFile(Offset: integer);
var
Removed: boolean;
@ -1839,6 +1876,17 @@ begin
ApplyTreeSelection(TreeSelection,true);
end;
procedure TPackageEditorForm.DoOpenPkgFile(PkgFile: TPkgFile);
begin
PackageEditors.OpenPkgFile(Self,PkgFile);
end;
procedure TPackageEditorForm.DoFixFilesCase;
begin
LazPackage.FixFilesCaseSensitivity;
UpdateFiles;
end;
constructor TPackageEditorForm.Create(TheOwner: TComponent);
begin
inherited Create(TheOwner);
@ -2059,6 +2107,15 @@ begin
Result:=mrCancel;
end;
function TPackageEditors.OpenPkgFile(Sender: TObject; PkgFile: TPkgFile
): TModalResult;
begin
if Assigned(OnOpenPkgFile) then
Result:=OnOpenPkgFile(Sender,PkgFile)
else
Result:=mrCancel;
end;
function TPackageEditors.OpenDependency(Sender: TObject;
Dependency: TPkgDependency): TModalResult;
var

View File

@ -78,6 +78,8 @@ type
): TModalResult;
function OnPackageEditorUninstallPackage(Sender: TObject;
APackage: TLazPackage): TModalResult;
function OnPackageEditorOpenPkgFile(Sender: TObject; PkgFile: TPkgFile
): TModalResult;
function OnPackageEditorOpenPackage(Sender: TObject; APackage: TLazPackage
): TModalResult;
function OnPackageEditorSavePackage(Sender: TObject; APackage: TLazPackage;
@ -183,6 +185,8 @@ type
var List: TObjectArray): TModalResult;
function GetOwnersOfUnit(const UnitFilename: string): TList; override;
function GetSourceFilesOfOwners(OwnerList: TList): TStrings; override;
function DoOpenPkgFile(PkgFile: TPkgFile): TModalResult;
function FindVirtualUnitSource(PkgFile: TPkgFile): string;
// package graph
function AddPackageToGraph(APackage: TLazPackage; Replace: boolean): TModalResult;
@ -293,15 +297,23 @@ end;
procedure TPkgManager.IDEComponentPaletteOpenUnit(Sender: TObject);
var
PkgComponent: TPkgComponent;
PkgFile: TPkgFile;
Filename: String;
begin
if (Sender=nil) then exit;
if (Sender is TPkgFile) then
MainIDE.DoOpenMacroFile(Self,TPkgFile(Sender).Filename)
DoOpenPkgFile(TPkgFile(Sender))
else if (Sender is TPkgComponent) then begin
PkgComponent:=TPkgComponent(Sender);
if PkgComponent.PkgFile=nil then exit;
PkgFile:=PkgComponent.PkgFile;
if PkgFile=nil then exit;
Filename:='';
if PkgFile.FileType=pftVirtualUnit then
Filename:=FindVirtualUnitSource(PkgFile);
if Filename='' then
Filename:=PkgFile.Filename;
MainIDE.DoOpenFileAndJumpToIdentifier(
PkgComponent.PkgFile.Filename,PkgComponent.ComponentClass.ClassName,
Filename,PkgComponent.ComponentClass.ClassName,
-1, // open page somewhere
[ofOnlyIfExists,ofAddToRecent,ofRegularFile,ofConvertMacros]);
end;
@ -453,6 +465,12 @@ begin
Result:=DoUninstallPackage(APackage);
end;
function TPkgManager.OnPackageEditorOpenPkgFile(Sender: TObject;
PkgFile: TPkgFile): TModalResult;
begin
Result:=DoOpenPkgFile(PkgFile);
end;
procedure TPkgManager.OnPackageEditorFreeEditor(APackage: TLazPackage);
begin
APackage.Editor:=nil;
@ -1517,6 +1535,7 @@ begin
// package editors
PackageEditors:=TPackageEditors.Create;
PackageEditors.OnOpenFile:=@MainIDE.DoOpenMacroFile;
PackageEditors.OnOpenPkgFile:=@OnPackageEditorOpenPkgFile;
PackageEditors.OnOpenPackage:=@OnPackageEditorOpenPackage;
PackageEditors.OnCreateNewFile:=@OnPackageEditorCreateFile;
PackageEditors.OnGetIDEFileInfo:=@MainIDE.GetIDEFileState;
@ -2835,6 +2854,32 @@ begin
end;
end;
function TPkgManager.DoOpenPkgFile(PkgFile: TPkgFile): TModalResult;
var
Filename: String;
begin
if (PkgFile.FileType=pftVirtualUnit) then begin
Filename:=FindVirtualUnitSource(PkgFile);
if Filename<>'' then begin
Result:=MainIDE.DoOpenEditorFile(Filename,-1,
[ofOnlyIfExists,ofAddToRecent,ofRegularFile]);
exit;
end;
end;
Result:=MainIDE.DoOpenMacroFile(Self,PkgFile.Filename);
end;
function TPkgManager.FindVirtualUnitSource(PkgFile: TPkgFile): string;
begin
Result:='';
if (PkgFile.FileType=pftVirtualUnit)
and (PkgFile.LazPackage<>nil)
and (not FileExists(PkgFile.Filename)) then begin
Result:=MainIDE.FindSourceFile(PkgFile.GetShortFilename(false),
PkgFile.LazPackage.Directory,[]);
end;
end;
function TPkgManager.DoAddActiveUnitToAPackage: TModalResult;
var
ActiveSourceEditor: TSourceEditor;

View File

@ -0,0 +1,65 @@
object EditVirtualUnitDialog: TEditVirtualUnitDialog
Caption = 'EditVirtualUnitDialog'
ClientHeight = 131
ClientWidth = 450
OnCreate = EditVirtualUnitDialogCreate
PixelsPerInch = 90
Position = poScreenCenter
HorzScrollBar.Page = 451
VertScrollBar.Page = 132
Left = 346
Height = 131
Top = 254
Width = 450
object OkButton: TButton
Caption = 'OkButton'
OnClick = OkButtonClick
TabOrder = 0
Left = 200
Height = 25
Top = 96
Width = 101
end
object CancelButton: TButton
Caption = 'CancelButton'
ModalResult = 2
TabOrder = 1
Left = 332
Height = 25
Top = 96
Width = 101
end
object FilenameLabel: TLabel
Caption = 'FilenameLabel'
Left = 8
Height = 17
Top = 24
Width = 89
end
object UnitnameLabel: TLabel
Caption = 'UnitnameLabel'
Left = 8
Height = 17
Top = 64
Width = 89
end
object FilenameEdit: TEdit
Anchors = [akTop, akLeft, akRight]
TabOrder = 4
Text = 'FilenameEdit'
TabOrder = 4
Left = 96
Height = 23
Top = 18
Width = 344
end
object UnitnameEdit: TEdit
TabOrder = 5
Text = 'UnitnameEdit'
TabOrder = 5
Left = 96
Height = 23
Top = 58
Width = 128
end
end

View File

@ -0,0 +1,21 @@
{ This is an automatically generated lazarus resource file }
LazarusResources.Add('TEditVirtualUnitDialog','FORMDATA',[
'TPF0'#22'TEditVirtualUnitDialog'#21'EditVirtualUnitDialog'#7'Caption'#6#21'E'
+'ditVirtualUnitDialog'#12'ClientHeight'#3#131#0#11'ClientWidth'#3#194#1#8'On'
+'Create'#7#27'EditVirtualUnitDialogCreate'#13'PixelsPerInch'#2'Z'#8'Position'
+#7#14'poScreenCenter'#18'HorzScrollBar.Page'#3#195#1#18'VertScrollBar.Page'#3
+#132#0#4'Left'#3'Z'#1#6'Height'#3#131#0#3'Top'#3#254#0#5'Width'#3#194#1#0#7
+'TButton'#8'OkButton'#7'Caption'#6#8'OkButton'#7'OnClick'#7#13'OkButtonClick'
+#8'TabOrder'#2#0#4'Left'#3#200#0#6'Height'#2#25#3'Top'#2'`'#5'Width'#2'e'#0#0
+#7'TButton'#12'CancelButton'#7'Caption'#6#12'CancelButton'#11'ModalResult'#2
+#2#8'TabOrder'#2#1#4'Left'#3'L'#1#6'Height'#2#25#3'Top'#2'`'#5'Width'#2'e'#0
+#0#6'TLabel'#13'FilenameLabel'#7'Caption'#6#13'FilenameLabel'#4'Left'#2#8#6
+'Height'#2#17#3'Top'#2#24#5'Width'#2'Y'#0#0#6'TLabel'#13'UnitnameLabel'#7'Ca'
+'ption'#6#13'UnitnameLabel'#4'Left'#2#8#6'Height'#2#17#3'Top'#2'@'#5'Width'#2
+'Y'#0#0#5'TEdit'#12'FilenameEdit'#7'Anchors'#11#5'akTop'#6'akLeft'#7'akRight'
+#0#8'TabOrder'#2#4#4'Text'#6#12'FilenameEdit'#8'TabOrder'#2#4#4'Left'#2'`'#6
+'Height'#2#23#3'Top'#2#18#5'Width'#3'X'#1#0#0#5'TEdit'#12'UnitnameEdit'#8'Ta'
+'bOrder'#2#5#4'Text'#6#12'UnitnameEdit'#8'TabOrder'#2#5#4'Left'#2'`'#6'Heigh'
+'t'#2#23#3'Top'#2':'#5'Width'#3#128#0#0#0#0
]);

View File

@ -0,0 +1,158 @@
{ $Id$ }
{
/***************************************************************************
pkgvirtualuniteditor.pas
------------------------
***************************************************************************/
***************************************************************************
* *
* This source is free software; you can redistribute it and/or modify *
* it under the terms of the GNU General Public License as published by *
* the Free Software Foundation; either version 2 of the License, or *
* (at your option) any later version. *
* *
* This code is distributed in the hope that it will be useful, but *
* WITHOUT ANY WARRANTY; without even the implied warranty of *
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *
* General Public License for more details. *
* *
* A copy of the GNU General Public License is available on the World *
* Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also *
* obtain it by writing to the Free Software Foundation, *
* Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *
* *
***************************************************************************
Author: Mattias Gaertner
Abstract:
TEditVirtualUnitDialog is a dialog to edit the properties of a virtual unit.
}
unit PkgVirtualUnitEditor;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, Buttons,
StdCtrls, FileCtrl, PackageDefs;
type
TEditVirtualUnitDialog = class(TForm)
FilenameEdit: TEdit;
UnitnameEdit: TEdit;
FilenameLabel: TLabel;
UnitnameLabel: TLabel;
OkButton: TButton;
CancelButton: TButton;
procedure EditVirtualUnitDialogCreate(Sender: TObject);
procedure OkButtonClick(Sender: TObject);
private
FPkgFile: TPkgFile;
procedure SetPkgFile(const AValue: TPkgFile);
public
property PkgFile: TPkgFile read FPkgFile write SetPkgFile;
end;
function ShowEditVirtualPackageDialog(PkgFile: TPkgFile): TModalResult;
implementation
function ShowEditVirtualPackageDialog(PkgFile: TPkgFile): TModalResult;
var
EditVirtualUnitDialog: TEditVirtualUnitDialog;
begin
EditVirtualUnitDialog:=TEditVirtualUnitDialog.Create(nil);
try
EditVirtualUnitDialog.PkgFile:=PkgFile;
Result:=EditVirtualUnitDialog.ShowModal;
finally
EditVirtualUnitDialog.Free;
end;
end;
{ TEditVirtualUnitDialog }
procedure TEditVirtualUnitDialog.EditVirtualUnitDialogCreate(Sender: TObject);
begin
Caption:='Edit virtual unit';
OkButton.Caption:='Ok';
CancelButton.Caption:='Cancel';
FilenameLabel.Caption:='Filename:';
UnitnameLabel.Caption:='Unitname:';
UnitnameEdit.Hint:='The unitname is used when the IDE extends uses clauses.';
UnitnameEdit.ShowHint:=true;
end;
procedure TEditVirtualUnitDialog.OkButtonClick(Sender: TObject);
var
NewFilename: String;
NewUnitName: String;
NewFilenameOnly: String;
LazPackage: TLazPackage;
ConflictUnit: TPkgFile;
begin
NewFilename:=FilenameEdit.Text;
NewUnitName:=UnitnameEdit.Text;
if not FilenameIsPascalUnit(NewFilename) then begin
MessageDlg('Invalid unit filename',
'A pascal unit must have the extension .pp or .pas',
mtError,[mbCancel],0);
exit;
end;
NewFilenameOnly:=ExtractFilenameOnly(NewFilename);
if CompareText(NewUnitName,NewFilenameOnly)<>0 then begin
MessageDlg('Invalid unitname',
'Unitname and Filename do not match.'#13
+'Example: unit1.pas and Unit1',
mtError,[mbCancel],0);
exit;
end;
if (NewUnitName='') or (not IsValidIdent(NewUnitName)) then begin
MessageDlg('Invalid unitname',
'The unitname is not a valid pascal identifier.',
mtError,[mbCancel],0);
exit;
end;
LazPackage:=PkgFile.LazPackage;
if LazPackage<>nil then begin
ConflictUnit:=LazPackage.FindUnit(NewUnitName,true,PkgFile);
if ConflictUnit<>nil then begin
MessageDlg('Conflict found',
'There is already an unit with this name.'#13
+'File: '+ConflictUnit.Filename,
mtError,[mbCancel],0);
exit;
end;
end;
// commit
if (PkgFile.Filename<>NewFilename)
or (PkgFile.Unitname<>NewUnitName) then begin
PkgFile.Filename:=NewFilename;
PkgFile.Unitname:=NewUnitName;
if LazPackage<>nil then LazPackage.Modified:=true;
end;
ModalResult:=mrOk;
end;
procedure TEditVirtualUnitDialog.SetPkgFile(const AValue: TPkgFile);
begin
if FPkgFile=AValue then exit;
FPkgFile:=AValue;
if PkgFile<>nil then begin
FilenameEdit.Text:=PkgFile.Filename;
UnitnameEdit.Text:=PkgFile.UnitName;
end;
end;
initialization
{$I pkgvirtualuniteditor.lrs}
end.