{ ***************************************************************************** * * * See the file COPYING.modifiedLGPL, included in this distribution, * * for details about the copyright. * * * * This program 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. * * * ***************************************************************************** Author: Mattias Gaertner Abstract: Interface to the IDE menus. } unit MenuIntf; {$mode objfpc}{$H+} interface uses Classes, SysUtils, LCLProc, Menus, ImgList, Graphics, LazHelpIntf, IDECommands; type TIDEMenuItem = class; TIDEMenuSection = class; TAddMenuItemProc = function (const NewCaption: string; const NewEnabled: boolean; const NewOnClick: TNotifyEvent): TIDEMenuItem of object; { TIDEMenuItem A menu item in one of the IDE's menus. This is only the base class for TIDEMenuSection and TIDEMenuCommand } { TIDEMenuItem } TIDEMenuItem = class(TPersistent) private FAutoFreeMenuItem: boolean; FBitmap: TBitmap; FCaption: string; FEnabled: Boolean; FHint: string; FImageIndex: Integer; FMenuItem: TMenuItem; FMenuItemClass: TMenuItemClass; FName: string; FOnClickMethod: TNotifyEvent; FOnClickProc: TNotifyProcedure; FSection: TIDEMenuSection; FSectionIndex: Integer; FSize: integer; FTag: Integer; FVisible: Boolean; FLastVisibleActive: boolean; procedure MenuItemDestroy(Sender: TObject); procedure BitmapChange(Sender: TObject); protected procedure MenuItemClick(Sender: TObject); virtual; function GetBitmap: TBitmap; virtual; function GetCaption: string; virtual; function GetHint: String; virtual; procedure SetBitmap(const AValue: TBitmap); virtual; procedure SetCaption(const AValue: string); virtual; procedure SetEnabled(const AValue: Boolean); virtual; procedure SetHint(const AValue: String); virtual; procedure SetImageIndex(const AValue: Integer); virtual; procedure SetMenuItem(const AValue: TMenuItem); virtual; procedure SetName(const AValue: string); virtual; procedure SetSection(const AValue: TIDEMenuSection); virtual; procedure SetVisible(const AValue: Boolean); virtual; procedure ClearMenuItems; virtual; public constructor Create(const TheName: string); virtual; destructor Destroy; override; function HasBitmap: Boolean; procedure CreateMenuItem; virtual; function GetPath: string; function GetRoot: TIDEMenuItem; function VisibleActive: boolean; virtual; function GetContainerSection: TIDEMenuSection; function GetContainerMenuItem: TMenuItem; function Size: integer; virtual; procedure WriteDebugReport(const Prefix: string; MenuItemDebugReport: boolean); virtual; procedure ConsistencyCheck; virtual; public property Name: string read FName write SetName; property Bitmap: TBitmap read GetBitmap write SetBitmap; property Hint: String read GetHint write SetHint; property ImageIndex: Integer read FImageIndex write SetImageIndex; property Visible: Boolean read FVisible write SetVisible; property OnClick: TNotifyEvent read FOnClickMethod write FOnClickMethod; property OnClickProc: TNotifyProcedure read FOnClickProc write FOnClickProc; property Caption: string read GetCaption write SetCaption; property Section: TIDEMenuSection read FSection write SetSection; property Enabled: Boolean read FEnabled write SetEnabled; property MenuItem: TMenuItem read FMenuItem write SetMenuItem; property MenuItemClass: TMenuItemClass read FMenuItemClass write FMenuItemClass; property SectionIndex: Integer read FSectionIndex; property AutoFreeMenuItem: boolean read FAutoFreeMenuItem write FAutoFreeMenuItem; property Tag: Integer read FTag write FTag; end; TIDEMenuItemClass = class of TIDEMenuItem; { TIDEMenuSection An TIDEMenuItem with childs, either in a sub menu or separated with separators. If no childs are visible, the section will not be visible. } { TIDEMenuSection } TIDEMenuSectionState = ( imssClearing ); TIDEMenuSectionStates = set of TIDEMenuSectionState; TIDEMenuSectionHandlerType = ( imshtOnShow // called before showing. Use this to enable/disable context sensitive items. ); TIDEMenuSection = class(TIDEMenuItem) private FBottomSeparator: TMenuItem; FChildMenuItemsCreated: boolean; FChildsAsSubMenu: boolean; FInvalidChildEndIndex: Integer; FInvalidChildStartIndex: Integer; FItems: TFPList; FNeedBottomSeparator: boolean; FNeedTopSeparator: boolean; FSectionHandlers: array[TIDEMenuSectionHandlerType] of TMethodList; FStates: TIDEMenuSectionStates; FSubMenuImages: TCustomImageList; FTopSeparator: TMenuItem; FUpdateLock: Integer; FVisibleCount: integer; function GetItems(Index: Integer): TIDEMenuItem; procedure SeparatorDestroy(Sender : TObject); procedure FreeSeparators; procedure AddHandler(HandlerType: TIDEMenuSectionHandlerType; const AMethod: TMethod; AsLast: boolean = false); procedure RemoveHandler(HandlerType: TIDEMenuSectionHandlerType; const AMethod: TMethod); protected procedure MenuItemClick(Sender: TObject); override; procedure SetMenuItem(const AValue: TMenuItem); override; procedure SetChildsAsSubMenu(const AValue: boolean); virtual; procedure SetSubMenuImages(const AValue: TCustomImageList); virtual; procedure ClearMenuItems; override; procedure ItemVisibleActiveChanged(AnItem: TIDEMenuItem); procedure UpdateChildsIndex(StartIndex: Integer); procedure UpdateMenuStructure; procedure UpdateSize(Diff: integer); procedure Invalidate(FromIndex, ToIndex: integer); public constructor Create(const TheName: string); override; destructor Destroy; override; procedure Clear; function Count: Integer; procedure AddFirst(AnItem: TIDEMenuItem); procedure AddLast(AnItem: TIDEMenuItem); procedure Insert(Index: Integer; AnItem: TIDEMenuItem); procedure Remove(AnItem: TIDEMenuItem); procedure CreateMenuItem; override; function GetContainerIndex(BehindSeparator: boolean): Integer; function GetChildContainerIndex(Index: integer): Integer; function IndexOf(AnItem: TIDEMenuItem): Integer; function IndexByName(const AName: string): Integer; function FindByName(const AName: string): TIDEMenuItem; function CreateUniqueName(const AName: string): string; function VisibleActive: boolean; override; function Size: integer; override; procedure BeginUpdate; procedure EndUpdate; procedure NotifySubSectionOnShow(Sender: TObject; WithChilds: Boolean = true); virtual; procedure RemoveAllHandlersOfObject(AnObject: TObject); procedure AddHandlerOnShow(const OnShowEvent: TNotifyEvent; AsLast: boolean = false); procedure RemoveHandlerOnShow(const OnShowEvent: TNotifyEvent); procedure WriteDebugReport(const Prefix: string; MenuItemDebugReport: boolean); override; procedure ConsistencyCheck; override; public property ChildsAsSubMenu: boolean read FChildsAsSubMenu write SetChildsAsSubMenu default true; property SubMenuImages: TCustomImageList read FSubMenuImages write SetSubMenuImages; property Items[Index: Integer]: TIDEMenuItem read GetItems; default; property TopSeparator: TMenuItem read FTopSeparator; property BottomSeparator: TMenuItem read FBottomSeparator; property NeedTopSeparator: boolean read FNeedTopSeparator; property NeedBottomSeparator: boolean read FNeedBottomSeparator; property VisibleCount: integer read FVisibleCount; // without grandchilds property States: TIDEMenuSectionStates read FStates; end; TIDEMenuSectionClass = class of TIDEMenuSection; { TIDEMenuCommand A leaf menu item. No childs. Hint: The shortcut is defined via the Command property. } TIDEMenuCommand = class(TIDEMenuItem) private FAutoCheck: boolean; FChecked: Boolean; FCommand: TIDECommand; FDefault: Boolean; FGroupIndex: Byte; FRadioItem: Boolean; FRightJustify: boolean; FShowAlwaysCheckable: boolean; protected procedure MenuItemClick(Sender: TObject); override; procedure SetAutoCheck(const AValue: boolean); virtual; procedure SetChecked(const AValue: Boolean); virtual; procedure SetDefault(const AValue: Boolean); virtual; procedure SetGroupIndex(const AValue: Byte); virtual; procedure SetRadioItem(const AValue: Boolean); virtual; procedure SetRightJustify(const AValue: boolean); virtual; procedure SetShowAlwaysCheckable(const AValue: boolean); virtual; procedure SetCommand(const AValue: TIDECommand); virtual; procedure SetMenuItem(const AValue: TMenuItem); override; procedure CommandChanged(Sender: TObject); public property Command: TIDECommand read FCommand write SetCommand; property AutoCheck: boolean read FAutoCheck write SetAutoCheck default False; property Checked: Boolean read FChecked write SetChecked default False; property Default: Boolean read FDefault write SetDefault default False; property GroupIndex: Byte read FGroupIndex write SetGroupIndex default 0; property RadioItem: Boolean read FRadioItem write SetRadioItem; property RightJustify: boolean read FRightJustify write SetRightJustify; property ShowAlwaysCheckable: boolean read FShowAlwaysCheckable write SetShowAlwaysCheckable; end; TIDEMenuCommandClass = class of TIDEMenuCommand; { TIDEMenuRoots These are the top level menu items of the IDE. } TIDEMenuRoots = class(TPersistent) private FItems: TFPList;// list of TIDEMenuSection function GetItems(Index: integer): TIDEMenuSection; public constructor Create; destructor Destroy; override; procedure RegisterMenuRoot(Section: TIDEMenuSection); procedure UnregisterMenuRoot(Section: TIDEMenuSection); function Count: Integer; procedure Clear; procedure Delete(Index: Integer); function IndexByName(const Name: string): Integer; function FindByName(const Name: string): TIDEMenuSection; function CreateUniqueName(const Name: string): string; function FindByPath(const Path: string; ErrorOnNotFound: boolean): TIDEMenuItem; public property Items[Index: integer]: TIDEMenuSection read GetItems; default; end; var IDEMenuRoots: TIDEMenuRoots = nil;// created by the IDE // IDE MainMenu mnuMain: TIDEMenuSection = nil; // file menu mnuFile: TIDEMenuSection; itmFileNew: TIDEMenuSection; itmFileOpenSave: TIDEMenuSection; itmFileRecentOpen: TIDEMenuSection; itmFileDirectories: TIDEMenuSection; itmFileIDEStart: TIDEMenuSection; // edit menu mnuEdit: TIDEMenuSection; itmEditReUndo: TIDEMenuSection; itmEditClipboard: TIDEMenuSection; itmEditBlockIndentation: TIDEMenuSection; itmEditBlockCharConversion: TIDEMenuSection; itmEditSelect: TIDEMenuSection; itmEditInsertions: TIDEMenuSection; itmEditInsertText: TIDEMenuSection; itmEditInsertCVSKeyWord: TIDEMenuSection; itmEditInsertGeneral: TIDEMenuSection; itmEditMenuCodeTools: TIDEMenuSection; // search menu mnuSearch: TIDEMenuSection; itmSearchFindReplace: TIDEMenuSection; itmJumpings: TIDEMenuSection; itmBookmarks: TIDEMenuSection; itmCodeToolSearches: TIDEMenuSection; // view menu mnuView: TIDEMenuSection; itmViewMainWindows: TIDEMenuSection; itmViewUnitWindows: TIDEMenuSection; itmViewSecondaryWindows: TIDEMenuSection; itmViewDebugWindows: TIDEMenuSection; // project menu mnuProject: TIDEMenuSection; itmProjectNewSection: TIDEMenuSection; itmProjectOpenSection: TIDEMenuSection; itmProjectRecentOpen: TIDEMenuSection; itmProjectSaveSection: TIDEMenuSection; itmProjectWindowSection: TIDEMenuSection; itmProjectAddRemoveSection: TIDEMenuSection; {$IFDEF TRANSLATESTRING} itmProjectPoFileSection: TIDEMenuSection; {$ENDIF} // run menu mnuRun: TIDEMenuSection; itmRunBuilding: TIDEMenuSection; itmRunnning: TIDEMenuSection; itmRunBuildingFile: TIDEMenuSection; itmRunDebugging: TIDEMenuSection; itmRunMenuAddBreakpoint: TIDEMenuSection; // components menu mnuComponents: TIDEMenuSection; itmPkgOpening: TIDEMenuSection; itmPkgOpenRecent: TIDEMenuSection; itmPkgUnits: TIDEMenuSection; itmPkgGraphSection: TIDEMenuSection; // tools menu mnuTools: TIDEMenuSection; itmCustomTools: TIDEMenuSection; itmCodeToolChecks: TIDEMenuSection; itmSecondaryTools: TIDEMenuSection; itmDelphiConversion: TIDEMenuSection; itmBuildingLazarus: TIDEMenuSection; // environment menu mnuEnvironment: TIDEMenuSection; itmOptionsDialogs: TIDEMenuSection; itmIDECacheSection: TIDEMenuSection; // windows menu mnuWindows: TIDEMenuSection; itmDesignerWindows: TIDEMenuSection; // help menu mnuHelp: TIDEMenuSection; itmOnlineHelps: TIDEMenuSection; itmInfoHelps: TIDEMenuSection; itmHelpTools: TIDEMenuSection; // Source Editor: Popupmenu SourceEditorMenuRoot: TIDEMenuSection = nil; // Source Editor: First dynamic section for often used context sensitive stuff // The items are cleared automatically after each popup. SrcEditMenuSectionFirstDynamic: TIDEMenuSection; SrcEditMenuSectionFirstStatic: TIDEMenuSection; SrcEditSubMenuFind: TIDEMenuSection; SrcEditMenuSectionClipboard: TIDEMenuSection; // Source Editor: File Specific dynamic section // The items are cleared automatically after each popup. SrcEditMenuSectionFileDynamic: TIDEMenuSection; SrcEditMenuSectionMarks: TIDEMenuSection; SrcEditSubMenuGotoBookmarks: TIDEMenuSection; SrcEditSubMenuSetBookmarks: TIDEMenuSection; SrcEditMenuSectionFlags: TIDEMenuSection; SrcEditMenuSectionHighlighter: TIDEMenuSection; SrcEditSubMenuDebug: TIDEMenuSection; SrcEditMenuSectionMovePage: TIDEMenuSection; SrcEditSubMenuRefactor: TIDEMenuSection; // Messages window popupmenu MessagesMenuRoot: TIDEMenuSection = nil; // CodeExplorer window popupmenu CodeExplorerMenuRoot: TIDEMenuSection = nil; // Code templates popupmenu CodeTemplatesMenuRoot: TIDEMenuSection = nil; // Designer: Popupmenu DesignerMenuRoot: TIDEMenuSection = nil; // Designer: Dynamic section for component editor DesignerMenuSectionComponentEditor: TIDEMenuSection; // Designer: custom dynamic section DesignerMenuSectionCustomDynamic: TIDEMenuSection; DesignerMenuSectionAlign: TIDEMenuSection; DesignerMenuSectionOrder: TIDEMenuSection; DesignerMenuSectionZOrder: TIDEMenuSection; DesignerMenuSectionClipboard: TIDEMenuSection; DesignerMenuSectionMisc: TIDEMenuSection; DesignerMenuSectionOptions: TIDEMenuSection; function RegisterIDEMenuRoot(const Name: string; MenuItem: TMenuItem = nil ): TIDEMenuSection; function RegisterIDEMenuSection(Parent: TIDEMenuSection; const Name: string): TIDEMenuSection; overload; function RegisterIDEMenuSection(const Path, Name: string): TIDEMenuSection; overload; function RegisterIDESubMenu(Parent: TIDEMenuSection; const Name, Caption: string; const OnClickMethod: TNotifyEvent = nil; const OnClickProc: TNotifyProcedure = nil ): TIDEMenuSection; overload; function RegisterIDESubMenu(const Path, Name, Caption: string; const OnClickMethod: TNotifyEvent = nil; const OnClickProc: TNotifyProcedure = nil ): TIDEMenuSection; overload; function RegisterIDEMenuCommand(Parent: TIDEMenuSection; const Name, Caption: string; const OnClickMethod: TNotifyEvent = nil; const OnClickProc: TNotifyProcedure = nil; const Command: TIDECommand = nil ): TIDEMenuCommand; overload; function RegisterIDEMenuCommand(const Path, Name, Caption: string; const OnClickMethod: TNotifyEvent = nil; const OnClickProc: TNotifyProcedure = nil; const Command: TIDECommand = nil ): TIDEMenuCommand; overload; implementation function RegisterIDEMenuRoot(const Name: string; MenuItem: TMenuItem ): TIDEMenuSection; begin //debugln('RegisterIDEMenuRoot Name="',Name,'"'); Result:=TIDEMenuSection.Create(Name); IDEMenuRoots.RegisterMenuRoot(Result); Result.MenuItem:=MenuItem; end; function RegisterIDEMenuSection(Parent: TIDEMenuSection; const Name: string ): TIDEMenuSection; begin Result:=TIDEMenuSection.Create(Name); Result.ChildsAsSubMenu:=false; Parent.AddLast(Result); end; function RegisterIDEMenuSection(const Path, Name: string): TIDEMenuSection; var Parent: TIDEMenuSection; begin //debugln('RegisterIDEMenuSection Path="',Path,'" Name="',Name,'"'); Parent:=IDEMenuRoots.FindByPath(Path,true) as TIDEMenuSection; Result:=RegisterIDEMenuSection(Parent,Name); end; function RegisterIDESubMenu(Parent: TIDEMenuSection; const Name, Caption: string; const OnClickMethod: TNotifyEvent; const OnClickProc: TNotifyProcedure): TIDEMenuSection; begin Result:=TIDEMenuSection.Create(Name); Result.ChildsAsSubMenu:=true; Result.Caption:=Caption; Result.OnClick:=OnClickMethod; Result.OnClickProc:=OnClickProc; Parent.AddLast(Result); end; function RegisterIDESubMenu(const Path, Name, Caption: string; const OnClickMethod: TNotifyEvent; const OnClickProc: TNotifyProcedure ): TIDEMenuSection; var Parent: TIDEMenuSection; begin //debugln('RegisterIDESubMenu Path="',Path,'" Name="',Name,'"'); Parent:=IDEMenuRoots.FindByPath(Path,true) as TIDEMenuSection; Result:=RegisterIDESubMenu(Parent,Name,Caption,OnClickMethod,OnClickProc); end; function RegisterIDEMenuCommand(Parent: TIDEMenuSection; const Name, Caption: string; const OnClickMethod: TNotifyEvent; const OnClickProc: TNotifyProcedure; const Command: TIDECommand ): TIDEMenuCommand; begin Result:=TIDEMenuCommand.Create(Name); Result.Caption:=Caption; Result.OnClick:=OnClickMethod; Result.OnClickProc:=OnClickProc; Result.Command:=Command; Parent.AddLast(Result); end; function RegisterIDEMenuCommand(const Path, Name, Caption: string; const OnClickMethod: TNotifyEvent; const OnClickProc: TNotifyProcedure; const Command: TIDECommand): TIDEMenuCommand; var Parent: TIDEMenuSection; begin //debugln('RegisterIDEMenuCommand Path="',Path,'" Name="',Name,'"'); Parent:=IDEMenuRoots.FindByPath(Path,true) as TIDEMenuSection; Result:=RegisterIDEMenuCommand(Parent,Name,Caption,OnClickMethod,OnClickProc, Command); end; { TIDEMenuItem } procedure TIDEMenuItem.MenuItemClick(Sender: TObject); begin if Assigned(OnClick) then OnClick(Self); if Assigned(OnClickProc) then OnClickProc(Self); end; procedure TIDEMenuItem.MenuItemDestroy(Sender: TObject); begin FMenuItem:=nil; FAutoFreeMenuItem:=false; end; procedure TIDEMenuItem.BitmapChange(Sender: TObject); begin if MenuItem<>nil then MenuItem.Bitmap:=Bitmap; end; procedure TIDEMenuItem.SetEnabled(const AValue: Boolean); begin if FEnabled=AValue then exit; FEnabled:=AValue; if MenuItem<>nil then MenuItem.Enabled:=Enabled; end; function TIDEMenuItem.GetBitmap: TBitmap; begin if FBitmap=nil then begin FBitmap:=TBitmap.Create; FBitmap.OnChange:=@BitmapChange; end; FBitmap.Transparent:=True; Result:=FBitmap; end; function TIDEMenuItem.GetCaption: string; begin if FCaption<>'' then Result:=FCaption else Result:=FName; end; function TIDEMenuItem.GetHint: String; begin Result:=FHint; end; procedure TIDEMenuItem.SetBitmap(const AValue: TBitmap); begin if FBitmap=AValue then exit; if AValue<>nil then Bitmap.Assign(AValue) else FBitmap.Free; if MenuItem<>nil then MenuItem.Bitmap:=FBitmap; end; procedure TIDEMenuItem.SetCaption(const AValue: string); begin FCaption:=AValue; if MenuItem<>nil then MenuItem.Caption:=Caption; end; procedure TIDEMenuItem.SetHint(const AValue: String); begin FHint:=AValue; if MenuItem<>nil then MenuItem.Hint:=Hint; end; procedure TIDEMenuItem.SetImageIndex(const AValue: Integer); begin if FImageIndex=AValue then exit; FImageIndex:=AValue; if MenuItem<>nil then MenuItem.ImageIndex:=ImageIndex; end; procedure TIDEMenuItem.SetMenuItem(const AValue: TMenuItem); begin if FMenuItem=AValue then exit; if FMenuItem<>nil then ClearMenuItems; if FMenuItem=nil then begin FMenuItem:=AValue; AutoFreeMenuItem:=false; if MenuItem<>nil then MenuItem.AddHandlerOnDestroy(@MenuItemDestroy); end; if MenuItem<>nil then begin MenuItem.Caption:=Caption; MenuItem.Bitmap:=FBitmap; MenuItem.Hint:=Hint; MenuItem.ImageIndex:=ImageIndex; MenuItem.Visible:=Visible; MenuItem.Enabled:=Enabled; MenuItem.OnClick:=@MenuItemClick; end; end; procedure TIDEMenuItem.SetName(const AValue: string); begin if FName=AValue then exit; FName:=AValue; end; procedure TIDEMenuItem.SetSection(const AValue: TIDEMenuSection); var OldSection: TIDEMenuSection; begin if FSection=AValue then exit; OldSection:=FSection; ClearMenuItems; if OldSection<>nil then OldSection.Remove(Self); FSection:=nil; if FSection<>nil then FSection.AddLast(Self); end; procedure TIDEMenuItem.SetVisible(const AValue: Boolean); var OldVisibleActive: Boolean; begin if FVisible=AValue then exit; OldVisibleActive:=VisibleActive; FVisible:=AValue; if MenuItem<>nil then MenuItem.Visible:=Visible; if (VisibleActive<>OldVisibleActive) and (Section<>nil) then Section.ItemVisibleActiveChanged(Self); end; procedure TIDEMenuItem.ClearMenuItems; begin if AutoFreeMenuItem then begin FAutoFreeMenuItem:=false; FMenuItem.Free; end; FMenuItem:=nil; end; constructor TIDEMenuItem.Create(const TheName: string); begin inherited Create; FSize:=1; FName:=TheName; FEnabled:=true; FVisible:=true; FMenuItemClass:=TMenuItem; FSectionIndex:=-1; FImageIndex:=-1; {$IFDEF VerboseMenuIntf} //debugln('TIDEMenuItem.Create ',dbgsName(Self),' Name="',Name,'"'); {$ENDIF} end; destructor TIDEMenuItem.Destroy; begin if Section<>nil then Section.Remove(Self); FreeAndNil(FBitmap); if FMenuItem<>nil then begin if FAutoFreeMenuItem then FreeAndNil(FMenuItem) else FMenuItem.RemoveAllHandlersOfObject(Self); end; inherited Destroy; end; function TIDEMenuItem.HasBitmap: Boolean; begin Result:=((FBitmap<>nil) and (not FBitmap.Empty)) or ((ImageIndex>=0) and (Section<>nil) and (Section.SubMenuImages<>nil) and (Section.SubMenuImages.Count>ImageIndex)); end; procedure TIDEMenuItem.CreateMenuItem; begin if FMenuItem<>nil then exit; {$IFDEF VerboseMenuIntf} //debugln('TIDEMenuItem.CreateMenuItem ',dbgsName(Self),' Name="',Name,'"'); {$ENDIF} MenuItem:=MenuItemClass.Create(nil); MenuItem.AddHandlerOnDestroy(@MenuItemDestroy); AutoFreeMenuItem:=true; end; function TIDEMenuItem.GetPath: string; var Item: TIDEMenuItem; begin Result:=Name; Item:=Section; while Item<>nil do begin Result:=Item.Name+'/'+Result; Item:=Item.Section; end; end; function TIDEMenuItem.GetRoot: TIDEMenuItem; begin Result:=Self; while Result.Section<>nil do Result:=Result.Section; end; function TIDEMenuItem.VisibleActive: boolean; // true if Visible=true and not hidden // false if menu item is hidden (e.g. due to no context, see TIDEMenuSection) begin Result:=Visible; end; function TIDEMenuItem.GetContainerSection: TIDEMenuSection; begin if Self is TIDEMenuSection then Result:=TIDEMenuSection(Self) else Result:=Section; while (Result<>nil) and (not Result.ChildsAsSubMenu) do Result:=Result.Section; end; function TIDEMenuItem.GetContainerMenuItem: TMenuItem; var ASection: TIDEMenuSection; begin ASection:=GetContainerSection; if (ASection<>nil) then Result:=ASection.MenuItem else Result:=nil; end; function TIDEMenuItem.Size: integer; begin Result:=FSize; end; procedure TIDEMenuItem.WriteDebugReport(const Prefix: string; MenuItemDebugReport: boolean); begin debugln(Prefix,'SectionIndex=',dbgs(SectionIndex),' Name="',DbgStr(Name),'"', ' VisibleActive=',dbgs(VisibleActive)); if MenuItemDebugReport and (MenuItem<>nil) then MenuItem.WriteDebugReport(Prefix); end; procedure TIDEMenuItem.ConsistencyCheck; procedure RaiseError; var s: String; begin s:='TIDEMenuItem.ConsistencyCheck Name="'+Name+'" Caption="'+DbgStr(Caption)+'"'; debugln(s); RaiseGDBException(s); end; begin if MenuItem<>nil then begin if MenuItem.HasBitmap<>HasBitmap then RaiseError; if MenuItem.Enabled<>Enabled then RaiseError; if MenuItem.Visible<>Visible then RaiseError; if MenuItem.Caption<>Caption then RaiseError; if MenuItem.ImageIndex<>ImageIndex then RaiseError; if MenuItem.Hint<>Hint then RaiseError; end; if (Section=nil) then begin if SectionIndex<>-1 then RaiseError; end else begin if SectionIndex<0 then RaiseError; end; end; { TIDEMenuSection } procedure TIDEMenuSection.SetSubMenuImages(const AValue: TCustomImageList); begin if FSubMenuImages=AValue then exit; FSubMenuImages:=AValue; if MenuItem<>nil then MenuItem.SubMenuImages:=SubMenuImages; end; procedure TIDEMenuSection.ClearMenuItems; var i: Integer; begin FreeSeparators; for i:=0 to Count-1 do Items[i].ClearMenuItems; inherited ClearMenuItems; end; procedure TIDEMenuSection.UpdateChildsIndex(StartIndex: Integer); var i: LongInt; begin for i:=StartIndex to FItems.Count-1 do Items[i].FSectionIndex:=i; end; procedure TIDEMenuSection.UpdateMenuStructure; // updates all FNeedBottomSeparator and FNeedTopSeparator var ContainerMenuItem: TMenuItem; ContainerMenuIndex: integer; Item: TIDEMenuItem; CurSection: TIDEMenuSection; procedure UpdateNeedTopSeparator; // a separator at top is needed, if // - this section is imbedded (not ChildsAsSubMenu) // - and this section is visible // - and this section has visible childs // - and there is a visible menu item in front var i: Integer; NewNeedTopSeparator: Boolean; begin NewNeedTopSeparator:=false; if (not ChildsAsSubMenu) and (Section<>nil) and VisibleActive then begin // check for any visible item in front i:=SectionIndex-1; while i>=0 do begin if Section[i].VisibleActive then begin // there is a visible menu item in front // => the Top separator is needed //debugln('TIDEMenuSection.UpdateNeedTopSeparator Name="',Name,'" ItemInFront="',Section[i].Name,'"'); NewNeedTopSeparator:=true; break; end; dec(i); end; end; if NewNeedTopSeparator<>FNeedTopSeparator then begin FNeedTopSeparator:=NewNeedTopSeparator; if FNeedTopSeparator then UpdateSize(1) else UpdateSize(-1); end; if ContainerMenuItem=nil then exit; if FNeedTopSeparator<>(TopSeparator<>nil) then begin // FNeedTopSeparator has changed if TopSeparator<>nil then begin // TopSeparator is not needed anymore FreeAndNil(FTopSeparator); {$IFDEF VerboseMenuIntf} debugln('TIDEMenuSection.UpdateMenuStructure FREE TopSeparator Name="',Name,'"'); {$ENDIF} end else begin // TopSeparator is needed FTopSeparator:=TMenuItem.Create(nil); FTopSeparator.AddHandlerOnDestroy(@SeparatorDestroy); FTopSeparator.Caption:='-'; {$IFDEF VerboseMenuIntf} debugln('TIDEMenuSection.UpdateNeedTopSeparator CREATE TopSeparator Name="',Name,'" ContainerMenuIndex=',dbgs(ContainerMenuIndex),' ContainerMenuItem.Count=',dbgs(ContainerMenuItem.Count)); {$ENDIF} if ContainerMenuIndex>ContainerMenuItem.Count then begin debugln('TIDEMenuSection.UpdateNeedTopSeparator CREATE TopSeparator Name="',Name,'" ContainerMenuIndex=',dbgs(ContainerMenuIndex),' ContainerMenuItem.Count=',dbgs(ContainerMenuItem.Count)); GetRoot.WriteDebugReport(' Top ',true); end; ContainerMenuItem.Insert(ContainerMenuIndex,FTopSeparator); end; end; end; procedure UpdateNeedBottomSeparator; // a separator at bottom is needed, if // - this section is imbedded (not ChildsAsSubMenu) // - and this section is visible // - and this section has visible childs // - and there is a visible menu item behind and it has no top separator var ItemBehind: TIDEMenuItem; i: Integer; NewNeedBottomSeparator: Boolean; begin NewNeedBottomSeparator:=false; //debugln('TIDEMenuSection.UpdateNeedBottomSeparator Name="',Name,'" ChildsAsSubMenu=',dbgs(ChildsAsSubMenu),' Section=',dbgs(Section<>nil),' VisibleActive=',dbgs(VisibleActive)); if (not ChildsAsSubMenu) and (Section<>nil) and VisibleActive then begin // check for any visible item in front i:=SectionIndex+1; while iFInvalidChildEndIndex) then exit; if FUpdateLock>0 then begin exit; end; if FInvalidChildStartIndex<0 then FInvalidChildStartIndex:=0; if (Section<>nil) and (not Section.ChildsAsSubMenu) and (Section.FInvalidChildStartIndex<=SectionIndex) then begin // the sections in front need update too // => start the update in front {$IFDEF VerboseMenuIntf} debugln('TIDEMenuSection.UpdateMenuStructure Front Section="',Section.Name,'" Name="',Name,'" Section.Invalid=',dbgs(Section.FInvalidChildStartIndex),'..',dbgs(Section.FInvalidChildEndIndex),' Count=',dbgs(Count),' SectionIndex=',dbgs(SectionIndex)); {$ENDIF} Section.UpdateMenuStructure; end else if FInvalidChildStartIndexnil) and (OldVisibleActive<>VisibleActive) then Section.ItemVisibleActiveChanged(Self); EndUpdate; end; function TIDEMenuSection.Count: Integer; begin Result:=FItems.Count; end; procedure TIDEMenuSection.AddFirst(AnItem: TIDEMenuItem); begin Insert(0,AnItem); end; procedure TIDEMenuSection.AddLast(AnItem: TIDEMenuItem); begin Insert(Count,AnItem); end; procedure TIDEMenuSection.Insert(Index: Integer; AnItem: TIDEMenuItem); begin AnItem.fName:=CreateUniqueName(AnItem.Name); FItems.Insert(Index,AnItem); UpdateChildsIndex(Index); UpdateSize(AnItem.Size); AnItem.FSection:=Self; if AnItem.VisibleActive then ItemVisibleActiveChanged(AnItem); {$IFDEF VerboseMenuIntf} ConsistencyCheck; {$ENDIF} end; procedure TIDEMenuSection.Remove(AnItem: TIDEMenuItem); var OldVisibleActive: Boolean; begin if not (imssClearing in FStates) then begin OldVisibleActive:=AnItem.VisibleActive; FItems.Delete(AnItem.SectionIndex); UpdateChildsIndex(AnItem.SectionIndex); end; UpdateSize(-AnItem.Size); AnItem.FSection:=nil; if not (imssClearing in FStates) then begin if OldVisibleActive then ItemVisibleActiveChanged(AnItem); // set the Index as last AnItem.FSectionIndex:=0; end; end; procedure TIDEMenuSection.CreateMenuItem; begin if ChildsAsSubMenu then inherited CreateMenuItem; end; function TIDEMenuSection.GetContainerIndex(BehindSeparator: boolean): Integer; var SiblingIndex: Integer; begin Result:=0; if (Section=nil) then exit; // get the start of the parent Section if not Section.ChildsAsSubMenu then inc(Result,Section.GetContainerIndex(true)); // add all siblings in front SiblingIndex:=0; while (Section[SiblingIndex]<>Self) do begin inc(Result,Section[SiblingIndex].Size); inc(SiblingIndex); end; // add separator if BehindSeparator and NeedTopSeparator then inc(Result); end; function TIDEMenuSection.GetChildContainerIndex(Index: integer): Integer; var i: Integer; begin if ChildsAsSubMenu then Result:=0 else Result:=GetContainerIndex(true); for i:=0 to Index-1 do inc(Result,Items[i].Size); end; function TIDEMenuSection.IndexOf(AnItem: TIDEMenuItem): Integer; begin Result:=FItems.IndexOf(AnItem); end; function TIDEMenuSection.IndexByName(const AName: string): Integer; begin Result:=Count-1; while (Result>=0) and (CompareText(AName,Items[Result].Name)<>0) do dec(Result); end; function TIDEMenuSection.FindByName(const AName: string): TIDEMenuItem; var i: LongInt; begin i:=IndexByName(AName); if i>=0 then Result:=Items[i] else Result:=nil; end; function TIDEMenuSection.CreateUniqueName(const AName: string): string; begin Result:=AName; if IndexByName(Result)<0 then exit; Result:=CreateFirstIdentifier(Result); while IndexByName(Result)>=0 do Result:=CreateNextIdentifier(Result); end; function TIDEMenuSection.VisibleActive: boolean; begin Result:=VisibleCount>0; end; function TIDEMenuSection.Size: integer; begin if ChildsAsSubMenu then Result:=1 else Result:=inherited Size; end; procedure TIDEMenuSection.BeginUpdate; begin inc(FUpdateLock); end; procedure TIDEMenuSection.EndUpdate; begin if FUpdateLock<=0 then RaiseGDBException('TIDEMenuSection.EndUpdate'); dec(FUpdateLock); if FUpdateLock=0 then UpdateMenuStructure; end; procedure TIDEMenuSection.RemoveAllHandlersOfObject(AnObject: TObject); var HandlerType: TIDEMenuSectionHandlerType; begin for HandlerType:=Low(TIDEMenuSectionHandlerType) to High(TIDEMenuSectionHandlerType) do FSectionHandlers[HandlerType].RemoveAllMethodsOfObject(AnObject); end; procedure TIDEMenuSection.AddHandlerOnShow(const OnShowEvent: TNotifyEvent; AsLast: boolean); begin AddHandler(imshtOnShow,TMethod(OnShowEvent)); end; procedure TIDEMenuSection.RemoveHandlerOnShow(const OnShowEvent: TNotifyEvent); begin RemoveHandler(imshtOnShow,TMethod(OnShowEvent)); end; procedure TIDEMenuSection.WriteDebugReport(const Prefix: string; MenuItemDebugReport: boolean); var i: Integer; begin debugln([Prefix,'SectionIndex=',SectionIndex,' Name="',DbgStr(Name),'"', ' VisibleActive=',VisibleActive, ' ChildsAsSubMenu=',ChildsAsSubMenu, ' ContainerIndex=',GetContainerIndex(false), ' NeedSep:Top=',NeedTopSeparator,',Bottom=',NeedBottomSeparator, ' Size='+dbgs(Size)]); for i:=0 to Count-1 do Items[i].WriteDebugReport(Prefix+' ',false); if MenuItemDebugReport and (MenuItem<>nil) then MenuItem.WriteDebugReport(Prefix); end; procedure TIDEMenuSection.ConsistencyCheck; var i: Integer; Item: TIDEMenuItem; RealVisibleCount: Integer; begin inherited ConsistencyCheck; RealVisibleCount:=0; for i:=0 to Count-1 do begin Item:=Items[i]; Item.ConsistencyCheck; if Item.SectionIndex<>i then RaiseGDBException(''); if Item.VisibleActive then inc(RealVisibleCount); end; if RealVisibleCount<>VisibleCount then RaiseGDBException(''); end; function TIDEMenuSection.GetItems(Index: Integer): TIDEMenuItem; begin Result:=TIDEMenuItem(FItems[Index]); end; procedure TIDEMenuSection.SeparatorDestroy(Sender: TObject); begin if Sender=FTopSeparator then FTopSeparator:=nil; if Sender=FBottomSeparator then FBottomSeparator:=nil; end; procedure TIDEMenuSection.FreeSeparators; begin if FNeedTopSeparator then begin UpdateSize(-1); FNeedTopSeparator:=false; end; FreeAndNil(FTopSeparator); if FNeedBottomSeparator then begin UpdateSize(-1); FNeedBottomSeparator:=false; end; FreeAndNil(FBottomSeparator); end; procedure TIDEMenuSection.AddHandler(HandlerType: TIDEMenuSectionHandlerType; const AMethod: TMethod; AsLast: boolean); begin if FSectionHandlers[HandlerType]=nil then FSectionHandlers[HandlerType]:=TMethodList.Create; FSectionHandlers[HandlerType].Add(AMethod); end; procedure TIDEMenuSection.RemoveHandler( HandlerType: TIDEMenuSectionHandlerType; const AMethod: TMethod); begin FSectionHandlers[HandlerType].Remove(AMethod); end; procedure TIDEMenuSection.MenuItemClick(Sender: TObject); begin inherited MenuItemClick(Sender); NotifySubSectionOnShow(Sender); end; procedure TIDEMenuSection.SetMenuItem(const AValue: TMenuItem); begin if MenuItem=AValue then exit; inherited SetMenuItem(AValue); Invalidate(0,Count-1); {$IFDEF VerboseMenuIntf} debugln('TIDEMenuSection.SetMenuItem Name="',Name,'"'); {$ENDIF} UpdateMenuStructure; end; procedure TIDEMenuSection.SetChildsAsSubMenu(const AValue: boolean); begin if FChildsAsSubMenu=AValue then exit; FChildsAsSubMenu:=AValue; ClearMenuItems; if Section<>nil then begin Section.Invalidate(SectionIndex,SectionIndex); {$IFDEF VerboseMenuIntf} debugln('TIDEMenuSection.SetChildsAsSubMenu Name="',Name,'"'); {$ENDIF} Section.UpdateMenuStructure; end; end; { TIDEMenuCommand } procedure TIDEMenuCommand.CommandChanged(Sender: TObject); begin //DebugLn('TIDEMenuCommand.CommandChanged ',Name); if MenuItem<>nil then if FCommand<>nil then MenuItem.ShortCut:=IDEShortCutToMenuShortCut(FCommand.ShortcutA) else MenuItem.ShortCut:=0; end; procedure TIDEMenuCommand.MenuItemClick(Sender: TObject); begin inherited MenuItemClick(Sender); if (Command<>nil) then Command.Execute(Sender); end; procedure TIDEMenuCommand.SetAutoCheck(const AValue: boolean); begin if FAutoCheck=AValue then exit; FAutoCheck:=AValue; if MenuItem<>nil then MenuItem.AutoCheck:=AutoCheck; end; procedure TIDEMenuCommand.SetChecked(const AValue: Boolean); begin if FChecked=AValue then exit; FChecked:=AValue; if MenuItem<>nil then MenuItem.Checked:=Checked; end; procedure TIDEMenuCommand.SetDefault(const AValue: Boolean); begin if FDefault=AValue then exit; FDefault:=AValue; if MenuItem<>nil then MenuItem.Default:=Default; end; procedure TIDEMenuCommand.SetGroupIndex(const AValue: Byte); begin if FGroupIndex=AValue then exit; FGroupIndex:=AValue; if MenuItem<>nil then MenuItem.GroupIndex:=GroupIndex; end; procedure TIDEMenuCommand.SetRadioItem(const AValue: Boolean); begin if FRadioItem=AValue then exit; FRadioItem:=AValue; if MenuItem<>nil then MenuItem.RadioItem:=RadioItem; end; procedure TIDEMenuCommand.SetRightJustify(const AValue: boolean); begin if FRightJustify=AValue then exit; FRightJustify:=AValue; if MenuItem<>nil then MenuItem.RightJustify:=RightJustify; end; procedure TIDEMenuCommand.SetShowAlwaysCheckable(const AValue: boolean); begin if FShowAlwaysCheckable=AValue then exit; FShowAlwaysCheckable:=AValue; if MenuItem<>nil then MenuItem.ShowAlwaysCheckable:=ShowAlwaysCheckable; end; procedure TIDEMenuCommand.SetCommand(const AValue: TIDECommand); begin if FCommand=AValue then exit; if FCommand<>nil then begin //DebugLn('TIDEMenuCommand.SetCommand OLD ',ShortCutToText(FCommand.AsShortCut),' FCommand.Name=',FCommand.Name,' Name=',Name,' FCommand=',dbgs(Pointer(FCommand))); FCommand.OnChange:=nil; end; FCommand:=AValue; if FCommand<>nil then begin FCommand.OnChange:=@CommandChanged; //DebugLn('TIDEMenuCommand.SetCommand NEW ',ShortCutToText(FCommand.AsShortCut),' FCommand.Name=',FCommand.Name,' Name=',Name,' FCommand=',dbgs(Pointer(FCommand))); end; CommandChanged(nil); end; procedure TIDEMenuCommand.SetMenuItem(const AValue: TMenuItem); begin inherited SetMenuItem(AValue); if MenuItem<>nil then begin MenuItem.AutoCheck:=AutoCheck; MenuItem.Checked:=Checked; MenuItem.Default:=Default; MenuItem.RadioItem:=RadioItem; MenuItem.RightJustify:=RightJustify; MenuItem.ShowAlwaysCheckable:=ShowAlwaysCheckable; if Command<>nil then MenuItem.ShortCut:=IDEShortCutToMenuShortCut(Command.ShortcutA) else MenuItem.ShortCut:=ShortCut(0,[]); MenuItem.GroupIndex:=GroupIndex; end; end; { TIDEMenuRoots } function TIDEMenuRoots.GetItems(Index: integer): TIDEMenuSection; begin Result:=TIDEMenuSection(FItems[Index]); end; constructor TIDEMenuRoots.Create; begin FItems:=TFPList.Create; end; destructor TIDEMenuRoots.Destroy; begin Clear; FItems.Free; inherited Destroy; end; procedure TIDEMenuRoots.RegisterMenuRoot(Section: TIDEMenuSection); begin Section.FName:=CreateUniqueName(Section.Name); FItems.Add(Section); end; procedure TIDEMenuRoots.UnregisterMenuRoot(Section: TIDEMenuSection); begin FItems.Remove(Section); end; function TIDEMenuRoots.Count: Integer; begin Result:=FItems.Count; end; procedure TIDEMenuRoots.Clear; var i: Integer; begin for i:=FItems.Count-1 downto 0 do begin Items[i].ClearMenuItems; Items[i].Free; end; FItems.Clear; end; procedure TIDEMenuRoots.Delete(Index: Integer); var OldItem: TIDEMenuSection; begin OldItem:=Items[Index]; UnregisterMenuRoot(OldItem); OldItem.Free; end; function TIDEMenuRoots.IndexByName(const Name: string): Integer; begin Result:=Count-1; while (Result>=0) and (CompareText(Name,Items[Result].Name)<>0) do dec(Result); end; function TIDEMenuRoots.FindByName(const Name: string): TIDEMenuSection; var i: LongInt; begin i:=IndexByName(Name); if i>=0 then Result:=Items[i] else Result:=nil; end; function TIDEMenuRoots.CreateUniqueName(const Name: string): string; begin Result:=Name; if IndexByName(Result)<0 then exit; Result:=CreateFirstIdentifier(Result); while IndexByName(Result)>=0 do Result:=CreateNextIdentifier(Result); end; function TIDEMenuRoots.FindByPath(const Path: string; ErrorOnNotFound: boolean): TIDEMenuItem; var StartPos: Integer; EndPos: LongInt; Name: String; begin Result:=nil; StartPos:=1; while StartPos<=length(Path) do begin EndPos:=StartPos; while (EndPos<=length(Path)) and (Path[EndPos]<>'/') do inc(EndPos); if EndPos>StartPos then begin Name:=copy(Path,StartPos,EndPos-StartPos); if Result=nil then // search root Result:=FindByName(Name) else if Result is TIDEMenuSection then // search child Result:=TIDEMenuSection(Result).FindByName(Name) else // path too long -> we are already at a leaf Result:=nil; if Result=nil then break; end; StartPos:=EndPos+1; end; if Result=nil then begin if ErrorOnNotFound then begin raise Exception.Create('IDE Menu path not found: '+Path); end; end; end; end.