mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-13 10:09:25 +02:00
implemented saving package
git-svn-id: trunk@4026 -
This commit is contained in:
mattias
parent
7a541bcc8f
commit
1f9e1181b0
@ -369,6 +369,9 @@ type
|
||||
const AClassName, OldVariableName, NewVarName,
|
||||
VarType: shortstring): boolean;
|
||||
|
||||
// register
|
||||
function HasInterfaceRegisterProc(Code: TCodeBuffer;
|
||||
var HasRegisterProc: boolean): boolean;
|
||||
|
||||
// - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||||
|
||||
@ -1911,6 +1914,21 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
function TCodeToolManager.HasInterfaceRegisterProc(Code: TCodeBuffer;
|
||||
var HasRegisterProc: boolean): boolean;
|
||||
begin
|
||||
Result:=false;
|
||||
{$IFDEF CTDEBUG}
|
||||
writeln('TCodeToolManager.HasInterfaceRegisterProc A ',Code.Filename);
|
||||
{$ENDIF}
|
||||
if not InitCurCodeTool(Code) then exit;
|
||||
try
|
||||
Result:=FCurCodeTool.HasInterfaceRegisterProc(HasRegisterProc);
|
||||
except
|
||||
on e: Exception do Result:=HandleException(e);
|
||||
end;
|
||||
end;
|
||||
|
||||
function TCodeToolManager.DoOnFindUsedUnit(SrcTool: TFindDeclarationTool;
|
||||
const TheUnitName, TheUnitInFilename: string): TCodeBuffer;
|
||||
begin
|
||||
|
||||
@ -184,6 +184,9 @@ type
|
||||
function StringConstToFormatString(
|
||||
const StartCursorPos, EndCursorPos: TCodeXYPosition;
|
||||
var FormatStringConstant,FormatParameters: string): boolean;
|
||||
|
||||
// register procedure
|
||||
function HasInterfaceRegisterProc(var HasRegisterProc: boolean): boolean;
|
||||
end;
|
||||
|
||||
|
||||
@ -1659,6 +1662,34 @@ begin
|
||||
Result:=FormatStringConstant<>'';
|
||||
end;
|
||||
|
||||
function TStandardCodeTool.HasInterfaceRegisterProc(var HasRegisterProc: boolean
|
||||
): boolean;
|
||||
var
|
||||
InterfaceNode: TCodeTreeNode;
|
||||
ANode: TCodeTreeNode;
|
||||
begin
|
||||
Result:=false;
|
||||
HasRegisterProc:=false;
|
||||
BuildTree(true);
|
||||
InterfaceNode:=FindInterfaceNode;
|
||||
if InterfaceNode=nil then exit;
|
||||
ANode:=InterfaceNode.FirstChild;
|
||||
while ANode<>nil do begin
|
||||
if (ANode.Desc=ctnProcedure) then begin
|
||||
MoveCursorToNodeStart(ANode);
|
||||
if ReadNextUpAtomIs('PROCEDURE')
|
||||
and ReadNextUpAtomIs('REGISTER')
|
||||
and ReadNextAtomIsChar(';')
|
||||
then begin
|
||||
HasRegisterProc:=true;
|
||||
break;
|
||||
end;
|
||||
end;
|
||||
ANode:=ANode.NextBrother;
|
||||
end;
|
||||
Result:=true;
|
||||
end;
|
||||
|
||||
function TStandardCodeTool.GatherResourceStringsWithValue(
|
||||
const CursorPos: TCodeXYPosition; const StringValue: string;
|
||||
PositionList: TCodeXYPositions): boolean;
|
||||
|
||||
@ -221,6 +221,9 @@ var i, j, FilenameEndPos: integer;
|
||||
MsgTypeName, Filename, Msg: string;
|
||||
MsgType: TErrorType;
|
||||
SkipMessage: boolean;
|
||||
CurCompHistory: string;
|
||||
CurFilenameLen: Integer;
|
||||
CurCompHistLen: Integer;
|
||||
begin
|
||||
Result:=false;
|
||||
if ('Compiling '=copy(s,1,length('Compiling '))) then begin
|
||||
@ -339,6 +342,7 @@ begin
|
||||
end;
|
||||
end else
|
||||
SkipMessage:=false;
|
||||
|
||||
// beautify compiler message
|
||||
|
||||
// the compiler always gives short filenames, even if it went into a
|
||||
@ -354,11 +358,15 @@ begin
|
||||
// -> prepend this subdirectory
|
||||
i:=fCompilingHistory.Count-1;
|
||||
while (i>=0) do begin
|
||||
j:=length(fCompilingHistory[i])-length(Filename);
|
||||
if CompareFilenames(
|
||||
copy(fCompilingHistory[i],j+1,length(Filename)),Filename)=0 then
|
||||
CurCompHistory:=fCompilingHistory[i];
|
||||
CurCompHistLen:=length(CurCompHistory);
|
||||
CurFilenameLen:=length(Filename);
|
||||
j:=CurCompHistLen-CurFilenameLen;
|
||||
if (j>1) and (CurCompHistory[j]=PathDelim)
|
||||
and (CompareFilenames(
|
||||
copy(CurCompHistory,j+1,CurFilenameLen),Filename)=0) then
|
||||
begin
|
||||
Msg:=copy(fCompilingHistory[i],1,j)+Msg;
|
||||
Msg:=copy(CurCompHistory,1,j)+Msg;
|
||||
inc(FilenameEndPos,j);
|
||||
break;
|
||||
end;
|
||||
|
||||
@ -1133,11 +1133,13 @@ type
|
||||
function GetLastSubChild: TTreeNode;
|
||||
function GetNext: TTreeNode;
|
||||
function GetNextChild(AValue: TTreeNode): TTreeNode;
|
||||
function GetNextExpanded: TTreeNode;
|
||||
function GetNextMultiSelected: TTreeNode;
|
||||
function GetNextSibling: TTreeNode;
|
||||
function GetNextVisible: TTreeNode;
|
||||
function GetPrev: TTreeNode;
|
||||
function GetPrevChild(AValue: TTreeNode): TTreeNode;
|
||||
function GetPrevExpanded: TTreeNode;
|
||||
function GetPrevMultiSelected: TTreeNode;
|
||||
function GetPrevSibling: TTreeNode;
|
||||
function GetPrevVisible: TTreeNode;
|
||||
@ -1353,6 +1355,7 @@ type
|
||||
FOnExpanding: TTVExpandingEvent;
|
||||
FOnGetImageIndex: TTVExpandedEvent;
|
||||
FOnGetSelectedIndex: TTVExpandedEvent;
|
||||
FOnSelectionChanged: TNotifyEvent;
|
||||
FOptions: TTreeViewOptions;
|
||||
FRClickNode: TTreeNode;
|
||||
//FSaveIndex: Integer;
|
||||
@ -1449,26 +1452,16 @@ type
|
||||
//procedure CMSysColorChange(var Message: TMessage); message CM_SYSCOLORCHANGE;
|
||||
protected
|
||||
FChangeTimer: TTimer;
|
||||
function CanEdit(Node: TTreeNode): Boolean; dynamic;
|
||||
//procedure Edit(const Item: TTVItem); dynamic;
|
||||
function CanChange(Node: TTreeNode): Boolean; dynamic;
|
||||
function CanCollapse(Node: TTreeNode): Boolean; dynamic;
|
||||
function CanEdit(Node: TTreeNode): Boolean; dynamic;
|
||||
function CanExpand(Node: TTreeNode): Boolean; dynamic;
|
||||
procedure Change(Node: TTreeNode); dynamic;
|
||||
procedure Collapse(Node: TTreeNode); dynamic;
|
||||
function CreateNode: TTreeNode; virtual;
|
||||
procedure CreateParams(var Params: TCreateParams); override;
|
||||
procedure CreateWnd; override;
|
||||
function CustomDraw(const ARect: TRect;
|
||||
Stage: TCustomDrawStage): Boolean; virtual;
|
||||
function CustomDrawItem(Node: TTreeNode; State: TCustomDrawState;
|
||||
Stage: TCustomDrawStage; var PaintImages: Boolean): Boolean; virtual;
|
||||
procedure Delete(Node: TTreeNode); dynamic;
|
||||
procedure DestroyWnd; override;
|
||||
procedure DoEndDrag(Target: TObject; X, Y: Integer); override;
|
||||
procedure DoPaint; virtual;
|
||||
procedure DoPaintNode(Node: TTreeNode); virtual;
|
||||
procedure DoStartDrag(var DragObject: TDragObject); override;
|
||||
//procedure Edit(const Item: TTVItem); dynamic;
|
||||
function GetDragImages: TDragImageList; //override;
|
||||
function GetMaxLvl: integer;
|
||||
function GetMaxScrollLeft: integer;
|
||||
@ -1480,11 +1473,22 @@ type
|
||||
function IsCustomDrawn(Target: TCustomDrawTarget;
|
||||
Stage: TCustomDrawStage): Boolean;
|
||||
function IsNodeVisible(ANode: TTreeNode): Boolean;
|
||||
procedure Change(Node: TTreeNode); dynamic;
|
||||
procedure Collapse(Node: TTreeNode); dynamic;
|
||||
procedure CreateParams(var Params: TCreateParams); override;
|
||||
procedure CreateWnd; override;
|
||||
procedure Delete(Node: TTreeNode); dynamic;
|
||||
procedure DestroyWnd; override;
|
||||
procedure DoEndDrag(Target: TObject; X, Y: Integer); override;
|
||||
procedure DoPaint; virtual;
|
||||
procedure DoPaintNode(Node: TTreeNode); virtual;
|
||||
procedure DoStartDrag(var DragObject: TDragObject); override;
|
||||
procedure EndEditing;
|
||||
procedure EnsureNodeIsVisible(ANode: TTreeNode);
|
||||
procedure Expand(Node: TTreeNode); dynamic;
|
||||
procedure GetImageIndex(Node: TTreeNode); virtual;
|
||||
procedure GetSelectedIndex(Node: TTreeNode); virtual;
|
||||
procedure KeyDown(var Key : Word; Shift : TShiftState); override;
|
||||
procedure Loaded; override;
|
||||
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y:
|
||||
Integer); override;
|
||||
@ -1522,14 +1526,16 @@ type
|
||||
property OnCustomDrawItem: TTVCustomDrawItemEvent
|
||||
read FOnCustomDrawItem write FOnCustomDrawItem;
|
||||
property OnDeletion: TTVExpandedEvent read FOnDeletion write FOnDeletion;
|
||||
property OnEditing: TTVEditingEvent read FOnEditing write FOnEditing;
|
||||
property OnEdited: TTVEditedEvent read FOnEdited write FOnEdited;
|
||||
property OnEditing: TTVEditingEvent read FOnEditing write FOnEditing;
|
||||
property OnExpanded: TTVExpandedEvent read FOnExpanded write FOnExpanded;
|
||||
property OnExpanding: TTVExpandingEvent read FOnExpanding write FOnExpanding;
|
||||
property OnGetImageIndex: TTVExpandedEvent
|
||||
read FOnGetImageIndex write FOnGetImageIndex;
|
||||
property OnGetSelectedIndex: TTVExpandedEvent
|
||||
read FOnGetSelectedIndex write FOnGetSelectedIndex;
|
||||
property OnSelectionChanged: TNotifyEvent
|
||||
read FOnSelectionChanged write FOnSelectionChanged;
|
||||
property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
|
||||
property RightClickSelect: Boolean
|
||||
read GetRightClickSelect write SetRightClickSelect default False;
|
||||
@ -1660,6 +1666,7 @@ type
|
||||
property OnMouseDown;
|
||||
property OnMouseMove;
|
||||
property OnMouseUp;
|
||||
property OnSelectionChanged;
|
||||
property Options;
|
||||
//property OnStartDock;
|
||||
property OnStartDrag;
|
||||
@ -1735,6 +1742,9 @@ end.
|
||||
{ =============================================================================
|
||||
|
||||
$Log$
|
||||
Revision 1.70 2003/04/08 16:56:55 mattias
|
||||
implemented saving package
|
||||
|
||||
Revision 1.69 2003/04/04 16:35:24 mattias
|
||||
started package registration
|
||||
|
||||
|
||||
@ -632,13 +632,38 @@ begin
|
||||
end;
|
||||
|
||||
function TTreeNode.GetPrevVisible: TTreeNode;
|
||||
var
|
||||
ANode: TTreeNode;
|
||||
begin
|
||||
Result:=GetPrev;
|
||||
Result:=GetPrevSibling;
|
||||
if Result <> nil then begin
|
||||
while Result.Expanded do begin
|
||||
ANode:=Result.GetLastChild;
|
||||
if ANode=nil then break;
|
||||
Result:=ANode;
|
||||
end;
|
||||
end else
|
||||
Result := Parent;
|
||||
if (Result<>nil) and (TreeView<>nil) and (not TreeView.IsNodeVisible(Result))
|
||||
then
|
||||
Result:=nil;
|
||||
end;
|
||||
|
||||
function TTreeNode.GetPrevExpanded: TTreeNode;
|
||||
var
|
||||
ANode: TTreeNode;
|
||||
begin
|
||||
Result:=GetPrevSibling;
|
||||
if Result <> nil then begin
|
||||
while Result.Expanded do begin
|
||||
ANode:=Result.GetLastChild;
|
||||
if ANode=nil then break;
|
||||
Result:=ANode;
|
||||
end;
|
||||
end else
|
||||
Result := Parent;
|
||||
end;
|
||||
|
||||
function TTreeNode.GetNextChild(AValue: TTreeNode): TTreeNode;
|
||||
begin
|
||||
if AValue <> nil then
|
||||
@ -647,6 +672,18 @@ begin
|
||||
Result := nil;
|
||||
end;
|
||||
|
||||
function TTreeNode.GetNextExpanded: TTreeNode;
|
||||
begin
|
||||
if Expanded and (GetFirstChild<>nil) then
|
||||
Result:=GetFirstChild
|
||||
else begin
|
||||
Result:=Self;
|
||||
while (Result<>nil) and (Result.GetNextSibling=nil) do
|
||||
Result:=Result.Parent;
|
||||
if Result<>nil then Result:=Result.GetNextSibling;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TTreeNode.GetNextMultiSelected: TTreeNode;
|
||||
begin
|
||||
Result:=FNextMultiSelected;
|
||||
@ -3215,6 +3252,33 @@ begin
|
||||
//' Node.Text=',ANode.Text,' Visible=',Result);
|
||||
end;
|
||||
|
||||
procedure TCustomTreeView.KeyDown(var Key: Word; Shift: TShiftState);
|
||||
begin
|
||||
inherited KeyDown(Key, Shift);
|
||||
|
||||
case Key of
|
||||
|
||||
VK_Down:
|
||||
if (Selected<>nil) and (Selected.GetNextExpanded<>nil) then begin
|
||||
Selected:=Selected.GetNextExpanded;
|
||||
Key:=VK_UNKNOWN;
|
||||
end;
|
||||
|
||||
VK_Up:
|
||||
if (Selected<>nil) and (Selected.GetPrevExpanded<>nil) then begin
|
||||
Selected:=Selected.GetPrevExpanded;
|
||||
Key:=VK_UNKNOWN;
|
||||
end;
|
||||
|
||||
VK_Left:
|
||||
if (Selected<>nil) then Selected.Expanded:=false;
|
||||
|
||||
VK_Right:
|
||||
if (Selected<>nil) then Selected.Expanded:=true;
|
||||
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TCustomTreeView.Loaded;
|
||||
begin
|
||||
inherited Loaded;
|
||||
@ -3345,6 +3409,7 @@ begin
|
||||
Value.Selected := True;
|
||||
Value.MakeVisible;
|
||||
end;
|
||||
if Assigned(OnSelectionChanged) then OnSelectionChanged(Self);
|
||||
Invalidate;
|
||||
end;
|
||||
|
||||
|
||||
@ -62,6 +62,9 @@ type
|
||||
PkgFileFlags: TPkgFileFlags;
|
||||
UsedUnitname: string;
|
||||
end;
|
||||
|
||||
TOnGetUnitRegisterInfo = procedure(Sender: TObject; const AFilename: string;
|
||||
var TheUnitName: string; var HasRegisterProc: boolean) of object;
|
||||
|
||||
TAddToPackageDlg = class(TForm)
|
||||
// notebook
|
||||
@ -73,6 +76,10 @@ type
|
||||
AddUnitFilenameLabel: TLabel;
|
||||
AddUnitFilenameEdit: TEdit;
|
||||
AddUnitFileBrowseButton: TButton;
|
||||
AddUnitSrcNameLabel: TLabel;
|
||||
AddUnitSrcNameEdit: TEdit;
|
||||
AddUnitHasRegisterCheckBox: TCheckBox;
|
||||
AddUnitUpdateButton: TButton;
|
||||
AddUnitButton: TButton;
|
||||
CancelAddUnitButton: TButton;
|
||||
// new component page
|
||||
@ -99,10 +106,10 @@ type
|
||||
DependMaxVersionEdit: TEdit;
|
||||
NewDependButton: TButton;
|
||||
CancelDependButton: TButton;
|
||||
procedure AddToPackageDlgResize(Sender: TObject);
|
||||
procedure AddUnitButtonClick(Sender: TObject);
|
||||
procedure AddUnitFileBrowseButtonClick(Sender: TObject);
|
||||
procedure AddUnitPageResize(Sender: TObject);
|
||||
procedure AddUnitUpdateButtonClick(Sender: TObject);
|
||||
procedure AncestorComboBoxCloseUp(Sender: TObject);
|
||||
procedure AncestorShowAllCheckBoxClick(Sender: TObject);
|
||||
procedure CancelAddUnitButtonClick(Sender: TObject);
|
||||
@ -118,6 +125,7 @@ type
|
||||
fLastNewComponentClassName: string;
|
||||
FLazPackage: TLazPackage;
|
||||
FOnGetIDEFileInfo: TGetIDEFileStateEvent;
|
||||
FOnGetUnitRegisterInfo: TOnGetUnitRegisterInfo;
|
||||
fPkgComponents: TAVLTree;// tree of TPkgComponent
|
||||
fPackages: TAVLTree;// tree of TLazPackage or TPackageLink
|
||||
procedure SetLazPackage(const AValue: TLazPackage);
|
||||
@ -128,6 +136,7 @@ type
|
||||
procedure AutoCompleteNewComponentUnitName;
|
||||
function CheckUnitFilename(AddFileType: TAddToPkgType;
|
||||
var AFilename: string): boolean;
|
||||
procedure UpdateAddUnitInfo;
|
||||
public
|
||||
Params: TAddToPkgResult;
|
||||
constructor Create(TheOwner: TComponent); override;
|
||||
@ -139,23 +148,28 @@ type
|
||||
property LazPackage: TLazPackage read FLazPackage write SetLazPackage;
|
||||
property OnGetIDEFileInfo: TGetIDEFileStateEvent read FOnGetIDEFileInfo
|
||||
write FOnGetIDEFileInfo;
|
||||
property OnGetUnitRegisterInfo: TOnGetUnitRegisterInfo
|
||||
read FOnGetUnitRegisterInfo write FOnGetUnitRegisterInfo;
|
||||
end;
|
||||
|
||||
function ShowAddToPackageDlg(Pkg: TLazPackage; var Params: TAddToPkgResult;
|
||||
OnGetIDEFileInfo: TGetIDEFileStateEvent): TModalResult;
|
||||
OnGetIDEFileInfo: TGetIDEFileStateEvent;
|
||||
OnGetUnitRegisterInfo: TOnGetUnitRegisterInfo): TModalResult;
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
|
||||
function ShowAddToPackageDlg(Pkg: TLazPackage; var Params: TAddToPkgResult;
|
||||
OnGetIDEFileInfo: TGetIDEFileStateEvent): TModalResult;
|
||||
OnGetIDEFileInfo: TGetIDEFileStateEvent;
|
||||
OnGetUnitRegisterInfo: TOnGetUnitRegisterInfo): TModalResult;
|
||||
var
|
||||
AddDlg: TAddToPackageDlg;
|
||||
begin
|
||||
AddDlg:=TAddToPackageDlg.Create(Application);
|
||||
AddDlg.LazPackage:=Pkg;
|
||||
AddDlg.OnGetIDEFileInfo:=OnGetIDEFileInfo;
|
||||
AddDlg.OnGetUnitRegisterInfo:=OnGetUnitRegisterInfo;
|
||||
Result:=AddDlg.ShowModal;
|
||||
if Result=mrOk then
|
||||
Params:=AddDlg.Params;
|
||||
@ -165,20 +179,28 @@ end;
|
||||
|
||||
{ TAddToPackageDlg }
|
||||
|
||||
procedure TAddToPackageDlg.AddToPackageDlgResize(Sender: TObject);
|
||||
begin
|
||||
|
||||
end;
|
||||
|
||||
procedure TAddToPackageDlg.AddUnitButtonClick(Sender: TObject);
|
||||
begin
|
||||
Params.AddType:=d2ptUnit;
|
||||
|
||||
Params.UnitFilename:=AddUnitFilenameEdit.Text;
|
||||
if not CheckUnitFilename(Params.AddType,Params.UnitFilename) then exit;
|
||||
Params.UnitName:=ExtractFileNameOnly(Params.UnitFilename);
|
||||
Params.UnitName:=AddUnitSrcNameEdit.Text;
|
||||
Params.FileType:=pftUnit;
|
||||
Params.PkgFileFlags:=[];
|
||||
if AddUnitHasRegisterCheckBox.Checked then
|
||||
Include(Params.PkgFileFlags,pffHasRegisterProc);
|
||||
|
||||
// check filename
|
||||
if not CheckUnitFilename(Params.AddType,Params.UnitFilename) then exit;
|
||||
|
||||
// check unitname
|
||||
if AnsiCompareText(Params.UnitName,ExtractFileNameOnly(Params.UnitFilename))<>0
|
||||
then begin
|
||||
MessageDlg('Invalid Unit Name',
|
||||
'The unit name "'+Params.UnitName+'" and filename differ.',
|
||||
mtError,[mbCancel],0);
|
||||
exit;
|
||||
end;
|
||||
|
||||
// add it ...
|
||||
ModalResult:=mrOk;
|
||||
@ -199,6 +221,7 @@ begin
|
||||
if FileExists(AFilename) then begin
|
||||
LazPackage.ShortenFilename(AFilename);
|
||||
AddUnitFilenameEdit.Text:=AFilename;
|
||||
UpdateAddUnitInfo;
|
||||
end;
|
||||
end;
|
||||
InputHistories.StoreFileDialogSettings(OpenDialog);
|
||||
@ -225,7 +248,24 @@ begin
|
||||
with AddUnitFileBrowseButton do
|
||||
SetBounds(x,y,AddUnitFilenameEdit.Height,AddUnitFilenameEdit.Height);
|
||||
x:=5;
|
||||
y:=AddUnitFilenameEdit.Top+AddUnitFilenameEdit.Height+15;
|
||||
y:=AddUnitFilenameEdit.Top+AddUnitFilenameEdit.Height+5;
|
||||
|
||||
with AddUnitSrcNameLabel do
|
||||
SetBounds(x,y+2,100,Height);
|
||||
inc(x,AddUnitSrcNameLabel.Width+5);
|
||||
|
||||
with AddUnitSrcNameEdit do
|
||||
SetBounds(x,y,100,Height);
|
||||
inc(y,AddUnitSrcNameEdit.Height+5);
|
||||
x:=5;
|
||||
|
||||
with AddUnitHasRegisterCheckBox do
|
||||
SetBounds(x,y,200,Height);
|
||||
inc(y,AddUnitHasRegisterCheckBox.Height+5);
|
||||
|
||||
with AddUnitUpdateButton do
|
||||
SetBounds(x,y,300,Height);
|
||||
inc(y,AddUnitUpdateButton.Height+25);
|
||||
|
||||
with AddUnitButton do
|
||||
SetBounds(x,y,80,Height);
|
||||
@ -235,6 +275,11 @@ begin
|
||||
SetBounds(x,y,80,Height);
|
||||
end;
|
||||
|
||||
procedure TAddToPackageDlg.AddUnitUpdateButtonClick(Sender: TObject);
|
||||
begin
|
||||
UpdateAddUnitInfo;
|
||||
end;
|
||||
|
||||
procedure TAddToPackageDlg.AncestorComboBoxCloseUp(Sender: TObject);
|
||||
begin
|
||||
if fLastNewComponentAncestorType<>AncestorComboBox.Text then
|
||||
@ -623,6 +668,35 @@ begin
|
||||
OnClick:=@AddUnitFileBrowseButtonClick;
|
||||
end;
|
||||
|
||||
AddUnitSrcNameLabel:=TLabel.Create(Self);
|
||||
with AddUnitSrcNameLabel do begin
|
||||
Name:='AddUnitSrcNameLabel';
|
||||
Parent:=AddUnitPage;
|
||||
Caption:='Unit Name: ';
|
||||
end;
|
||||
|
||||
AddUnitSrcNameEdit:=TEdit.Create(Self);
|
||||
with AddUnitSrcNameEdit do begin
|
||||
Name:='AddUnitSrcNameEdit';
|
||||
Parent:=AddUnitPage;
|
||||
Text:='';
|
||||
end;
|
||||
|
||||
AddUnitHasRegisterCheckBox:=TCheckBox.Create(Self);
|
||||
with AddUnitHasRegisterCheckBox do begin
|
||||
Name:='AddUnitHasRegisterCheckBox';
|
||||
Parent:=AddUnitPage;
|
||||
Caption:='Has Register procedure';
|
||||
end;
|
||||
|
||||
AddUnitUpdateButton:=TButton.Create(Self);
|
||||
with AddUnitUpdateButton do begin
|
||||
Name:='AddUnitUpdateButton';
|
||||
Parent:=AddUnitPage;
|
||||
Caption:='Update Unit Name and Has Register procedure';
|
||||
OnClick:=@AddUnitUpdateButtonClick;
|
||||
end;
|
||||
|
||||
AddUnitButton:=TButton.Create(Self);
|
||||
with AddUnitButton do begin
|
||||
Name:='AddUnitButton';
|
||||
@ -986,6 +1060,19 @@ begin
|
||||
Result:=true;
|
||||
end;
|
||||
|
||||
procedure TAddToPackageDlg.UpdateAddUnitInfo;
|
||||
var
|
||||
AnUnitName: string;
|
||||
HasRegisterProc: boolean;
|
||||
begin
|
||||
if Assigned(OnGetUnitRegisterInfo) then begin
|
||||
OnGetUnitRegisterInfo(Self,AddUnitFilenameEdit.Text,
|
||||
AnUnitName,HasRegisterProc);
|
||||
AddUnitSrcNameEdit.Text:=AnUnitName;
|
||||
AddUnitHasRegisterCheckBox.Checked:=HasRegisterProc;
|
||||
end;
|
||||
end;
|
||||
|
||||
constructor TAddToPackageDlg.Create(TheOwner: TComponent);
|
||||
begin
|
||||
inherited Create(TheOwner);
|
||||
@ -994,7 +1081,6 @@ begin
|
||||
Position:=poScreenCenter;
|
||||
IDEDialogLayoutList.ApplyLayout(Self,500,300);
|
||||
SetupComponents;
|
||||
OnResize:=@AddToPackageDlgResize;
|
||||
end;
|
||||
|
||||
destructor TAddToPackageDlg.Destroy;
|
||||
|
||||
@ -47,6 +47,11 @@ uses
|
||||
Classes, SysUtils, Forms, PackageDefs;
|
||||
|
||||
type
|
||||
TPkgSaveFlag = (
|
||||
psfSaveAs
|
||||
);
|
||||
TPkgSaveFlags = set of TPkgSaveFlag;
|
||||
|
||||
TBasePkgManager = class(TComponent)
|
||||
public
|
||||
procedure ConnectMainBarEvents; virtual; abstract;
|
||||
@ -59,8 +64,10 @@ type
|
||||
function DoNewPackage: TModalResult; virtual; abstract;
|
||||
function DoShowOpenInstalledPckDlg: TModalResult; virtual; abstract;
|
||||
function DoOpenPackage(APackage: TLazPackage): TModalResult; virtual; abstract;
|
||||
function DoSavePackage(APackage: TLazPackage;
|
||||
Flags: TPkgSaveFlags): TModalResult; virtual; abstract;
|
||||
end;
|
||||
|
||||
|
||||
var
|
||||
PkgBoss: TBasePkgManager;
|
||||
|
||||
|
||||
@ -405,7 +405,6 @@ function CompareLazPackageID(Data1, Data2: Pointer): integer;
|
||||
function CompareNameWithPackage(Key, Data: Pointer): integer;
|
||||
function CompareLazPackageName(Data1, Data2: Pointer): integer;
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
|
||||
@ -648,6 +647,7 @@ end;
|
||||
function TPkgFile.GetResolvedFilename: string;
|
||||
begin
|
||||
Result:=ReadAllLinks(Filename,false);
|
||||
if Result='' then Result:=Filename;
|
||||
end;
|
||||
|
||||
{ TPkgDependency }
|
||||
@ -1083,6 +1083,7 @@ begin
|
||||
FUsedPkgs:=TList.Create;
|
||||
FInstalled:=pitNope;
|
||||
FAutoInstall:=pitNope;
|
||||
FFlags:=[lpfAutoIncrementVersionOnBuild,lpfAutoUpdate];
|
||||
end;
|
||||
|
||||
destructor TLazPackage.Destroy;
|
||||
@ -1192,6 +1193,7 @@ begin
|
||||
if FileVersion=1 then ;
|
||||
Clear;
|
||||
LockModified;
|
||||
FName:=XMLConfig.GetValue(Path+'Name/Value','');
|
||||
FAuthor:=XMLConfig.GetValue(Path+'Author/Value','');
|
||||
FCompilerOptions.LoadFromXMLConfig(XMLConfig,Path+'CompilerOptions/');
|
||||
FDescription:=XMLConfig.GetValue(Path+'Description','');
|
||||
@ -1243,6 +1245,7 @@ procedure TLazPackage.SaveToXMLConfig(XMLConfig: TXMLConfig; const Path: string
|
||||
end;
|
||||
|
||||
begin
|
||||
XMLConfig.SetDeleteValue(Path+'Name/Value',FName,'');
|
||||
XMLConfig.SetDeleteValue(Path+'Author/Value',FAuthor,'');
|
||||
FCompilerOptions.SaveToXMLConfig(XMLConfig,Path+'CompilerOptions/');
|
||||
XMLConfig.SetDeleteValue(Path+'Description',FDescription,'');
|
||||
@ -1337,12 +1340,19 @@ var
|
||||
begin
|
||||
Result:=nil;
|
||||
TheFilename:=AFilename;
|
||||
if ResolveLinks then TheFilename:=ReadAllLinks(TheFilename,false);
|
||||
if ResolveLinks then begin
|
||||
TheFilename:=ReadAllLinks(TheFilename,false);
|
||||
if TheFilename='' then TheFilename:=AFilename;
|
||||
end;
|
||||
Cnt:=FileCount;
|
||||
for i:=0 to Cnt-1 do begin
|
||||
if CompareFilenames(Files[i].GetResolvedFilename,TheFilename)=0 then begin
|
||||
Result:=Files[i];
|
||||
exit;
|
||||
if ResolveLinks then begin
|
||||
if CompareFilenames(Files[i].GetResolvedFilename,TheFilename)=0 then begin
|
||||
Result:=Files[i];
|
||||
end;
|
||||
end else begin
|
||||
if CompareFilenames(Files[i].Filename,TheFilename)=0 then
|
||||
Result:=Files[i];
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -70,13 +70,13 @@ type
|
||||
FilesPopupMenu: TPopupMenu;
|
||||
procedure AddBitBtnClick(Sender: TObject);
|
||||
procedure FilePropsGroupBoxResize(Sender: TObject);
|
||||
procedure FilesTreeViewMouseUp(Sender: TOBject; Button: TMouseButton;
|
||||
Shift: TShiftState; X, Y: Integer);
|
||||
procedure FilesPopupMenuPopup(Sender: TObject);
|
||||
procedure FilesTreeViewSelectionChanged(Sender: TObject);
|
||||
procedure OpenFileMenuItemClick(Sender: TObject);
|
||||
procedure PackageEditorFormResize(Sender: TObject);
|
||||
procedure RegisteredListBoxDrawItem(Control: TWinControl; Index: Integer;
|
||||
ARect: TRect; State: TOwnerDrawState);
|
||||
procedure SaveBitBtnClick(Sender: TObject);
|
||||
private
|
||||
FLazPackage: TLazPackage;
|
||||
FilesNode: TTreeNode;
|
||||
@ -91,6 +91,7 @@ type
|
||||
procedure UpdateRequiredPkgs;
|
||||
procedure UpdateSelectedFile;
|
||||
procedure UpdateStatusBar;
|
||||
procedure DoSave;
|
||||
public
|
||||
constructor Create(TheOwner: TComponent); override;
|
||||
destructor Destroy; override;
|
||||
@ -106,8 +107,10 @@ type
|
||||
FItems: TList; // list of TPackageEditorForm
|
||||
FOnCreateNewFile: TOnCreateNewPkgFile;
|
||||
FOnGetIDEFileInfo: TGetIDEFileStateEvent;
|
||||
FOnGetUnitRegisterInfo: TOnGetUnitRegisterInfo;
|
||||
FOnOpenFile: TOnOpenFile;
|
||||
FOnOpenPackage: TOnOpenPackage;
|
||||
FOnSavePackage: TNotifyEvent;
|
||||
function GetEditors(Index: integer): TPackageEditorForm;
|
||||
public
|
||||
constructor Create;
|
||||
@ -123,6 +126,7 @@ type
|
||||
Dependency: TPkgDependency): TModalResult;
|
||||
function CreateNewFile(Sender: TObject;
|
||||
const Params: TAddToPkgResult): TModalResult;
|
||||
procedure SavePackage(APackage: TLazPackage);
|
||||
public
|
||||
property Editors[Index: integer]: TPackageEditorForm read GetEditors;
|
||||
property OnCreateNewFile: TOnCreateNewPkgFile read FOnCreateNewFile
|
||||
@ -131,6 +135,9 @@ type
|
||||
property OnOpenPackage: TOnOpenPackage read FOnOpenPackage write FOnOpenPackage;
|
||||
property OnGetIDEFileInfo: TGetIDEFileStateEvent read FOnGetIDEFileInfo
|
||||
write FOnGetIDEFileInfo;
|
||||
property OnGetUnitRegisterInfo: TOnGetUnitRegisterInfo
|
||||
read FOnGetUnitRegisterInfo write FOnGetUnitRegisterInfo;
|
||||
property OnSavePackage: TNotifyEvent read FOnSavePackage write FOnSavePackage;
|
||||
end;
|
||||
|
||||
var
|
||||
@ -218,6 +225,11 @@ begin
|
||||
FilesPopupMenu.Items.Delete(FilesPopupMenu.Items.Count-1);
|
||||
end;
|
||||
|
||||
procedure TPackageEditorForm.FilesTreeViewSelectionChanged(Sender: TObject);
|
||||
begin
|
||||
UpdateSelectedFile;
|
||||
end;
|
||||
|
||||
procedure TPackageEditorForm.OpenFileMenuItemClick(Sender: TObject);
|
||||
var
|
||||
CurNode: TTreeNode;
|
||||
@ -280,6 +292,11 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TPackageEditorForm.SaveBitBtnClick(Sender: TObject);
|
||||
begin
|
||||
DoSave;
|
||||
end;
|
||||
|
||||
procedure TPackageEditorForm.FilePropsGroupBoxResize(Sender: TObject);
|
||||
var
|
||||
y: Integer;
|
||||
@ -293,17 +310,12 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TPackageEditorForm.FilesTreeViewMouseUp(Sender: TOBject;
|
||||
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
|
||||
begin
|
||||
UpdateSelectedFile;
|
||||
end;
|
||||
|
||||
procedure TPackageEditorForm.AddBitBtnClick(Sender: TObject);
|
||||
var
|
||||
AddParams: TAddToPkgResult;
|
||||
begin
|
||||
if ShowAddToPackageDlg(LazPackage,AddParams,PackageEditors.OnGetIDEFileInfo)
|
||||
if ShowAddToPackageDlg(LazPackage,AddParams,PackageEditors.OnGetIDEFileInfo,
|
||||
PackageEditors.OnGetUnitRegisterInfo)
|
||||
<>mrOk
|
||||
then
|
||||
exit;
|
||||
@ -311,6 +323,7 @@ begin
|
||||
case AddParams.AddType of
|
||||
d2ptUnit:
|
||||
begin
|
||||
// add file
|
||||
with AddParams do
|
||||
LazPackage.AddFile(UnitFilename,UnitName,FileType,PkgFileFlags,cpNormal);
|
||||
UpdateFiles;
|
||||
@ -333,6 +346,7 @@ begin
|
||||
|
||||
d2ptRequiredPkg:
|
||||
begin
|
||||
// add dependency
|
||||
LazPackage.AddRequiredDependency(AddParams.Dependency);
|
||||
UpdateRequiredPkgs;
|
||||
end;
|
||||
@ -398,6 +412,7 @@ begin
|
||||
Name:='SaveBitBtn';
|
||||
Parent:=Self;
|
||||
Caption:='Save';
|
||||
OnClick:=@SaveBitBtnClick;
|
||||
end;
|
||||
|
||||
CompileBitBtn:=TBitBtn.Create(Self);
|
||||
@ -455,7 +470,7 @@ begin
|
||||
RequiredPackagesNode.SelectedIndex:=RequiredPackagesNode.ImageIndex;
|
||||
EndUpdate;
|
||||
PopupMenu:=FilesPopupMenu;
|
||||
OnMouseUp:=@FilesTreeViewMouseUp;
|
||||
OnSelectionChanged:=@FilesTreeViewSelectionChanged;
|
||||
Options:=Options+[tvoRightClickSelect];
|
||||
end;
|
||||
|
||||
@ -645,6 +660,12 @@ begin
|
||||
StatusBar.SimpleText:=StatusText;
|
||||
end;
|
||||
|
||||
procedure TPackageEditorForm.DoSave;
|
||||
begin
|
||||
PackageEditors.SavePackage(LazPackage);
|
||||
UpdateButtons;
|
||||
end;
|
||||
|
||||
constructor TPackageEditorForm.Create(TheOwner: TComponent);
|
||||
begin
|
||||
inherited Create(TheOwner);
|
||||
@ -750,6 +771,11 @@ begin
|
||||
Result:=OnCreateNewFile(Sender,Params);
|
||||
end;
|
||||
|
||||
procedure TPackageEditors.SavePackage(APackage: TLazPackage);
|
||||
begin
|
||||
if Assigned(OnSavePackage) then OnSavePackage(APackage);
|
||||
end;
|
||||
|
||||
initialization
|
||||
PackageEditors:=nil;
|
||||
|
||||
|
||||
@ -97,9 +97,13 @@ type
|
||||
function FindNextSameName(ANode: TAVLTreeNode): TAVLTreeNode;
|
||||
function FindWithDependency(Dependency: TPkgDependency;
|
||||
Flags: TFindPackageFlags): TAVLTreeNode;
|
||||
function FindAPackageWithName(const PkgName: string;
|
||||
IgnorePackage: TLazPackage): TLazPackage;
|
||||
function FindUnit(StartPackage: TLazPackage;
|
||||
const TheUnitName: string; WithRequiredPackages: boolean): TPkgFile;
|
||||
function FindUnitInAllPackages(const TheUnitName: string): TPkgFile;
|
||||
function FindFileInAllPackages(const TheFilename: string;
|
||||
ResolveLinks: boolean): TPkgFile;
|
||||
function CreateUniqueUnitName(const Prefix: string): string;
|
||||
function PackageNameExists(const PkgName: string;
|
||||
IgnorePackage: TLazPackage): boolean;
|
||||
@ -273,6 +277,24 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
function TLazPackageGraph.FindAPackageWithName(const PkgName: string;
|
||||
IgnorePackage: TLazPackage): TLazPackage;
|
||||
var
|
||||
ANode: TAVLTreeNode;
|
||||
begin
|
||||
Result:=nil;
|
||||
ANode:=FindLeftMostByName(PkgName);
|
||||
if ANode<>nil then begin
|
||||
Result:=TLazPackage(ANode.Data);
|
||||
if Result=IgnorePackage then begin
|
||||
Result:=nil;
|
||||
ANode:=FindNextSameName(ANode);
|
||||
if ANode<>nil then
|
||||
Result:=TLazPackage(ANode.Data);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TLazPackageGraph.FindUnit(StartPackage: TLazPackage;
|
||||
const TheUnitName: string; WithRequiredPackages: boolean): TPkgFile;
|
||||
var
|
||||
@ -312,6 +334,20 @@ begin
|
||||
Result:=nil;
|
||||
end;
|
||||
|
||||
function TLazPackageGraph.FindFileInAllPackages(const TheFilename: string;
|
||||
ResolveLinks: boolean): TPkgFile;
|
||||
var
|
||||
Cnt: Integer;
|
||||
i: Integer;
|
||||
begin
|
||||
Cnt:=Count;
|
||||
for i:=0 to Cnt-1 do begin
|
||||
Result:=Packages[i].FindPkgFile(TheFilename,ResolveLinks);
|
||||
if Result<>nil then exit;
|
||||
end;
|
||||
Result:=nil;
|
||||
end;
|
||||
|
||||
function TLazPackageGraph.CreateUniqueUnitName(const Prefix: string): string;
|
||||
var
|
||||
i: Integer;
|
||||
|
||||
@ -44,20 +44,27 @@ uses
|
||||
{$IFDEF IDE_MEM_CHECK}
|
||||
MemCheck,
|
||||
{$ENDIF}
|
||||
Classes, SysUtils, LCLProc, Forms, Controls, CodeToolManager,
|
||||
KeyMapping, EnvironmentOpts, IDEProcs, ProjectDefs, IDEDefs,
|
||||
UComponentManMain, PackageEditor, AddToPackageDlg, PackageDefs, PackageLinks,
|
||||
PackageSystem, ComponentReg, OpenInstalledPkgDlg,
|
||||
Classes, SysUtils, LCLProc, Forms, Controls, FileCtrl, Dialogs,
|
||||
CodeToolManager, CodeCache, Laz_XMLCfg,
|
||||
KeyMapping, EnvironmentOpts, IDEProcs, ProjectDefs, InputHistory,
|
||||
IDEDefs, UComponentManMain, PackageEditor, AddToPackageDlg, PackageDefs,
|
||||
PackageLinks, PackageSystem, ComponentReg, OpenInstalledPkgDlg,
|
||||
BasePkgManager, MainBar;
|
||||
|
||||
type
|
||||
TPkgManager = class(TBasePkgManager)
|
||||
function OnPackageEditorCreateFile(Sender: TObject;
|
||||
const Params: TAddToPkgResult): TModalResult;
|
||||
procedure OnPackageEditorGetUnitRegisterInfo(Sender: TObject;
|
||||
const AFilename: string; var TheUnitName: string;
|
||||
var HasRegisterProc: boolean);
|
||||
function OnPackageEditorOpenPackage(Sender: TObject; APackage: TLazPackage
|
||||
): TModalResult;
|
||||
procedure OnPackageEditorSavePackage(Sender: TObject);
|
||||
procedure mnuConfigCustomCompsClicked(Sender: TObject);
|
||||
procedure mnuOpenInstalledPckClicked(Sender: TObject);
|
||||
private
|
||||
function DoShowSavePackageAsDialog(APackage: TLazPackage): TModalResult;
|
||||
public
|
||||
constructor Create(TheOwner: TComponent); override;
|
||||
destructor Destroy; override;
|
||||
@ -72,6 +79,8 @@ type
|
||||
function DoNewPackage: TModalResult; override;
|
||||
function DoShowOpenInstalledPckDlg: TModalResult; override;
|
||||
function DoOpenPackage(APackage: TLazPackage): TModalResult; override;
|
||||
function DoSavePackage(APackage: TLazPackage;
|
||||
Flags: TPkgSaveFlags): TModalResult; override;
|
||||
end;
|
||||
|
||||
implementation
|
||||
@ -128,12 +137,39 @@ begin
|
||||
[nfOpenInEditor,nfIsNotPartOfProject,nfSave,nfAddToRecent]);
|
||||
end;
|
||||
|
||||
procedure TPkgManager.OnPackageEditorGetUnitRegisterInfo(Sender: TObject;
|
||||
const AFilename: string; var TheUnitName: string; var HasRegisterProc: boolean
|
||||
);
|
||||
var
|
||||
ExpFilename: String;
|
||||
CodeBuffer: TCodeBuffer;
|
||||
begin
|
||||
ExpFilename:=CleanAndExpandFilename(AFilename);
|
||||
// create default values
|
||||
TheUnitName:='';
|
||||
HasRegisterProc:=false;
|
||||
MainIDE.SaveSourceEditorChangesToCodeCache(-1);
|
||||
CodeBuffer:=CodeToolBoss.LoadFile(ExpFilename,true,false);
|
||||
if CodeBuffer<>nil then begin
|
||||
TheUnitName:=CodeToolBoss.GetSourceName(CodeBuffer,false);
|
||||
CodeToolBoss.HasInterfaceRegisterProc(CodeBuffer,HasRegisterProc);
|
||||
end;
|
||||
if TheUnitName='' then
|
||||
TheUnitName:=ExtractFileNameOnly(ExpFilename);
|
||||
end;
|
||||
|
||||
function TPkgManager.OnPackageEditorOpenPackage(Sender: TObject;
|
||||
APackage: TLazPackage): TModalResult;
|
||||
begin
|
||||
Result:=DoOpenPackage(APackage);
|
||||
end;
|
||||
|
||||
procedure TPkgManager.OnPackageEditorSavePackage(Sender: TObject);
|
||||
begin
|
||||
if Sender is TLazPackage then
|
||||
DoSavePackage(TLazPackage(Sender),[]);
|
||||
end;
|
||||
|
||||
procedure TPkgManager.mnuConfigCustomCompsClicked(Sender: TObject);
|
||||
begin
|
||||
ShowConfigureCustomComponents;
|
||||
@ -144,6 +180,141 @@ begin
|
||||
DoShowOpenInstalledPckDlg;
|
||||
end;
|
||||
|
||||
function TPkgManager.DoShowSavePackageAsDialog(
|
||||
APackage: TLazPackage): TModalResult;
|
||||
var
|
||||
OldPkgFilename: String;
|
||||
SaveDialog: TSaveDialog;
|
||||
NewFileName: String;
|
||||
NewPkgName: String;
|
||||
ConflictPkg: TLazPackage;
|
||||
PkgFile: TPkgFile;
|
||||
begin
|
||||
OldPkgFilename:=APackage.Filename;
|
||||
|
||||
SaveDialog:=TSaveDialog.Create(Application);
|
||||
try
|
||||
InputHistories.ApplyFileDialogSettings(SaveDialog);
|
||||
SaveDialog.Title:='Save Package '+APackage.IDAsString+' (*.lpk)';
|
||||
if APackage.HasDirectory then
|
||||
SaveDialog.InitialDir:=APackage.Directory;
|
||||
|
||||
// build a nice package filename suggestion
|
||||
NewFileName:=APackage.Name+'.lpk';
|
||||
SaveDialog.FileName:=NewFileName;
|
||||
|
||||
repeat
|
||||
Result:=mrCancel;
|
||||
|
||||
if not SaveDialog.Execute then begin
|
||||
// user cancels
|
||||
Result:=mrCancel;
|
||||
exit;
|
||||
end;
|
||||
NewFileName:=CleanAndExpandFilename(SaveDialog.Filename);
|
||||
NewPkgName:=ExtractFileNameOnly(NewFilename);
|
||||
|
||||
// check file extension
|
||||
if ExtractFileExt(NewFilename)='' then begin
|
||||
// append extension
|
||||
NewFileName:=NewFileName+'.lpk';
|
||||
end else if ExtractFileExt(NewFilename)<>'.lpk' then begin
|
||||
Result:=MessageDlg('Invalid package file extension',
|
||||
'Packages must have the extension .lpk',
|
||||
mtInformation,[mbRetry,mbAbort],0);
|
||||
if Result=mrAbort then exit;
|
||||
continue; // try again
|
||||
end;
|
||||
|
||||
// check filename
|
||||
if (NewPkgName='') or (not IsValidIdent(NewPkgName)) then begin
|
||||
Result:=MessageDlg('Invalid package name',
|
||||
'The package name "'+NewPkgName+'" is not a valid package name'#13
|
||||
+'Please choose another name (e.g. package1.lpk)',
|
||||
mtInformation,[mbRetry,mbAbort],0);
|
||||
if Result=mrAbort then exit;
|
||||
continue; // try again
|
||||
end;
|
||||
|
||||
// apply naming conventions
|
||||
if EnvironmentOptions.PascalFileAutoLowerCase then
|
||||
NewFileName:=ExtractFilePath(NewFilename)
|
||||
+lowercase(ExtractFileName(NewFilename));
|
||||
|
||||
// check package name conflicts
|
||||
ConflictPkg:=PackageGraph.FindAPackageWithName(NewPkgName,APackage);
|
||||
if ConflictPkg<>nil then begin
|
||||
Result:=MessageDlg('Package name already exists',
|
||||
'The package name "'+NewPkgName+'" already exists.'#13
|
||||
+'Conflict package: "'+ConflictPkg.IDAsString+'"'#13
|
||||
+'File: "'+ConflictPkg.Filename+'"'#13
|
||||
+#13
|
||||
+'It is strongly recommended to choose another name.',
|
||||
mtInformation,[mbRetry,mbAbort,mbIgnore],0);
|
||||
if Result=mrAbort then exit;
|
||||
if Result<>mrIgnore then continue; // try again
|
||||
end;
|
||||
|
||||
// check file name conflict with project
|
||||
if Project1.ProjectUnitWithFilename(NewFilename)<>nil then begin
|
||||
Result:=MessageDlg('Filename is used by project',
|
||||
'The file name "'+NewFilename+'" is part of the current project.'#13
|
||||
+'Projects and Packages should not share files.',
|
||||
mtInformation,[mbRetry,mbAbort],0);
|
||||
if Result=mrAbort then exit;
|
||||
continue; // try again
|
||||
end;
|
||||
|
||||
// check file name conflict with other packages
|
||||
PkgFile:=PackageGraph.FindFileInAllPackages(NewFilename,true);
|
||||
if PkgFile<>nil then begin
|
||||
Result:=MessageDlg('Filename is used by other package',
|
||||
'The file name "'+NewFilename+'" is used by'#13
|
||||
+'the package "'+PkgFile.LazPackage.IDAsString+'"'#13
|
||||
+'in file "'+PkgFile.LazPackage.Filename+'".',
|
||||
mtInformation,[mbRetry,mbAbort],0);
|
||||
if Result=mrAbort then exit;
|
||||
continue; // try again
|
||||
end;
|
||||
|
||||
until Result<>mrRetry;
|
||||
finally
|
||||
InputHistories.StoreFileDialogSettings(SaveDialog);
|
||||
SaveDialog.Free;
|
||||
end;
|
||||
|
||||
// set filename
|
||||
APackage.Filename:=NewFilename;
|
||||
|
||||
// rename package
|
||||
if AnsiCompareText(NewPkgName,APackage.Name)=0 then begin
|
||||
// just change in case
|
||||
APackage.Name:=NewPkgName;
|
||||
end else begin
|
||||
// name change -> update package graph
|
||||
APackage.Name:=NewPkgName;
|
||||
// ToDo: update package graph
|
||||
end;
|
||||
|
||||
// clean up old package file to reduce ambigiousities
|
||||
if FileExists(OldPkgFilename)
|
||||
and (CompareFilenames(OldPkgFilename,NewFilename)<>0) then begin
|
||||
if MessageDlg('Delete Old Package File?',
|
||||
'Delete old package file "'+OldPkgFilename+'"?',
|
||||
mtConfirmation,[mbOk,mbCancel],0)=mrOk
|
||||
then begin
|
||||
if not DeleteFile(OldPkgFilename) then begin
|
||||
MessageDlg('Delete failed',
|
||||
'Deleting of file "'+OldPkgFilename+'"'
|
||||
+' failed.',mtError,[mbOk],0);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
// success
|
||||
Result:=mrOk;
|
||||
end;
|
||||
|
||||
constructor TPkgManager.Create(TheOwner: TComponent);
|
||||
begin
|
||||
inherited Create(TheOwner);
|
||||
@ -158,6 +329,8 @@ begin
|
||||
PackageEditors.OnOpenPackage:=@OnPackageEditorOpenPackage;
|
||||
PackageEditors.OnCreateNewFile:=@OnPackageEditorCreateFile;
|
||||
PackageEditors.OnGetIDEFileInfo:=@MainIDE.GetIDEFileState;
|
||||
PackageEditors.OnGetUnitRegisterInfo:=@OnPackageEditorGetUnitRegisterInfo;
|
||||
PackageEditors.OnSavePackage:=@OnPackageEditorSavePackage;
|
||||
end;
|
||||
|
||||
destructor TPkgManager.Destroy;
|
||||
@ -207,7 +380,6 @@ var
|
||||
NewPackage: TLazPackage;
|
||||
CurEditor: TPackageEditorForm;
|
||||
begin
|
||||
Result:=mrCancel;
|
||||
// create a new package with standard dependencies
|
||||
NewPackage:=PackageGraph.NewPackage('NewPackage');
|
||||
NewPackage.AddRequiredDependency(
|
||||
@ -232,12 +404,61 @@ function TPkgManager.DoOpenPackage(APackage: TLazPackage): TModalResult;
|
||||
var
|
||||
CurEditor: TPackageEditorForm;
|
||||
begin
|
||||
Result:=mrCancel;
|
||||
// open a package editor
|
||||
CurEditor:=PackageEditors.OpenEditor(APackage);
|
||||
CurEditor.Show;
|
||||
Result:=mrOk;
|
||||
end;
|
||||
|
||||
function TPkgManager.DoSavePackage(APackage: TLazPackage;
|
||||
Flags: TPkgSaveFlags): TModalResult;
|
||||
var
|
||||
XMLConfig: TXMLConfig;
|
||||
begin
|
||||
// do not save during compilation
|
||||
if not (MainIDE.ToolStatus in [itNone,itDebugger]) then begin
|
||||
Result:=mrAbort;
|
||||
exit;
|
||||
end;
|
||||
MainIDE.SaveSourceEditorChangesToCodeCache(-1);
|
||||
|
||||
if APackage.IsVirtual then Include(Flags,psfSaveAs);
|
||||
|
||||
// check if package needs saving
|
||||
if (not (psfSaveAs in Flags)) and (not APackage.ReadOnly)
|
||||
and (not APackage.Modified)
|
||||
and FileExists(APackage.Filename) then begin
|
||||
Result:=mrOk;
|
||||
exit;
|
||||
end;
|
||||
|
||||
// save package
|
||||
if (psfSaveAs in Flags) then begin
|
||||
Result:=DoShowSavePackageAsDialog(APackage);
|
||||
if Result<>mrOk then exit;
|
||||
end;
|
||||
|
||||
// save
|
||||
Result:=mrCancel;
|
||||
try
|
||||
XMLConfig:=TXMLConfig.Create(APackage.Filename);
|
||||
APackage.SaveToXMLConfig(XMLConfig,'Package/');
|
||||
XMLConfig.Flush;
|
||||
XMLConfig.Free;
|
||||
except
|
||||
on E: Exception do begin
|
||||
Result:=MessageDlg('Error Writing Package',
|
||||
'Unable to write package "'+APackage.IDAsString+'"'#13
|
||||
+'to file "'+APackage.Filename+'".',
|
||||
mtError,[mbAbort,mbCancel],0);
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
|
||||
// success
|
||||
APackage.Modified:=false;
|
||||
Result:=mrOk;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user