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

IDE: improvements to Use Unit dialog. Issue #20743, patch from Anton

Browse Source 
git-svn-id: trunk@33998 -
This commit is contained in:
juha 2011-12-06 14:21:19 +00:00
parent 9421caa547
commit 24e376bd7c
2 changed files with 156 additions and 56 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
ide/useunitdlg.lfm
View File

@ -64,6 +64,7 @@ object UseUnitDialog: TUseUnitDialog
'Interface' 'Interface'
'Implementation' 'Implementation'
) )
OnClick = SectionRadioGroupClick
TabOrder = 3 TabOrder = 3
end end
object UnitsListBox: TListBox object UnitsListBox: TListBox

211
ide/useunitdlg.pas
View File

@ -59,13 +59,14 @@ type
UnitImgInd: Integer; UnitImgInd: Integer;
FMainUsedUnits: TStrings; FMainUsedUnits: TStrings;
FImplUsedUnits: TStrings; FImplUsedUnits: TStrings;
FProjUnits: TStringList; FProjUnits, FOtherUnits: TStringList;
FOtherUnits: TStringList; procedure AddImplUsedUnits;
function GetAvailableProjUnits(SrcEdit: TSourceEditor): TModalResult; procedure GetProjUnits(SrcEdit: TSourceEditor);
procedure CreateOtherUnitsList; procedure CreateOtherUnitsList;
function SelectedUnit: string; function SelectedUnit: string;
function InterfaceSelected: Boolean; function InterfaceSelected: Boolean;
procedure DetermineUsesSection(ACode: TCodeBuffer; ACursorPos: TPoint); procedure DetermineUsesSection(ACode: TCodeBuffer; ACursorPos: TPoint);
procedure FillAvailableUnitsList;
public public
end; end;
@ -89,23 +90,33 @@ begin
SrcEdit:=SourceEditorManager.ActiveEditor; SrcEdit:=SourceEditorManager.ActiveEditor;
UseUnitDlg:=TUseUnitDialog.Create(nil); UseUnitDlg:=TUseUnitDialog.Create(nil);
try try
Result:=UseUnitDlg.GetAvailableProjUnits(SrcEdit); UseUnitDlg.GetProjUnits(SrcEdit);
if Result<>mrOK then exit; UseUnitDlg.FillAvailableUnitsList;
// there is only main uses section in program/library/package // there is only main uses section in program/library/package
if SrcEdit.GetProjectFile=Project1.MainUnitInfo then begin if SrcEdit.GetProjectFile=Project1.MainUnitInfo then begin
// only main (interface) section is available // only main (interface) section is available
UseUnitDlg.SectionRadioGroup.Enabled := False UseUnitDlg.SectionRadioGroup.Enabled := False
end else begin end else begin
// automatic choise of dest uses-section by cursor position // automatic choice of dest uses-section by cursor position
UseUnitDlg.DetermineUsesSection(SrcEdit.CodeBuffer, SrcEdit.GetCursorTextXY); UseUnitDlg.DetermineUsesSection(SrcEdit.CodeBuffer, SrcEdit.GetCursorTextXY);
end; end;
if UseUnitDlg.FilterEdit.Data.Count = 0 then
begin
// no available units from current project => turn on "all units"
UseUnitDlg.AllUnitsCheckBox.Checked := True;
end;
if UseUnitDlg.FilterEdit.Data.Count = 0 then Exit(mrCancel);
// Show the dialog. // Show the dialog.
if UseUnitDlg.ShowModal=mrOk then begin if UseUnitDlg.ShowModal=mrOk then begin
s:=UseUnitDlg.SelectedUnit; s:=UseUnitDlg.SelectedUnit;
if s <> '' then begin if s <> '' then begin
if UseUnitDlg.InterfaceSelected then if UseUnitDlg.InterfaceSelected then begin
CTRes:=CodeToolBoss.AddUnitToMainUsesSection(SrcEdit.CodeBuffer, s, '') if UseUnitDlg.FImplUsedUnits.IndexOf(s) >= 0 then
else CTRes := CodeToolBoss.RemoveUnitFromAllUsesSections(SrcEdit.CodeBuffer, s);
if CTRes then
CTRes := CodeToolBoss.AddUnitToMainUsesSection(SrcEdit.CodeBuffer, s, '');
end else
CTRes:=CodeToolBoss.AddUnitToImplementationUsesSection(SrcEdit.CodeBuffer, s, ''); CTRes:=CodeToolBoss.AddUnitToImplementationUsesSection(SrcEdit.CodeBuffer, s, '');
if not CTRes then begin if not CTRes then begin
LazarusIDE.DoJumpToCodeToolBossError; LazarusIDE.DoJumpToCodeToolBossError;
@ -146,7 +157,18 @@ begin
end; end;
procedure TUseUnitDialog.SectionRadioGroupClick(Sender: TObject); procedure TUseUnitDialog.SectionRadioGroupClick(Sender: TObject);
var
i: Integer;
begin begin
if not Assigned(FImplUsedUnits) then Exit;
if InterfaceSelected then
AddImplUsedUnits
else
with FilterEdit.Data do
for i := Count - 1 downto 0 do
if Objects[i] is TCodeTreeNode then
Delete(i);
FilterEdit.InvalidateFilter;
if Visible then if Visible then
FilterEdit.SetFocus; FilterEdit.SetFocus;
end; end;
@ -160,15 +182,16 @@ begin
FilterEdit.Data.AddStrings(FOtherUnits); FilterEdit.Data.AddStrings(FOtherUnits);
end end
else else
with FilterEdit.Data do begin // Remove other units with FilterEdit.Data do begin // Remove other units
BeginUpdate; BeginUpdate;
try try
for i := Count-1 downto 0 do for i := Count-1 downto 0 do
if Assigned(Objects[i]) then Delete(i); if Objects[i] is TIdentifierListItem then
finally Delete(i);
EndUpdate; finally
EndUpdate;
end;
end; end;
end;
if Visible then if Visible then
FilterEdit.SetFocus; FilterEdit.SetFocus;
FilterEdit.InvalidateFilter; FilterEdit.InvalidateFilter;
@ -182,16 +205,28 @@ end;
procedure TUseUnitDialog.UnitsListBoxDrawItem(Control: TWinControl; procedure TUseUnitDialog.UnitsListBoxDrawItem(Control: TWinControl;
Index: Integer; ARect: TRect; State: TOwnerDrawState); Index: Integer; ARect: TRect; State: TOwnerDrawState);
var ena: Boolean; var
ena: Boolean;
begin begin
if Index < 0 then Exit; if Index < 0 then Exit;
with UnitsListBox do with UnitsListBox do
begin begin
Canvas.FillRect(ARect); Canvas.FillRect(ARect);
ena := not Assigned(Items.Objects[Index]); ena := not Assigned(Items.Objects[Index]) or (Items.Objects[Index] is TCodeTreeNode);
if not (ena or (odSelected in State)) then if not (ena or (odSelected in State)) then
UnitsListBox.Canvas.Font.Color := clGreen; UnitsListBox.Canvas.Font.Color := clGreen;
IDEImages.Images_16.Draw(Canvas, 1, ARect.Top, UnitImgInd, ena); IDEImages.Images_16.Draw(Canvas, 1, ARect.Top, UnitImgInd, ena);
if Items.Objects[Index] is TCodeTreeNode then
begin
// unit for moving: implementation->interface
Canvas.Pen.Color := clBlue;
Canvas.Pen.Width := 2;
Canvas.MoveTo(ARect.Left + 13, ARect.Top + 16);
Canvas.LineTo(ARect.Left + 13, ARect.Top + 8);
Canvas.LineTo(ARect.Left + 10, ARect.Top + 11);
Canvas.MoveTo(ARect.Left + 13, ARect.Top + 8);
Canvas.LineTo(ARect.Left + 15, ARect.Top + 11);
end;
Canvas.TextRect(ARect, ARect.Left + 20, ARect.Top, Items[Index]); Canvas.TextRect(ARect, ARect.Left + 20, ARect.Top, Items[Index]);
end; end;
end; end;
@ -205,48 +240,78 @@ begin
Key:=VK_UNKNOWN; Key:=VK_UNKNOWN;
end; end;
function TUseUnitDialog.GetAvailableProjUnits(SrcEdit: TSourceEditor): TModalResult; procedure TUseUnitDialog.AddImplUsedUnits;
var
i, j: Integer;
newUnit: string;
ImplNode: TObject;
begin
if FImplUsedUnits.Count = 0 then Exit;
i := 0; j := 0;
ImplNode := FImplUsedUnits.Objects[0];
newUnit := FImplUsedUnits[j];
with FilterEdit.Data do
begin
BeginUpdate;
try
while i <= Count - 1 do
begin
if Assigned(Objects[i]) then Break;
if CompareStr(FImplUsedUnits[j], Strings[i]) <= 0 then
begin
InsertObject(i, newUnit, ImplNode);
Inc(j);
if j >= FImplUsedUnits.Count then Exit;
newUnit := FImplUsedUnits[j];
end;
Inc(i);
end;
if j < FImplUsedUnits.Count then
for j := j to FImplUsedUnits.Count - 1 do
if i < Count then
InsertObject(i, FImplUsedUnits[j], ImplNode)
else
AddObject(FImplUsedUnits[j], ImplNode);
finally
EndUpdate;
end;
end;
end;
procedure TUseUnitDialog.GetProjUnits(SrcEdit: TSourceEditor);
var var
ProjFile: TUnitInfo; ProjFile: TUnitInfo;
CurrentUnitName, s: String; CurrentUnitName, s: String;
begin begin
Result:=mrOk; FMainUsedUnits := nil;
FMainUsedUnits:=nil; FImplUsedUnits := nil;
FImplUsedUnits:=nil; if SrcEdit = nil then Exit;
if SrcEdit=nil then exit;
Assert(Assigned(SrcEdit.CodeBuffer)); Assert(Assigned(SrcEdit.CodeBuffer));
if not CodeToolBoss.FindUsedUnitNames(SrcEdit.CodeBuffer, if not CodeToolBoss.FindUsedUnitNames(SrcEdit.CodeBuffer,
FMainUsedUnits,FImplUsedUnits) FMainUsedUnits,FImplUsedUnits)
then begin then begin
DebugLn(['ShowUseProjUnitDialog CodeToolBoss.FindUsedUnitNames failed']); DebugLn(['ShowUseProjUnitDialog CodeToolBoss.FindUsedUnitNames failed']);
LazarusIDE.DoJumpToCodeToolBossError; LazarusIDE.DoJumpToCodeToolBossError;
exit(mrCancel); Exit;
end; end;
TStringList(FMainUsedUnits).CaseSensitive:=False; TStringList(FMainUsedUnits).CaseSensitive := False;
TStringList(FImplUsedUnits).CaseSensitive:=False; TStringList(FImplUsedUnits).CaseSensitive := False;
if SrcEdit.GetProjectFile is TUnitInfo then if SrcEdit.GetProjectFile is TUnitInfo then
CurrentUnitName:=TUnitInfo(SrcEdit.GetProjectFile).Unit_Name CurrentUnitName := TUnitInfo(SrcEdit.GetProjectFile).Unit_Name
else else
CurrentUnitName:=''; CurrentUnitName := '';
// Add available unit names to list. // Add available unit names to list
ProjFile:=Project1.FirstPartOfProject; ProjFile:=Project1.FirstPartOfProject;
while ProjFile<>nil do begin while ProjFile <> nil do begin
s:=ProjFile.Unit_Name; s := ProjFile.Unit_Name;
if s=CurrentUnitName then // current unit if s = CurrentUnitName then // current unit
s:=''; s := '';
if (ProjFile<>Project1.MainUnitInfo) and (s<>'') then if (ProjFile <> Project1.MainUnitInfo) and (s <> '') then
if (FMainUsedUnits.IndexOf(s) < 0) and (FImplUsedUnits.IndexOf(s) < 0) then if FMainUsedUnits.IndexOf(s) < 0 then
FProjUnits.Add(s); FProjUnits.Add(s);
ProjFile:=ProjFile.NextPartOfProject; ProjFile := ProjFile.NextPartOfProject;
end; end;
FProjUnits.Sorted:=True; FProjUnits.Sorted := True;
FilterEdit.Data.Assign(FProjUnits);
if FilterEdit.Data.Count = 0 then
begin
AllUnitsCheckBox.Checked := True;
if FilterEdit.Data.Count = 0 then Exit(mrCancel);
end;
FilterEdit.InvalidateFilter;
end; end;
procedure TUseUnitDialog.CreateOtherUnitsList; procedure TUseUnitDialog.CreateOtherUnitsList;
@ -268,9 +333,10 @@ begin
begin begin
curUnit := IdentifierList.FilteredItems[i].Identifier; curUnit := IdentifierList.FilteredItems[i].Identifier;
if (FMainUsedUnits.IndexOf(curUnit) < 0) if (FMainUsedUnits.IndexOf(curUnit) < 0)
and (FImplUsedUnits.IndexOf(curUnit) < 0) and (FImplUsedUnits.IndexOf(curUnit) < 0)
and (FOtherUnits.IndexOf(curUnit) < 0) then and (FOtherUnits.IndexOf(curUnit) < 0) then
FOtherUnits.AddObject(IdentifierList.FilteredItems[i].Identifier, IdentifierList.FilteredItems[i]); FOtherUnits.AddObject(IdentifierList.FilteredItems[i].Identifier,
IdentifierList.FilteredItems[i]);
end; end;
end; end;
FOtherUnits.Sort; FOtherUnits.Sort;
@ -283,6 +349,7 @@ function TUseUnitDialog.SelectedUnit: string;
var var
IdentItem: TIdentifierListItem; IdentItem: TIdentifierListItem;
CodeBuf: TCodeBuffer; CodeBuf: TCodeBuffer;
s: String;
begin begin
with UnitsListBox do with UnitsListBox do
if ItemIndex >= 0 then if ItemIndex >= 0 then
@ -291,13 +358,13 @@ begin
if Assigned(IdentItem) then if Assigned(IdentItem) then
begin begin
Result := IdentItem.Identifier; Result := IdentItem.Identifier;
CodeBuf := CodeToolBoss.FindUnitSource( CodeBuf := CodeToolBoss.FindUnitSource(SourceEditorManager.ActiveEditor.CodeBuffer, Result, '');
SourceEditorManager.ActiveEditor.CodeBuffer, Result, ''); if Assigned(CodeBuf) then
if CodeBuf = nil then begin
Exit(IdentItem.Identifier); s := CodeToolBoss.GetSourceName(CodeBuf, True);
Result := CodeToolBoss.GetSourceName(CodeBuf, True); if s <> '' then
if Result = '' then Result := s;
Result := IdentItem.Identifier; end;
end else end else
Result := Items[ItemIndex]; Result := Items[ItemIndex];
end else end else
@ -314,6 +381,8 @@ var
CursorPos: TCodeXYPosition; CursorPos: TCodeXYPosition;
CleanCursorPos: Integer; CleanCursorPos: Integer;
CursorNode: TCodeTreeNode; CursorNode: TCodeTreeNode;
ImplUsesNode: TCodeTreeNode;
i: Integer;
begin begin
if not CodeToolBoss.InitCurCodeTool(ACode) then Exit; if not CodeToolBoss.InitCurCodeTool(ACode) then Exit;
with CodeToolBoss.CurCodeTool do with CodeToolBoss.CurCodeTool do
@ -324,16 +393,46 @@ begin
// build code tree // build code tree
BuildTreeAndGetCleanPos(trTillCursor,lsrEnd,CursorPos,CleanCursorPos, BuildTreeAndGetCleanPos(trTillCursor,lsrEnd,CursorPos,CleanCursorPos,
[btSetIgnoreErrorPos,btLoadDirtySource,btCursorPosOutAllowed]); [btSetIgnoreErrorPos,btLoadDirtySource,btCursorPosOutAllowed]);
// find CodeTreeNode at cursor
if (Tree.Root = nil) or (Tree.Root.StartPos > CleanCursorPos) then Exit; if (Tree.Root = nil) or (Tree.Root.StartPos > CleanCursorPos) then Exit;
ImplUsesNode := FindImplementationUsesSection;
if Assigned(ImplUsesNode) then
for i := 0 to FImplUsedUnits.Count - 1 do
FImplUsedUnits.Objects[i] := ImplUsesNode;
// find CodeTreeNode at cursor
CursorNode := BuildSubTreeAndFindDeepestNodeAtPos(CleanCursorPos, True); CursorNode := BuildSubTreeAndFindDeepestNodeAtPos(CleanCursorPos, True);
if CursorNode.HasParentOfType(ctnImplementation) then if CursorNode.HasParentOfType(ctnImplementation) then
SectionRadioGroup.ItemIndex := 1; SectionRadioGroup.ItemIndex := 1;
SectionRadioGroup.OnClick(SectionRadioGroup);
finally finally
DeactivateGlobalWriteLock DeactivateGlobalWriteLock
end; end;
end; end;
end; end;
procedure TUseUnitDialog.FillAvailableUnitsList;
var
curUnit: String;
i: Integer;
begin
if not Assigned(FProjUnits) then Exit;
with FilterEdit.Data do
begin
BeginUpdate;
try
Clear;
for i := 0 to FProjUnits.Count - 1 do
begin
curUnit := FProjUnits[i];
if (FMainUsedUnits.IndexOf(curUnit) < 0)
and (FImplUsedUnits.IndexOf(curUnit) < 0) then
Add(FProjUnits[i]);
end;
finally
EndUpdate;
end;
end;
FilterEdit.InvalidateFilter;
end;
end. end.