paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-05 17:37:53 +02:00
Code Issues Packages Projects Releases Wiki Activity
337d747d4d
lazarus/ide/useunitdlg.pas

540 lines
17 KiB
ObjectPascal
Raw Blame History

{ Copyright (C) 2011,
***************************************************************************
* *
* 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., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA. *
* *
***************************************************************************
Original version by Juha Manninen
Icons added by Marcelo B Paula
All available units added to the list by Anton Panferov
}
unit UseUnitDlg;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils,
// LCL
LCLType, Forms, Controls, StdCtrls, ExtCtrls, ButtonPanel, Dialogs, Graphics,
// LazControls
ListFilterEdit,
// LazUtils
LazUTF8, LazFileUtils, LazUtilities,
// Codetools
FileProcs, LinkScanner, CodeCache, CodeTree, CodeToolManager, IdentCompletionTool,
// BuildIntf
ProjectIntf,
// IdeIntf
IdeIntfStrConsts, LazIDEIntf, IDEImagesIntf, IDEWindowIntf, TextTools,
// IDE
LazarusIDEStrConsts, SourceEditor, Project, EnvironmentOpts, MainIntf;
type
TUseUnitDialogType = (udUseUnit, udOpenUnit);
{ TUseUnitDialog }
TUseUnitDialog = class(TForm)
ButtonPanel1: TButtonPanel;
AllUnitsCheckBox: TCheckBox;
FilterEdit: TListFilterEdit;
UnitsListBox: TListBox;
SectionRadioGroup: TRadioGroup;
procedure AllUnitsCheckBoxChange(Sender: TObject);
procedure FilterEditAfterFilter(Sender: TObject);
function FilterEditFilterItemEx(const ACaption: string; {%H-}ItemData: Pointer;
out Done: Boolean): Boolean;
procedure FilterEditKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure FormClose(Sender: TObject; var {%H-}CloseAction: TCloseAction);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure SectionRadioGroupClick(Sender: TObject);
procedure UnitsListBoxDblClick(Sender: TObject);
procedure UnitsListBoxDrawItem({%H-}Control: TWinControl; Index: Integer;
ARect: TRect; State: TOwnerDrawState);
private
UnitImgInd: Integer;
FMainUsedUnits, FImplUsedUnits: TStringList;
FProjUnits, FOtherUnits: TStringListUTF8Fast;
DlgType: TUseUnitDialogType;
procedure AddImplUsedUnits;
function GetProjUnits(SrcEdit: TSourceEditor): Boolean;
procedure CreateOtherUnitsList;
function SelectedUnitFileName: string;
function SelectedUnit: string;
function InterfaceSelected: Boolean;
procedure DetermineUsesSection(ACode: TCodeBuffer);
procedure FillAvailableUnitsList;
public
end;
function ShowUseUnitDialog(const DefText: string; const aDlgType: TUseUnitDialogType): TModalResult;
implementation
{$R *.lfm}
function ShowUseUnitDialog(const DefText: string; const aDlgType: TUseUnitDialogType): TModalResult;
var
UseUnitDlg: TUseUnitDialog;
SrcEdit: TSourceEditor;
s: String;
CTRes: Boolean;
EnvOptions: TUseUnitDlgOptions;
begin
Result:=mrOk;
if not LazarusIDE.BeginCodeTools then begin
debugln(['ShowUseUnitDialog LazarusIDE.BeginCodeTools failed']);
exit;
end;
// get cursor position
SrcEdit:=SourceEditorManager.ActiveEditor;
if SrcEdit=nil then begin
debugln(['ShowUseUnitDialog no SrcEdit']);
exit;
end;
UseUnitDlg:=TUseUnitDialog.Create(nil);
try
UseUnitDlg.DlgType := aDlgType;
case aDlgType of
udUseUnit: UseUnitDlg.Caption := dlgUseUnitCaption;
udOpenUnit: UseUnitDlg.Caption := lisOpenUnit;
end;
if not UseUnitDlg.GetProjUnits(SrcEdit) then begin
debugln(['ShowUseUnitDialog UseUnitDlg.GetProjUnits(SrcEdit) failed: ',SrcEdit.FileName]);
Exit(mrCancel);
end;
UseUnitDlg.FillAvailableUnitsList;
// there is only main uses section in program/library/package
if SrcEdit.GetProjectFile=Project1.MainUnitInfo then
// only main (interface) section is available
UseUnitDlg.SectionRadioGroup.Enabled := False
else
// automatic choice of dest uses-section by cursor position
UseUnitDlg.DetermineUsesSection(SrcEdit.CodeBuffer);
// Read recent properties
EnvOptions := EnvironmentOptions.UseUnitDlgOptions;
UseUnitDlg.AllUnitsCheckBox.Checked := EnvOptions.AllUnits;
UseUnitDlg.SectionRadioGroup.ItemIndex := Ord(EnvOptions.AddToImplementation);
UseUnitDlg.SectionRadioGroup.Visible := aDlgType=udUseUnit;
if (UseUnitDlg.FilterEdit.Items.Count = 0)
and UseUnitDlg.AllUnitsCheckBox.Checked then begin
// No available units. This may not be a pascal source file.
ShowMessage(dlgNoAvailableUnits);
Exit(mrCancel);
end;
UseUnitDlg.FilterEdit.Text := DefText;
// Show the dialog.
if UseUnitDlg.ShowModal=mrOk then begin
// Write recent properties
EnvOptions.AllUnits := UseUnitDlg.AllUnitsCheckBox.Checked;
if aDlgType=udUseUnit then
EnvOptions.AddToImplementation := Boolean(UseUnitDlg.SectionRadioGroup.ItemIndex);
EnvironmentOptions.UseUnitDlgOptions := EnvOptions;
case aDlgType of
udUseUnit:
begin
s:=UseUnitDlg.SelectedUnit;
if s <> '' then begin
if UseUnitDlg.InterfaceSelected then
CTRes := CodeToolBoss.AddUnitToMainUsesSection(SrcEdit.CodeBuffer, s, '')
else
CTRes:=CodeToolBoss.AddUnitToImplementationUsesSection(SrcEdit.CodeBuffer, s, '');
if not CTRes then begin
LazarusIDE.DoJumpToCodeToolBossError;
exit(mrCancel);
end;
end;
end;
udOpenUnit:
begin
s:=UseUnitDlg.SelectedUnitFileName;
if FileExistsUTF8(s) then
Result := MainIDEInterface.DoOpenEditorFile(s,-1,-1,[ofAddToRecent])
else
exit(mrCancel);
end;
end;
end;
finally
UseUnitDlg.Free;
CodeToolBoss.SourceCache.ClearAllSourceLogEntries;
end;
end;
{ TUseUnitDialog }
procedure TUseUnitDialog.FormCreate(Sender: TObject);
begin
// Internationalization
IDEDialogLayoutList.ApplyLayout(Self, 500, 460);
AllUnitsCheckBox.Caption := dlgShowAllUnits;
SectionRadioGroup.Caption := dlgInsertSection;
SectionRadioGroup.Items.Clear;
SectionRadioGroup.Items.Add(dlgInsertInterface);
SectionRadioGroup.Items.Add(dlgInsertImplementation);
ButtonPanel1.OKButton.Caption:=lisBtnOk;
ButtonPanel1.CancelButton.Caption:=lisCancel;
UnitImgInd := IDEImages.LoadImage('item_unit');
FProjUnits:=TStringListUTF8Fast.Create;
UnitsListBox.ItemHeight := IDEImages.Images_16.Height + 2;
end;
procedure TUseUnitDialog.FormDestroy(Sender: TObject);
begin
FreeThenNil(FOtherUnits);
FreeThenNil(FProjUnits);
FreeThenNil(FImplUsedUnits);
FreeThenNil(FMainUsedUnits);
end;
procedure TUseUnitDialog.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if (Key = VK_A) and (Shift = [ssAlt]) then
begin
with AllUnitsCheckBox do
Checked := not Checked;
Key := 0;
end;
if (Key = VK_S) and (Shift = [ssAlt]) then
begin
with SectionRadioGroup do
if Enabled then
ItemIndex := (ItemIndex + 1) mod Items.Count;
Key := 0;
end;
end;
procedure TUseUnitDialog.FormClose(Sender: TObject; var CloseAction: TCloseAction);
begin
IDEDialogLayoutList.SaveLayout(Self);
end;
procedure TUseUnitDialog.SectionRadioGroupClick(Sender: TObject);
var
i: Integer;
begin
if not Assigned(FImplUsedUnits) then Exit;
if InterfaceSelected then
AddImplUsedUnits
else
for i := FilterEdit.Items.Count - 1 downto 0 do
if FilterEdit.Items.Objects[i] is TCodeTreeNode then
FilterEdit.Items.Delete(i);
FilterEdit.InvalidateFilter;
if Visible then
FilterEdit.SetFocus;
end;
procedure TUseUnitDialog.AllUnitsCheckBoxChange(Sender: TObject);
var
i: Integer;
begin
if not (Assigned(FMainUsedUnits) and Assigned(FImplUsedUnits)) then Exit;
if AllUnitsCheckBox.Checked then begin // Add other units
if not Assigned(FOtherUnits) then
CreateOtherUnitsList;
FilterEdit.Items.AddStrings(FOtherUnits);
end
else
for i := FilterEdit.Items.Count-1 downto 0 do
if FilterEdit.Items.Objects[i] is TIdentifierListItem then
FilterEdit.Items.Delete(i);
if Visible then
FilterEdit.SetFocus;
FilterEdit.InvalidateFilter;
end;
procedure TUseUnitDialog.UnitsListBoxDblClick(Sender: TObject);
begin
if UnitsListBox.ItemIndex >= 0 then
ModalResult := mrOK;
end;
procedure TUseUnitDialog.UnitsListBoxDrawItem(Control: TWinControl;
Index: Integer; ARect: TRect; State: TOwnerDrawState);
var
ena: Boolean;
begin
if Index < 0 then Exit;
with UnitsListBox do
begin
Canvas.FillRect(ARect);
ena := not Assigned(Items.Objects[Index]) or (Items.Objects[Index] is TCodeTreeNode);
if not (ena or (odSelected in State)) then
Canvas.Font.Color := clGreen;
IDEImages.Images_16.Draw(Canvas, 1, (ARect.Top+ARect.Bottom-IDEImages.Images_16.Height) div 2, 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 + IDEImages.Images_16.Width + 4, ARect.Top, Items[Index]);
end;
end;
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.Items 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;
function TUseUnitDialog.GetProjUnits(SrcEdit: TSourceEditor): Boolean;
var
ProjFile: TUnitInfo;
CurrentUnitName, s: String;
x: Integer;
begin
Result := False;
FreeThenNil(FMainUsedUnits);
FreeThenNil(FImplUsedUnits);
if SrcEdit = nil then Exit;
Assert(Assigned(SrcEdit.CodeBuffer));
if DlgType=udUseUnit then
begin
if not CodeToolBoss.FindUsedUnitNames(SrcEdit.CodeBuffer, TStrings(FMainUsedUnits),
TStrings(FImplUsedUnits))
then begin
DebugLn(['ShowUseProjUnitDialog CodeToolBoss.FindUsedUnitNames failed']);
LazarusIDE.DoJumpToCodeToolBossError;
Exit;
end;
end else
begin
// don't filter units in current uses sections - use empty lists
FMainUsedUnits := TStringList.Create;
FImplUsedUnits := TStringList.Create;
end;
Result := True;
if Assigned(FMainUsedUnits) then
FMainUsedUnits.Sorted := True;
if Assigned(FImplUsedUnits) then
FImplUsedUnits.Sorted := True;
if SrcEdit.GetProjectFile is TUnitInfo then
CurrentUnitName := TUnitInfo(SrcEdit.GetProjectFile).Unit_Name
else
CurrentUnitName := '';
// Add available unit names to list
for TLazProjectFile(ProjFile) in Project1.UnitsBelongingToProject do begin
s := ProjFile.Unit_Name;
if s = CurrentUnitName then // current unit
s := '';
if (ProjFile <> Project1.MainUnitInfo) and (s <> '') then
if not FMainUsedUnits.Find(s, x) then
FProjUnits.AddObject(s, ProjFile);
end;
FProjUnits.Sorted := True;
end;
procedure TUseUnitDialog.CreateOtherUnitsList;
var
i, x: Integer;
curUnit: string;
SrcEdit: TSourceEditor;
begin
if not (Assigned(FMainUsedUnits) and Assigned(FImplUsedUnits)) then Exit;
Screen.BeginWaitCursor;
try
FOtherUnits := TStringListUTF8Fast.Create;
SrcEdit := SourceEditorManager.ActiveEditor;
with CodeToolBoss do
if GatherUnitNames(SrcEdit.CodeBuffer) then
begin
IdentifierList.Prefix := '';
for i := 0 to IdentifierList.GetFilteredCount - 1 do
begin
curUnit := IdentifierList.FilteredItems[i].Identifier;
if not FMainUsedUnits.Find(curUnit, x)
and not FImplUsedUnits.Find(curUnit, x)
and not FProjUnits.Find(curUnit, x) then
FOtherUnits.AddObject(IdentifierList.FilteredItems[i].Identifier,
IdentifierList.FilteredItems[i]);
end;
end;
FOtherUnits.Sorted := True;
finally
Screen.EndWaitCursor;
end;
end;
function TUseUnitDialog.SelectedUnit: string;
var
IdentItem: TIdentifierListItem;
CodeBuf: TCodeBuffer;
s: String;
begin
with UnitsListBox do
if ItemIndex >= 0 then
begin
if Items.Objects[ItemIndex] is TIdentifierListItem then
begin
IdentItem := TIdentifierListItem(Items.Objects[ItemIndex]);
Result := IdentItem.Identifier;
with CodeToolBoss.SourceChangeCache.BeautifyCodeOptions do
if WordExceptions.CheckExceptions(Result) then Exit;
CodeBuf := CodeToolBoss.FindUnitSource(SourceEditorManager.ActiveEditor.CodeBuffer, Result, '');
if Assigned(CodeBuf) then
begin
s := CodeToolBoss.GetSourceName(CodeBuf, True);
if s <> '' then
Result := s;
end;
end else
Result := Items[ItemIndex];
end else
Result := '';
end;
function TUseUnitDialog.SelectedUnitFileName: string;
var
CodeBuf: TCodeBuffer;
AObj: TObject;
begin
Result := '';
if UnitsListBox.ItemIndex < 0 then
Exit;
AObj := UnitsListBox.Items.Objects[UnitsListBox.ItemIndex];
if AObj is TIdentifierListItem then
begin
CodeBuf := CodeToolBoss.FindUnitSource(SourceEditorManager.ActiveEditor.CodeBuffer, TIdentifierListItem(AObj).Identifier, '');
if Assigned(CodeBuf) then
Result := CodeBuf.Filename;
end else
if AObj is TUnitInfo then
begin
Result := TUnitInfo(AObj).Filename;
end;
end;
function TUseUnitDialog.InterfaceSelected: Boolean;
begin
Result:=(not SectionRadioGroup.Enabled) or (SectionRadioGroup.ItemIndex=0);
end;
procedure TUseUnitDialog.DetermineUsesSection(ACode: TCodeBuffer);
var
ImplUsesNode: TCodeTreeNode;
i: Integer;
Tool: TCodeTool;
begin
CodeToolBoss.Explore(ACode,Tool,false);
if Tool=nil then exit;
// collect implementation use unit nodes
ImplUsesNode := Tool.FindImplementationUsesNode;
if Assigned(ImplUsesNode) then
for i := 0 to FImplUsedUnits.Count - 1 do
FImplUsedUnits.Objects[i] := ImplUsesNode;
// update
SectionRadioGroup.OnClick(SectionRadioGroup);
end;
procedure TUseUnitDialog.FillAvailableUnitsList;
var
curUnit: String;
i, x: Integer;
begin
if not (Assigned(FMainUsedUnits) and Assigned(FImplUsedUnits)) then Exit;
if not Assigned(FProjUnits) then Exit;
FilterEdit.Items.Clear;
for i := 0 to FProjUnits.Count - 1 do
begin
curUnit := FProjUnits[i];
if not FMainUsedUnits.Find(curUnit, x)
and not FImplUsedUnits.Find(curUnit, x) then
FilterEdit.Items.AddObject(FProjUnits[i], FProjUnits.Objects[i]);
end;
FilterEdit.InvalidateFilter;
end;
procedure TUseUnitDialog.FilterEditAfterFilter(Sender: TObject);
begin
if (UnitsListBox.Count > 0) and (UnitsListBox.ItemIndex < 0) then
UnitsListBox.ItemIndex := 0;
end;
function TUseUnitDialog.FilterEditFilterItemEx(const ACaption: string;
ItemData: Pointer; out Done: Boolean): Boolean;
begin
Done := true;
result := MultiWordSearch(FilterEdit.Text, ACaption);
end;
procedure TUseUnitDialog.FilterEditKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
var
c: char;
begin
if KeyToQWERTY(Key, Shift, c, true) then
FilterEdit.SelText := c;
end;
end.
Reference in New Issue View Git Blame Copy Permalink