From 27a1a5023fc98faed7360ac798d950d0bdd87cab Mon Sep 17 00:00:00 2001 From: Mark van Renswoude Date: Thu, 5 Jan 2006 21:04:59 +0000 Subject: [PATCH] Added: filter options in Units dialog Added: support for Project Source Added: dialog overrides View Form Added: dialog now actually activates the unit Changed: refactored filters to use Visitor pattern Note: requires at least Delphi 7 --- Packages/D2006/UnitSwitcher.dpk | 3 +- Source/UnSwClient.pas | 58 +++++-- Source/UnSwDialog.dfm | 64 +++++-- Source/UnSwDialog.pas | 158 +++++++++++++---- Source/UnSwFilters.pas | 137 +++++++++++++++ Source/UnSwObjects.pas | 293 ++++++++++++++++++++------------ 6 files changed, 544 insertions(+), 169 deletions(-) create mode 100644 Source/UnSwFilters.pas diff --git a/Packages/D2006/UnitSwitcher.dpk b/Packages/D2006/UnitSwitcher.dpk index 9fd73e4..b184c53 100644 --- a/Packages/D2006/UnitSwitcher.dpk +++ b/Packages/D2006/UnitSwitcher.dpk @@ -34,6 +34,7 @@ requires contains UnSwClient in '..\..\Source\UnSwClient.pas', UnSwObjects in '..\..\Source\UnSwObjects.pas', - UnSwDialog in '..\..\Source\UnSwDialog.pas' {frmUnSwDialog}; + UnSwDialog in '..\..\Source\UnSwDialog.pas' {frmUnSwDialog}, + UnSwFilters in '..\..\Source\UnSwFilters.pas'; end. diff --git a/Source/UnSwClient.pas b/Source/UnSwClient.pas index 917a3c5..6cf20ab 100644 --- a/Source/UnSwClient.pas +++ b/Source/UnSwClient.pas @@ -16,9 +16,12 @@ uses type TUnitSwitcherHook = class(TObject) private - FOldExecute: TNotifyEvent; + FOldUnitExecute: TNotifyEvent; + FOldFormExecute: TNotifyEvent; FViewUnitAction: TContainedAction; + FViewFormAction: TContainedAction; protected + function ActiveFileName(): String; procedure NewExecute(Sender: TObject); virtual; public constructor Create(); @@ -48,15 +51,21 @@ begin pAction := ifNTA.ActionList.Actions[iAction]; if pAction.Name = 'ViewUnitCommand' then begin - FOldExecute := pAction.OnExecute; + FOldUnitExecute := pAction.OnExecute; pAction.OnExecute := NewExecute; FViewUnitAction := pAction; - break; + end else if pAction.Name = 'ViewFormCommand' then + begin + FOldFormExecute := pAction.OnExecute; + pAction.OnExecute := NewExecute; + FViewFormAction := pAction; end; end; Assert(Assigned(FViewUnitAction), 'ViewUnitCommand action is not' + 'available in the IDE.'); + Assert(Assigned(FViewFormAction), 'ViewFormCommand action is not' + + 'available in the IDE.'); except on E:EAssertionFailed do ShowMessage('Error while loading UnitSwitcher: ' + E.Message); @@ -65,30 +74,59 @@ end; destructor TUnitSwitcherHook.Destroy(); begin + if Assigned(FViewFormAction) then + FViewFormAction.OnExecute := FOldFormExecute; + if Assigned(FViewUnitAction) then - FViewUnitAction.OnExecute := FOldExecute; + FViewUnitAction.OnExecute := FOldUnitExecute; inherited; end; +function TUnitSwitcherHook.ActiveFileName(): String; +var + ifModule: IOTAModule; + +begin + Result := ''; + ifModule := (BorlandIDEServices as IOTAModuleServices).CurrentModule; + if Assigned(ifModule) then + begin + if Assigned(ifModule.CurrentEditor) then + Result := ifModule.FileName; + end; +end; + procedure TUnitSwitcherHook.NewExecute(Sender: TObject); var + iActive: Integer; + ifProject: IOTAProject; iModule: Integer; - pProject: IOTAProject; + pActive: TUnSwUnit; pUnits: TUnSwUnitList; begin - pProject := (BorlandIDEServices as IOTAModuleServices).GetActiveProject; - if not Assigned(pProject) then + ifProject := (BorlandIDEServices as IOTAModuleServices).GetActiveProject; + if not Assigned(ifProject) then exit; pUnits := TUnSwUnitList.Create(); try - for iModule := 0 to Pred(pProject.GetModuleCount) do - pUnits.Add(TUnSwUnit.Create(pProject.GetModule(iModule))); + pUnits.Add(TUnSwProjectUnit.Create(ifProject)); - TfrmUnSwDialog.Execute(pUnits); + for iModule := 0 to Pred(ifProject.GetModuleCount) do + pUnits.Add(TUnSwModuleUnit.Create(ifProject.GetModule(iModule))); + + pActive := nil; + iActive := pUnits.IndexOfFileName(ActiveFileName()); + if iActive > -1 then + pActive := pUnits[iActive]; + + pActive := TfrmUnSwDialog.Execute(pUnits, (Sender = FViewFormAction), + pActive); + if Assigned(pActive) then + pActive.Activate((Sender = FViewUnitAction)); finally FreeAndNil(pUnits); end; diff --git a/Source/UnSwDialog.dfm b/Source/UnSwDialog.dfm index 1b84d8d..1ff544d 100644 --- a/Source/UnSwDialog.dfm +++ b/Source/UnSwDialog.dfm @@ -3,7 +3,7 @@ object frmUnSwDialog: TfrmUnSwDialog Top = 83 BorderIcons = [biSystemMenu] Caption = 'UnitSwitcher - it almosts makes coffee.' - ClientHeight = 387 + ClientHeight = 427 ClientWidth = 299 Color = clBtnFace Font.Charset = DEFAULT_CHARSET @@ -17,7 +17,7 @@ object frmUnSwDialog: TfrmUnSwDialog TextHeight = 13 object sbStatus: TStatusBar Left = 0 - Top = 368 + Top = 408 Width = 299 Height = 19 Panels = < @@ -29,11 +29,11 @@ object frmUnSwDialog: TfrmUnSwDialog Left = 0 Top = 0 Width = 299 - Height = 334 + Height = 317 Align = alClient BevelOuter = bvNone BorderWidth = 4 - TabOrder = 1 + TabOrder = 0 ExplicitWidth = 297 ExplicitHeight = 368 object pnlSearch: TPanel @@ -59,7 +59,7 @@ object frmUnSwDialog: TfrmUnSwDialog Left = 4 Top = 29 Width = 291 - Height = 301 + Height = 284 Style = lbVirtualOwnerDraw Align = alClient ItemHeight = 20 @@ -68,38 +68,74 @@ object frmUnSwDialog: TfrmUnSwDialog OnDrawItem = lstUnitsDrawItem end end - object Panel1: TPanel + object pnlButtons: TPanel Left = 0 - Top = 334 + Top = 372 Width = 299 - Height = 34 + Height = 36 Align = alBottom BevelOuter = bvNone TabOrder = 2 DesignSize = ( 299 - 34) + 36) object btnCancel: TButton Left = 220 - Top = 2 + Top = 5 Width = 75 Height = 25 - Anchors = [akTop, akRight] + Anchors = [akRight, akBottom] Cancel = True Caption = 'Cancel' ModalResult = 2 - TabOrder = 0 + TabOrder = 1 end object btnOK: TButton Left = 139 - Top = 2 + Top = 5 Width = 75 Height = 25 - Anchors = [akTop, akRight] + Anchors = [akRight, akBottom] Caption = 'OK' Default = True ModalResult = 1 + TabOrder = 0 + end + end + object pnlIncludeTypes: TPanel + Left = 0 + Top = 317 + Width = 299 + Height = 55 + Align = alBottom + BevelOuter = bvNone + TabOrder = 1 + object chkDataModules: TCheckBox + Left = 4 + Top = 19 + Width = 291 + Height = 17 + Caption = 'Show &DataModule units' TabOrder = 1 + OnClick = TypeFilterChange + end + object chkForms: TCheckBox + Left = 4 + Top = 2 + Width = 291 + Height = 17 + Caption = 'Show &Form units' + TabOrder = 0 + OnClick = TypeFilterChange + end + object chkProjectSource: TCheckBox + Left = 4 + Top = 36 + Width = 291 + Height = 17 + Caption = 'Show &Project source' + TabOrder = 2 + OnClick = TypeFilterChange end end object ilsTypes: TImageList diff --git a/Source/UnSwDialog.pas b/Source/UnSwDialog.pas index f5542ff..fc83517 100644 --- a/Source/UnSwDialog.pas +++ b/Source/UnSwDialog.pas @@ -1,5 +1,7 @@ unit UnSwDialog; +// #ToDo1 Store dialog settings + interface uses Classes, @@ -11,19 +13,35 @@ uses StdCtrls, Windows, - UnSwObjects; + UnSwObjects, + UnSwFilters; type + TUnSwIconVisitor = class(TUnSwNoRefIntfObject, IUnSwVisitor) + private + FImageIndex: Integer; + protected + procedure VisitModule(const AUnit: TUnSwModuleUnit); + procedure VisitProject(const AUnit: TUnSwProjectUnit); + public + property ImageIndex: Integer read FImageIndex; + end; + TfrmUnSwDialog = class(TForm) + btnCancel: TButton; + btnOK: TButton; edtSearch: TEdit; ilsTypes: TImageList; lstUnits: TListBox; + pnlButtons: TPanel; pnlMain: TPanel; pnlSearch: TPanel; sbStatus: TStatusBar; - Panel1: TPanel; - btnCancel: TButton; - btnOK: TButton; + chkForms: TCheckBox; + chkDataModules: TCheckBox; + chkProjectSource: TCheckBox; + pnlIncludeTypes: TPanel; + procedure TypeFilterChange(Sender: TObject); procedure edtSearchChange(Sender: TObject); procedure edtSearchKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); @@ -31,18 +49,26 @@ type procedure lstUnitsDrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState); private FUnitList: TUnSwUnitList; + FActiveUnit: TUnSwUnit; + FFormsOnly: Boolean; + FTypeFilteredList: TUnSwUnitList; FInputFilteredList: TUnSwUnitList; FTypeFilter: TUnSwUnitTypeFilter; FInputFilter: TUnSwUnitSimpleFilter; - function InternalExecute(const AUnits: TUnSwUnitList): Integer; + FIconVisitor: TUnSwIconVisitor; + + function InternalExecute(): TUnSwUnit; + procedure UpdateTypeFilter(); procedure UpdateList(); function GetActiveUnit(): TUnSwUnit; public - class function Execute(const AUnits: TUnSwUnitList): Integer; + class function Execute(const AUnits: TUnSwUnitList; + const AFormsOnly: Boolean; + const AActive: TUnSwUnit = nil): TUnSwUnit; end; implementation @@ -50,41 +76,74 @@ uses SysUtils, Graphics; + {$R *.dfm} + +{ TUnSwIconVisitor } +procedure TUnSwIconVisitor.VisitModule(const AUnit: TUnSwModuleUnit); +begin + case AUnit.UnitType of + swutForm: FImageIndex := 1; + swutDataModule: FImageIndex := 2; + else + FImageIndex := 0; + end; +end; + +procedure TUnSwIconVisitor.VisitProject(const AUnit: TUnSwProjectUnit); +begin + FImageIndex := 3; +end; + + { TfrmUnSwDialog } -class function TfrmUnSwDialog.Execute(const AUnits: TUnSwUnitList): Integer; +class function TfrmUnSwDialog.Execute(const AUnits: TUnSwUnitList; + const AFormsOnly: Boolean; + const AActive: TUnSwUnit): TUnSwUnit; begin with Self.Create(nil) do try - Result := InternalExecute(AUnits); + FUnitList := AUnits; + FActiveUnit := AActive; + FFormsOnly := AFormsOnly; + Result := InternalExecute(); finally Free(); end; end; - function SortByName(Item1, Item2: Pointer): Integer; begin Result := CompareText(TUnSwUnit(Item1).Name, TUnSwUnit(Item2).Name) end; -function TfrmUnSwDialog.InternalExecute(const AUnits: TUnSwUnitList): Integer; +function TfrmUnSwDialog.InternalExecute(): TUnSwUnit; begin - Result := -1; - FUnitList := AUnits; + Result := nil; + + if not FFormsOnly then + begin + chkForms.Checked := FTypeFilter.IncludeForms; + chkDataModules.Checked := FTypeFilter.IncludeDataModules; + chkProjectSource.Checked := FTypeFilter.IncludeProjectSource; + end else + pnlIncludeTypes.Visible := False; FTypeFilteredList := TUnSwUnitList.Create(); FInputFilteredList := TUnSwUnitList.Create(); - FTypeFilter := TUnSwUnitTypeFilter.Create(); - FInputFilter := TUnSwUnitSimpleFilter.Create(); + FTypeFilter := TUnSwUnitTypeFilter.Create(FTypeFilteredList); + FInputFilter := TUnSwUnitSimpleFilter.Create(FInputFilteredList); try - FTypeFilteredList.Clone(FUnitList); - FTypeFilteredList.ApplyFilter(FTypeFilter); - FTypeFilteredList.Sort(SortByName); - UpdateList(); + UpdateTypeFilter(); - Self.ShowModal(); + FIconVisitor := TUnSwIconVisitor.Create(); + try + if Self.ShowModal() = mrOk then + Result := GetActiveUnit(); + finally + FreeAndNil(FIconVisitor); + end; finally FreeAndNil(FInputFilter); FreeAndNil(FTypeFilter); @@ -99,10 +158,9 @@ var begin pActive := GetActiveUnit(); - // #ToDo1 Try to select the previous unit, otherwise select the first FInputFilteredList.Clone(FTypeFilteredList); - FInputFilteredList.ApplyFilter(FInputFilter); + FInputFilteredList.AcceptVisitor(FInputFilter); lstUnits.Count := FInputFilteredList.Count; if FInputFilteredList.Count > 0 then @@ -115,11 +173,28 @@ begin end; end; +procedure TfrmUnSwDialog.UpdateTypeFilter(); +begin + FTypeFilter.IncludeUnits := not FFormsOnly; + FTypeFilter.IncludeForms := (FFormsOnly or chkForms.Checked); + FTypeFilter.IncludeDataModules := ((not FFormsOnly) and chkDataModules.Checked); + FTypeFilter.IncludeProjectSource := ((not FFormsOnly) and chkProjectSource.Checked); + + FTypeFilteredList.Clone(FUnitList); + FTypeFilteredList.AcceptVisitor(FTypeFilter); + FTypeFilteredList.Sort(SortByName); + UpdateList(); +end; + function TfrmUnSwDialog.GetActiveUnit(): TUnSwUnit; begin - Result := nil; - if lstUnits.ItemIndex > -1 then - Result := FInputFilteredList[lstUnits.ItemIndex]; + Result := FActiveUnit; + if not Assigned(Result) then + begin + if lstUnits.ItemIndex > -1 then + Result := FInputFilteredList[lstUnits.ItemIndex]; + end else + FActiveUnit := nil; end; procedure TfrmUnSwDialog.edtSearchChange(Sender: TObject); @@ -134,14 +209,26 @@ begin if Shift = [] then case Key of VK_UP: - if lstUnits.ItemIndex > 0 then - lstUnits.ItemIndex := Pred(lstUnits.ItemIndex); + begin + if lstUnits.ItemIndex > 0 then + lstUnits.ItemIndex := Pred(lstUnits.ItemIndex); + + Key := 0; + end; VK_DOWN: - if lstUnits.ItemIndex < Pred(lstUnits.Items.Count) then - lstUnits.ItemIndex := Succ(lstUnits.ItemIndex); + begin + if lstUnits.ItemIndex < Pred(lstUnits.Items.Count) then + lstUnits.ItemIndex := Succ(lstUnits.ItemIndex); + + Key := 0; + end; end; end; +procedure TfrmUnSwDialog.TypeFilterChange(Sender: TObject); +begin + UpdateTypeFilter(); +end; procedure TfrmUnSwDialog.lstUnitsData(Control: TWinControl; Index: Integer; var Data: string); @@ -152,13 +239,15 @@ end; procedure TfrmUnSwDialog.lstUnitsDrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState); var - iIcon: Integer; + pUnit: TUnSwUnit; rText: TRect; sText: String; begin with TListBox(Control) do begin + pUnit := FInputFilteredList[Index]; + if odSelected in State then begin Canvas.Brush.Color := clHighlight; @@ -173,16 +262,11 @@ begin rText := Rect; InflateRect(rText, -2, -2); - iIcon := 0; - case FInputFilteredList[Index].UnitType of - swutForm: iIcon := 1; - swutDataModule: iIcon := 2; - swutProjUnit: iIcon := 3; - end; - ilsTypes.Draw(Canvas, rText.Left, rText.Top, iIcon); + pUnit.AcceptVisitor(FIconVisitor); + ilsTypes.Draw(Canvas, rText.Left, rText.Top, FIconVisitor.ImageIndex); Inc(rText.Left, ilsTypes.Width + 4); - sText := FInputFilteredList[Index].Name; + sText := pUnit.Name; DrawText(Canvas.Handle, PChar(sText), Length(sText), rText, DT_SINGLELINE or DT_LEFT or DT_VCENTER or DT_END_ELLIPSIS); end; diff --git a/Source/UnSwFilters.pas b/Source/UnSwFilters.pas new file mode 100644 index 0000000..5fb6b31 --- /dev/null +++ b/Source/UnSwFilters.pas @@ -0,0 +1,137 @@ +unit UnSwFilters; + +interface +uses + UnSwObjects; + +type + TUnSwUnitFilter = class(TUnSwNoRefIntfObject, IUnSwVisitor) + private + FList: TUnSwUnitList; + protected + // Called by default by all other Visit methods + procedure VisitUnit(const AUnit: TUnSwUnit); virtual; + + procedure VisitModule(const AUnit: TUnSwModuleUnit); virtual; + procedure VisitProject(const AUnit: TUnSwProjectUnit); virtual; + + procedure FilterUnit(const AUnit: TUnSwUnit); virtual; + public + constructor Create(const AList: TUnSwUnitList); virtual; + end; + + TUnSwUnitSimpleFilter = class(TUnSwUnitFilter) + private + FFilter: String; + + procedure SetFilter(const Value: String); + protected + procedure VisitUnit(const AUnit: TUnSwUnit); override; + public + property Filter: String read FFilter write SetFilter; + end; + + TUnSwUnitTypeFilter = class(TUnSwUnitFilter) + private + FIncludeDataModules: Boolean; + FIncludeForms: Boolean; + FIncludeProjectSource: Boolean; + FIncludeUnits: Boolean; + protected + procedure VisitModule(const AUnit: TUnSwModuleUnit); override; + procedure VisitProject(const AUnit: TUnSwProjectUnit); override; + public + constructor Create(const AList: TUnSwUnitList); override; + + property IncludeDataModules: Boolean read FIncludeDataModules write FIncludeDataModules; + property IncludeForms: Boolean read FIncludeForms write FIncludeForms; + property IncludeProjectSource: Boolean read FIncludeProjectSource write FIncludeProjectSource; + property IncludeUnits: Boolean read FIncludeUnits write FIncludeUnits; + end; + +implementation +uses + SysUtils; + + +{ TUnSwUnitFilter } +constructor TUnSwUnitFilter.Create(const AList: TUnSwUnitList); +begin + inherited Create(); + + Assert(Assigned(AList), 'List must be assigned.'); + FList := AList; +end; + +procedure TUnSwUnitFilter.VisitUnit(const AUnit: TUnSwUnit); +begin +end; + +procedure TUnSwUnitFilter.VisitModule(const AUnit: TUnSwModuleUnit); +begin + VisitUnit(AUnit); +end; + +procedure TUnSwUnitFilter.VisitProject(const AUnit: TUnSwProjectUnit); +begin + VisitUnit(AUnit); +end; + +procedure TUnSwUnitFilter.FilterUnit(const AUnit: TUnSwUnit); +begin + FList.Remove(AUnit); +end; + + +{ TUnSwUnitSimpleFilter } +procedure TUnSwUnitSimpleFilter.VisitUnit(const AUnit: TUnSwUnit); +begin + if (Length(FFilter) > 0) and + (AnsiPos(FFilter, LowerCase(AUnit.Name)) = 0) then + FilterUnit(AUnit); +end; + +procedure TUnSwUnitSimpleFilter.SetFilter(const Value: String); +begin + FFilter := LowerCase(Value); +end; + + +{ TUnSwUnitTypeFilter } +constructor TUnSwUnitTypeFilter.Create(const AList: TUnSwUnitList); +begin + inherited; + + FIncludeDataModules := True; + FIncludeForms := True; + FIncludeProjectSource := True; + FIncludeUnits := True; +end; + +procedure TUnSwUnitTypeFilter.VisitModule(const AUnit: TUnSwModuleUnit); +var + eValidTypes: TUnSwUnitTypes; + +begin + eValidTypes := []; + + if FIncludeDataModules then + Include(eValidTypes, swutDataModule); + + if FIncludeForms then + Include(eValidTypes, swutForm); + + if FIncludeUnits then + Include(eValidTypes, swutUnit); + + if not (AUnit.UnitType in eValidTypes) then + FilterUnit(AUnit); +end; + +procedure TUnSwUnitTypeFilter.VisitProject(const AUnit: TUnSwProjectUnit); +begin + if not FIncludeProjectSource then + FilterUnit(AUnit); +end; + +end. diff --git a/Source/UnSwObjects.pas b/Source/UnSwObjects.pas index 2460f88..29e0fff 100644 --- a/Source/UnSwObjects.pas +++ b/Source/UnSwObjects.pas @@ -8,7 +8,46 @@ uses type // Forward declarations - TUnSwUnitFilter = class; + TUnSwUnit = class; + TUnSwModuleUnit = class; + TUnSwProjectUnit = class; + + + IUnSwVisitor = interface + ['{A822C25B-5D0F-462F-94DD-47CD6235D79F}'] + procedure VisitModule(const AUnit: TUnSwModuleUnit); + procedure VisitProject(const AUnit: TUnSwProjectUnit); + end; + + IUnSwVisited = interface + ['{9540671E-184B-4DB6-A015-27B457C74C6C}'] + procedure AcceptVisitor(const AVisitor: IUnSwVisitor); + end; + + + TUnSwNoRefIntfObject = class(TPersistent, IInterface) + protected + // IInterface + function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall; + function _AddRef(): Integer; stdcall; + function _Release(): Integer; stdcall; + end; + + + TUnSwUnit = class(TUnSwNoRefIntfObject, IUnSwVisited) + protected + function GetName(): String; virtual; + function GetFileName(): String; virtual; + public + // IUnSwVisited + procedure AcceptVisitor(const AVisitor: IUnSwVisitor); virtual; abstract; + + procedure Activate(const ASource: Boolean); virtual; abstract; + + property Name: String read GetName; + property FileName: String read GetFileName; + end; + TUnSwUnitType = ( swutForm = 0, @@ -29,22 +68,38 @@ type ); TUnSwUnitTypes = set of TUnSwUnitType; - TUnSwUnit = class(TPersistent) + + TUnSwModuleUnit = class(TUnSwUnit) private FModule: IOTAModuleInfo; - - function GetName(): String; - function GetFileName(): String; + protected + function GetName(): String; override; + function GetFileName(): String; override; function GetUnitType(): TUnSwUnitType; public - constructor Create(const AModule: IOTAModuleInfo); virtual; + constructor Create(const AModule: IOTAModuleInfo); + procedure AcceptVisitor(const AVisitor: IUnSwVisitor); override; + + procedure Activate(const ASource: Boolean); override; - property Name: String read GetName; - property FileName: String read GetFileName; property UnitType: TUnSwUnitType read GetUnitType; end; - TUnSwUnitList = class(TPersistent) + TUnSwProjectUnit = class(TUnSwUnit) + private + FProject: IOTAProject; + protected + function GetName(): String; override; + function GetFileName(): String; override; + public + constructor Create(const AProject: IOTAProject); + procedure AcceptVisitor(const AVisitor: IUnSwVisitor); override; + + procedure Activate(const ASource: Boolean); override; + end; + + + TUnSwUnitList = class(TUnSwNoRefIntfObject, IUnSwVisited) private FItems: TObjectList; @@ -57,74 +112,94 @@ type function Add(const AUnit: TUnSwUnit): Integer; virtual; function IndexOf(const AUnit: TUnSwUnit): Integer; - procedure Sort(Compare: TListSortCompare); + function IndexOfFileName(const AFileName: String): Integer; + procedure Delete(const AIndex: Integer); + function Remove(const AUnit: TUnSwUnit): Integer; + procedure Sort(Compare: TListSortCompare); procedure Clone(const ASource: TUnSwUnitList); virtual; - procedure ApplyFilter(const AFilter: TUnSwUnitFilter); virtual; + + procedure AcceptVisitor(const AVisitor: IUnSwVisitor); property Count: Integer read GetCount; property Items[Index: Integer]: TUnSwUnit read GetItem write SetItem; default; end; - TUnSwUnitFilter = class(TObject) - protected - function IsFiltered(const AUnit: TUnSwUnit): Boolean; virtual; abstract; - public - constructor Create(); virtual; - end; - - TUnSwUnitSimpleFilter = class(TUnSwUnitFilter) - private - FFilter: String; - - procedure SetFilter(const Value: String); - protected - function IsFiltered(const AUnit: TUnSwUnit): Boolean; override; - public - property Filter: String read FFilter write SetFilter; - end; - - TUnSwUnitTypeFilter = class(TUnSwUnitFilter) - private - FIncludeDataModules: Boolean; - FIncludeForms: Boolean; - FIncludeProjectSource: Boolean; - protected - function IsFiltered(const AUnit: TUnSwUnit): Boolean; override; - public - constructor Create(); override; - - property IncludeDataModules: Boolean read FIncludeDataModules write FIncludeDataModules; - property IncludeForms: Boolean read FIncludeForms write FIncludeForms; - property IncludeProjectSource: Boolean read FIncludeProjectSource write FIncludeProjectSource; - end; - implementation uses SysUtils; +{ TUnSwNoRefIntfObject } +function TUnSwNoRefIntfObject.QueryInterface(const IID: TGUID; out Obj): HResult; +begin + if GetInterface(IID, Obj) then + Result := S_OK + else + Result := E_NOINTERFACE; +end; + +function TUnSwNoRefIntfObject._AddRef(): Integer; +begin + Result := -1; +end; + +function TUnSwNoRefIntfObject._Release(): Integer; +begin + Result := -1; +end; + + { TUnSwUnit } -constructor TUnSwUnit.Create(const AModule: IOTAModuleInfo); +function TUnSwUnit.GetName(): String; +begin + Result := ''; +end; + +function TUnSwUnit.GetFileName(): String; +begin + Result := ''; +end; + + +{ TUnSwModuleUnit } +constructor TUnSwModuleUnit.Create(const AModule: IOTAModuleInfo); begin inherited Create(); FModule := AModule; end; +procedure TUnSwModuleUnit.Activate(const ASource: Boolean); +var + ifModule: IOTAModule; -function TUnSwUnit.GetName(): String; +begin + ifModule := FModule.OpenModule(); + if Assigned(ifModule) then + if ASource then + ifModule.ShowFilename(ifModule.FileName) + else + ifModule.Show(); +end; + +procedure TUnSwModuleUnit.AcceptVisitor(const AVisitor: IUnSwVisitor); +begin + AVisitor.VisitModule(Self); +end; + +function TUnSwModuleUnit.GetName(): String; begin Result := FModule.Name; end; -function TUnSwUnit.GetFileName(): String; +function TUnSwModuleUnit.GetFileName(): String; begin Result := FModule.FileName; end; -function TUnSwUnit.GetUnitType(): TUnSwUnitType; +function TUnSwModuleUnit.GetUnitType(): TUnSwUnitType; begin Result := TUnSwUnitType(FModule.ModuleType); if (Result = swutForm) and (Length(FModule.FormName) = 0) then @@ -132,6 +207,35 @@ begin end; +{ TUnSwProjectUnit } +constructor TUnSwProjectUnit.Create(const AProject: IOTAProject); +begin + inherited Create(); + + FProject := AProject; +end; + +procedure TUnSwProjectUnit.Activate(const ASource: Boolean); +begin + FProject.ShowFilename(FProject.FileName); +end; + +procedure TUnSwProjectUnit.AcceptVisitor(const AVisitor: IUnSwVisitor); +begin + AVisitor.VisitProject(Self); +end; + +function TUnSwProjectUnit.GetName(): String; +begin + Result := ChangeFileExt(ExtractFileName(FProject.FileName), ''); +end; + +function TUnSwProjectUnit.GetFileName(): String; +begin + +end; + + { TUnSwUnitList} constructor TUnSwUnitList.Create(); begin @@ -149,6 +253,15 @@ begin end; +procedure TUnSwUnitList.AcceptVisitor(const AVisitor: IUnSwVisitor); +var + iItem: Integer; + +begin + for iItem := Pred(Count) downto 0 do + Items[iItem].AcceptVisitor(AVisitor); +end; + function TUnSwUnitList.Add(const AUnit: TUnSwUnit): Integer; begin Result := FItems.Add(AUnit); @@ -159,20 +272,36 @@ begin Result := FItems.IndexOf(AUnit); end; -procedure TUnSwUnitList.Sort(Compare: TListSortCompare); -begin - FItems.Sort(Compare); -end; - - -procedure TUnSwUnitList.ApplyFilter(const AFilter: TUnSwUnitFilter); +function TUnSwUnitList.IndexOfFileName(const AFileName: String): Integer; var iItem: Integer; begin + Result := -1; + if Length(AFileName) = 0 then + exit; + for iItem := Pred(Count) downto 0 do - if AFilter.IsFiltered(Items[iItem]) then - FItems.Delete(iItem); + if SameText(Items[iItem].FileName, AFileName) then + begin + Result := iItem; + break; + end; +end; + +procedure TUnSwUnitList.Delete(const AIndex: Integer); +begin + FItems.Delete(AIndex); +end; + +function TUnSwUnitList.Remove(const AUnit: TUnSwUnit): Integer; +begin + Result := FItems.Remove(AUnit); +end; + +procedure TUnSwUnitList.Sort(Compare: TListSortCompare); +begin + FItems.Sort(Compare); end; procedure TUnSwUnitList.Clone(const ASource: TUnSwUnitList); @@ -203,54 +332,4 @@ begin FItems[Index] := Value; end; - -{ TUnSwUnitFilter } -constructor TUnSwUnitFilter.Create(); -begin - inherited Create(); -end; - - -{ TUnSwUnitSimpleFilter } -function TUnSwUnitSimpleFilter.IsFiltered(const AUnit: TUnSwUnit): Boolean; -begin - Result := (Length(FFilter) > 0) and - (AnsiPos(FFilter, LowerCase(AUnit.Name)) = 0); -end; - -procedure TUnSwUnitSimpleFilter.SetFilter(const Value: String); -begin - FFilter := LowerCase(Value); -end; - - -{ TUnSwUnitTypeFilter } -constructor TUnSwUnitTypeFilter.Create(); -begin - inherited; - - FIncludeDataModules := True; - FIncludeForms := True; - FIncludeProjectSource := True; -end; - -function TUnSwUnitTypeFilter.IsFiltered(const AUnit: TUnSwUnit): Boolean; -var - eValidTypes: TUnSwUnitTypes; - -begin - eValidTypes := [swutUnit]; - - if FIncludeDataModules then - Include(eValidTypes, swutDataModule); - - if FIncludeForms then - Include(eValidTypes, swutForm); - - if FIncludeProjectSource then - Include(eValidTypes, swutProjUnit); - - Result := not (AUnit.UnitType in eValidTypes); -end; - end.