diff --git a/src/ce_gdb.pas b/src/ce_gdb.pas index 193b0c3c..08afc1e2 100644 --- a/src/ce_gdb.pas +++ b/src/ce_gdb.pas @@ -315,7 +315,7 @@ type TAddWatchPointKind = (wpkRead, wpkWrite, wpkReadWrite); { TCEGdbWidget } - TCEGdbWidget = class(TCEWidget, ICEProjectObserver, ICEDocumentObserver, ICEDebugger, ICEMainMenuProvider) + TCEGdbWidget = class(TCEWidget, ICEProjectObserver, ICEDocumentObserver, ICEDebugger) btnContinue: TCEToolButton; btnVariables: TCEToolButton; btnNext: TCEToolButton; @@ -373,7 +373,6 @@ type fOutputName: string; fInputName: string; fShowFromCustomCommand: boolean; - fUpdateMenu: boolean; fGdbState: TGdbState; fSubj: TCEDebugObserverSubject; fDoc: TCESynMemo; @@ -392,12 +391,9 @@ type fOptions: TCEDebugOptions; fAddWatchPointKind: TAddWatchPointKind; fBreakPoints: TPersistentBreakPoints; - // + fMenu: TMenuItem; + procedure updateMenu; procedure optionsChangesApplied(sender: TObject); - procedure menuDeclare(item: TMenuItem); - procedure menuUpdate(item: TMenuItem); - function menuHasItems: boolean; - // procedure disableEditor; procedure setState(value: TGdbState); procedure updateButtonsState; @@ -951,6 +947,7 @@ begin fAddWatchPointKind := wpkWrite; fBreakPoints := TPersistentBreakPoints.create(self); // + updateMenu; AssignPng(btnSendCom, 'ACCEPT'); setState(gsNone); end; @@ -976,157 +973,136 @@ begin btnSendCom.Flat:=value; end; -procedure TCEGdbWidget.menuDeclare(item: TMenuItem); +procedure TCEGdbWidget.updateMenu; var + mnu: ICEMainMenu; itm: TMenuItem; bmp: TBitmap; i: integer; begin - item.Caption:='Debugger'; - item.Clear; + mnu := getMainMenu; + if not assigned(mnu) then + exit; + + if fMenu.isNil then + begin + fMenu := mnu.mnuAdd; + fMenu.Caption:='Debugger'; + end; + fMenu.Clear; bmp := TBitmap.Create; - itm := TMenuItem.Create(item); + itm := TMenuItem.Create(fMenu); itm.ShortCut:=fOptions.shortcuts.start; itm.Caption:='Start'; itm.OnClick:= @executeFromShortcut; itm.Tag:=0; - item.Add(itm); + fMenu.Add(itm); btnStart.toBitmap(bmp); itm.Bitmap.Assign(bmp); - i := item.GetImageList.Add(bmp, nil); + i := fMenu.GetImageList.Add(bmp, nil); itm.ImageIndex:= i; - itm := TMenuItem.Create(item); + itm := TMenuItem.Create(fMenu); itm.ShortCut:=fOptions.shortcuts.stop; itm.Caption:='Stop'; itm.OnClick:= @executeFromShortcut; itm.Tag:=1; - item.Add(itm); + fMenu.Add(itm); btnStop.toBitmap(bmp); itm.Bitmap.Assign(bmp); - i := item.GetImageList.Add(bmp, nil); + i := fMenu.GetImageList.Add(bmp, nil); itm.ImageIndex:= i; - itm := TMenuItem.Create(item); + itm := TMenuItem.Create(fMenu); itm.ShortCut:=fOptions.shortcuts.pause; itm.Caption:='Pause'; itm.OnClick:= @executeFromShortcut; itm.Tag:=2; - item.Add(itm); + fMenu.Add(itm); btnPause.toBitmap(bmp); itm.Bitmap.Assign(bmp); - i := item.GetImageList.Add(bmp, nil); + i := fMenu.GetImageList.Add(bmp, nil); itm.ImageIndex:= i; - itm := TMenuItem.Create(item); + itm := TMenuItem.Create(fMenu); itm.ShortCut:=fOptions.shortcuts.continue; itm.Caption:='Continue'; itm.OnClick:= @executeFromShortcut; itm.Tag:=3; - item.Add(itm); + fMenu.Add(itm); btnContinue.toBitmap(bmp); itm.Bitmap.Assign(bmp); - i := item.GetImageList.Add(bmp, nil); + i := fMenu.GetImageList.Add(bmp, nil); itm.ImageIndex:= i; - itm := TMenuItem.Create(item); + itm := TMenuItem.Create(fMenu); itm.ShortCut:=fOptions.shortcuts.step; itm.Caption:='Step'; itm.OnClick:= @executeFromShortcut; itm.Tag:=4; - item.Add(itm); + fMenu.Add(itm); btnNext.toBitmap(bmp); itm.Bitmap.Assign(bmp); - i := item.GetImageList.Add(bmp, nil); + i := fMenu.GetImageList.Add(bmp, nil); itm.ImageIndex:= i; - itm := TMenuItem.Create(item); + itm := TMenuItem.Create(fMenu); itm.ShortCut:=fOptions.shortcuts.stepOver; itm.Caption:='Step over'; itm.OnClick:= @executeFromShortcut; itm.Tag:=5; - item.Add(itm); + fMenu.Add(itm); btnOver.toBitmap(bmp); itm.Bitmap.Assign(bmp); - i := item.GetImageList.Add(bmp, nil); + i := fMenu.GetImageList.Add(bmp, nil); itm.ImageIndex:= i; - itm := TMenuItem.Create(item); + itm := TMenuItem.Create(fMenu); itm.Caption:= '-'; itm.Tag:=-1; - item.Add(itm); + fMenu.Add(itm); - itm := TMenuItem.Create(item); + itm := TMenuItem.Create(fMenu); itm.ShortCut:=fOptions.shortcuts.updateRegisters; itm.Caption:='Update registers'; itm.OnClick:= @executeFromShortcut; itm.Tag:=6; - item.Add(itm); + fMenu.Add(itm); btnReg.toBitmap(bmp); itm.Bitmap.Assign(bmp); - i := item.GetImageList.Add(bmp, nil); + i := fMenu.GetImageList.Add(bmp, nil); itm.ImageIndex:= i; - itm := TMenuItem.Create(item); + itm := TMenuItem.Create(fMenu); itm.ShortCut:=fOptions.shortcuts.updateStack; itm.Caption:='Update call stack'; itm.OnClick:= @executeFromShortcut; itm.Tag:=7; - item.Add(itm); + fMenu.Add(itm); btnStack.toBitmap(bmp); itm.Bitmap.Assign(bmp); - i := item.GetImageList.Add(bmp, nil); + i := fMenu.GetImageList.Add(bmp, nil); itm.ImageIndex:= i; - itm := TMenuItem.Create(item); + itm := TMenuItem.Create(fMenu); itm.ShortCut:=fOptions.shortcuts.updateVariables; itm.Caption:='Update the variables'; itm.OnClick:= @executeFromShortcut; itm.Tag:=8; - item.Add(itm); + fMenu.Add(itm); btnVariables.toBitmap(bmp); itm.Bitmap.Assign(bmp); - i := item.GetImageList.Add(bmp, nil); + i := fMenu.GetImageList.Add(bmp, nil); itm.ImageIndex:= i; bmp.Free; end; -procedure TCEGdbWidget.menuUpdate(item: TMenuItem); -var - i: integer; - itm: TMenuItem; -begin - if item.isNil or not fUpdateMenu then - exit; - fUpdateMenu := false; - for i:= 0 to item.Count-1 do - begin - itm := item.Items[i]; - case itm.Tag of - 0: itm.ShortCut:=fOptions.shortcuts.start; - 1: itm.ShortCut:=fOptions.shortcuts.stop; - 2: itm.ShortCut:=fOptions.shortcuts.pause; - 3: itm.ShortCut:=fOptions.shortcuts.continue; - 4: itm.ShortCut:=fOptions.shortcuts.step; - 5: itm.ShortCut:=fOptions.shortcuts.stepOver; - 6: itm.ShortCut:=fOptions.shortcuts.updateRegisters; - 7: itm.ShortCut:=fOptions.shortcuts.updateStack; - 8: itm.ShortCut:=fOptions.shortcuts.updateVariables; - end; - end; -end; - -function TCEGdbWidget.menuHasItems: boolean; -begin - exit(true); -end; - procedure TCEGdbWidget.optionsChangesApplied(sender: TObject); begin - fUpdateMenu:=true; + updateMenu; end; procedure TCEGdbWidget.executeFromShortcut(sender: TObject); diff --git a/src/ce_interfaces.pas b/src/ce_interfaces.pas index 3fe23ba5..89c35598 100644 --- a/src/ce_interfaces.pas +++ b/src/ce_interfaces.pas @@ -163,47 +163,6 @@ type - (** - * An implementer can add a main menu entry. - *) - ICEMainMenuProvider = interface(IObserverType) - ['ICEMainMenuProvider'] - // item is a new mainMenu entry. item must be filled with the sub-items to be added. - procedure menuDeclare(item: TMenuItem); - // item is the mainMenu entry declared previously. the sub items can be updated, deleted. - procedure menuUpdate(item: TMenuItem); - // indicates if menuDeclare should be called. - function menuHasItems: boolean; - end; - (** - * An implementer collects and updates its observers menus. - *) - TCEMainMenuSubject = specialize TCECustomSubject; - - - - (** - * An implementer declares some actions which have their own main menu entry and - * whose shortcuts are automatically handled - *) - ICEActionProvider = interface(IObserverType) - ['ICEActionProvider'] - // the action handler will clear the references to the actions collected previously and start collecting if result. - function actHandlerWantRecollect: boolean; - // the action handler starts to collect the actions if result. - function actHandlerWantFirst: boolean; - // the handler continue collecting action if result. - function actHandlerWantNext(out category: string; out action: TCustomAction): boolean; - // the handler update the state of a particular action. - procedure actHandleUpdater(action: TCustomAction); - end; - (** - * An implementer handles its observers actions. - *) - TCEActionProviderSubject = specialize TCECustomSubject; - - - (** * An implementer can expose customizable shortcuts to be edited in a dedicated widget. *) @@ -402,6 +361,16 @@ type procedure getCompilerImports(value: DCompiler; paths: TStrings); end; + (** + * Single service that provides access to the main menu. + *) + ICEMainMenu = interface(ICESingleService) + // adds a main menu entry + function mnuAdd: TMenuItem; + // removes a main menu entry + procedure mnuDelete(value: TMenuItem); + end; + TDCDCompletionKind = ( dckClass, @@ -454,15 +423,16 @@ type { Service getters: } - function getMessageDisplay(var obj: ICEMessagesDisplay): ICEMessagesDisplay; - function getMessageDisplay: ICEMessagesDisplay; - function getprocInputHandler: ICEProcInputHandler; - function getMultiDocHandler: ICEMultiDocHandler; - function getSymStringExpander: ICESymStringExpander; - function getProjectGroup: ICEProjectGroup; - function getExplorer: ICEExplorer; - function getOptionsEditor: ICEOptionsEditor; - function getCompilerSelector: ICECompilerSelector; + function getMessageDisplay(var obj: ICEMessagesDisplay): ICEMessagesDisplay; inline; + function getMessageDisplay: ICEMessagesDisplay; inline; + function getprocInputHandler: ICEProcInputHandler; inline; + function getMultiDocHandler: ICEMultiDocHandler; inline; + function getSymStringExpander: ICESymStringExpander; inline; + function getProjectGroup: ICEProjectGroup; inline; + function getExplorer: ICEExplorer; inline; + function getOptionsEditor: ICEOptionsEditor; inline; + function getCompilerSelector: ICECompilerSelector; inline; + function getMainMenu: ICEMainMenu; inline; implementation @@ -612,6 +582,11 @@ function getCompilerSelector: ICECompilerSelector; begin exit(EntitiesConnector.getSingleService('ICECompilerSelector') as ICECompilerSelector); end; + +function getMainMenu: ICEMainMenu; +begin + exit(EntitiesConnector.getSingleService('ICEMainMenu') as ICEMainMenu); +end; {$ENDREGION} end. diff --git a/src/ce_main.lfm b/src/ce_main.lfm index 332ecbf2..c97dfa6a 100644 --- a/src/ce_main.lfm +++ b/src/ce_main.lfm @@ -4801,8 +4801,8 @@ object CEMainForm: TCEMainForm end object Actions: TActionList Images = imgList - OnUpdate = ActionsUpdate left = 32 + top = 1 object actEdCopy: TAction Category = 'Edit' Caption = 'Copy' diff --git a/src/ce_main.pas b/src/ce_main.pas index b378ea48..8e0fc2d3 100644 --- a/src/ce_main.pas +++ b/src/ce_main.pas @@ -77,7 +77,7 @@ type end; { TCEMainForm } - TCEMainForm = class(TForm, ICEDocumentObserver, ICEEditableShortCut, ICEProjectObserver) + TCEMainForm = class(TForm, ICEDocumentObserver, ICEEditableShortCut, ICEProjectObserver, ICEMainMenu) actFileCompAndRun: TAction; actFileSaveAll: TAction; actFileClose: TAction; @@ -298,7 +298,6 @@ type procedure actProjCompileExecute(Sender: TObject); procedure actEdCopyExecute(Sender: TObject); procedure actEdCutExecute(Sender: TObject); - procedure ActionsUpdate(AAction: TBasicAction; var Handled: Boolean); procedure actEdMacPlayExecute(Sender: TObject); procedure actEdMacStartStopExecute(Sender: TObject); procedure actFileNewExecute(Sender: TObject); @@ -338,7 +337,6 @@ type fDscanUnittests: boolean; fDoc: TCESynMemo; fFirstTimeCoedit: boolean; - fActionHandler: TCEActionProviderSubject; fMultidoc: ICEMultiDocHandler; fScCollectCount: Integer; fUpdateCount: NativeInt; @@ -379,18 +377,18 @@ type fInitialized: boolean; fRunProc: TCEProcess; fMsgs: ICEMessagesDisplay; - fMainMenuSubj: TCEMainMenuSubject; fAppliOpts: TCEApplicationOptions; fProjActionsLock: boolean; fCompilerSelector: ICECompilerSelector; - procedure updateMainMenuProviders; procedure updateFloatingWidgetOnTop(onTop: boolean); procedure widgetDockingChanged(sender: TCEWidget; newState: TWidgetDockingState); procedure mnuOptsItemClick(sender: TObject); - // action provider handling; - procedure clearActProviderEntries; - procedure collectedActProviderEntries; + + // ICEMainMenu + function singleServiceName: string; + function mnuAdd: TMenuItem; + procedure mnuDelete(value: TMenuItem); // ICEDocumentObserver procedure docNew(document: TCESynMemo); @@ -1126,11 +1124,10 @@ end; constructor TCEMainForm.create(aOwner: TComponent); begin inherited create(aOwner); - fMainMenuSubj := TCEMainMenuSubject.create; - fActionHandler := TCEActionProviderSubject.create; fOptionCategories := TCEEditableOptionsSubject.create; EntitiesConnector.addObserver(self); + EntitiesConnector.addSingleService(self); InitMRUs; InitWidgets; @@ -1141,7 +1138,6 @@ begin OnDragDrop:= @ddHandler.DragDrop; OnDragOver:= @ddHandler.DragOver; - updateMainMenuProviders; EntitiesConnector.forceUpdate; fSymStringExpander:= getSymStringExpander; fProjectGroup := getProjectGroup; @@ -1810,8 +1806,6 @@ begin fPrjGrpMru.Free; FreeRunnableProc; // - fMainMenuSubj.Free; - fActionHandler.Free; fOptionCategories.Free; EntitiesConnector.removeObserver(self); inherited; @@ -1873,66 +1867,6 @@ begin TAction(sender).Enabled := false; end; -procedure TCEMainForm.ActionsUpdate(AAction: TBasicAction; var Handled: Boolean); -begin - Handled := false; - if fUpdateCount > 0 then - exit; - Inc(fUpdateCount); - try - clearActProviderEntries; - collectedActProviderEntries; - if AAction.isNotNil and not AAction.Update then - TAction(AAction).enabled := true; - updateMainMenuProviders; - finally - Dec(fUpdateCount); - end; -end; - -procedure TCEMainForm.updateMainMenuProviders; -var - i, j: Integer; - itm: TMenuItem; - hasItems: boolean; - doneUpdate: boolean; -begin - if not assigned(mainMenu.Images) then - exit; - for j := 0 to fMainMenuSubj.observersCount-1 do - begin - doneUpdate := false; - hasItems := (fMainMenuSubj.observers[j] as ICEMainMenuProvider).menuHasItems; - // try to update existing entry. - for i := mainMenu.Items.Count-1 downto 0 do - if PtrInt(fMainMenuSubj.observers[j]) = mainMenu.Items[i].Tag then - begin - if not hasItems then - begin - doneUpdate:=true; - mainMenu.Items[i].Clear; - mainMenu.Items.Delete(i); - break; - end - else - begin - (fMainMenuSubj.observers[j] as ICEMainMenuProvider).menuUpdate(mainMenu.Items[i]); - doneUpdate := true; - break; - end; - end; - if doneUpdate or not hasItems then - continue; - // otherwise propose to create a new entry - itm := TMenuItem.Create(Self); - mainMenu.Items.Add(itm); - (fMainMenuSubj.observers[j] as ICEMainMenuProvider).menuDeclare(itm); - itm.Tag:= PtrInt(fMainMenuSubj.observers[j]); - if itm.Count = 0 then - itm.Free; - end; -end; - procedure TCEMainForm.mruChange(Sender: TObject); var srcLst: TCEMruFileList; @@ -2152,55 +2086,28 @@ begin end; {$ENDREGION} -{$REGION TCEActionProviderHandler ----------------------------------------------} -procedure TCEMainForm.clearActProviderEntries; -var - prov: ICEActionProvider; - act: TContainedAction; - i, j: Integer; +{$REGION ICEMAinMenu -----------------------------------------------------------} +function TCEMainForm.singleServiceName: string; begin - for i:= 0 to fActionHandler.observersCount-1 do - begin - prov := fActionHandler[i] as ICEActionProvider; - if not prov.actHandlerWantRecollect then - continue; - for j := Actions.ActionCount-1 downto 0 do - begin - act := Actions.Actions[j]; - if (act.Owner <> Self) and (act.Tag = PtrInt(prov)) then - act.ActionList := nil; - end; - end; + exit('ICEMainMenu'); end; -procedure TCEMainForm.collectedActProviderEntries; -var - prov: ICEActionProvider; - act: TCustomAction; - cat: string; - i: Integer; - procedure addAction; - begin - act.ActionList := Actions; - act.Tag := ptrInt(prov); - act.Category := cat; - - act := nil; - cat := ''; - end; +function TCEMainForm.mnuAdd: TMenuItem; begin - for i:= 0 to fActionHandler.observersCount-1 do - begin - prov := fActionHandler[i] as ICEActionProvider; - if not prov.actHandlerWantFirst then - continue; + result := TMenuItem.Create(nil); + mainMenu.Items.Add(result); + exit(result); +end; - act := nil; - cat := ''; - while prov.actHandlerWantNext(cat, act) do - addAction; - addAction; - end; +procedure TCEMainForm.mnuDelete(value: TMenuItem); +var + i: integer; +begin + if value.isNil then + exit; + i := mainMenu.Items.IndexOf(value); + if i <> -1 then + mainMenu.Items.Delete(i); end; {$ENDREGION} diff --git a/src/ce_tools.pas b/src/ce_tools.pas index 8cf75e08..5b79f028 100644 --- a/src/ce_tools.pas +++ b/src/ce_tools.pas @@ -66,17 +66,15 @@ type function findTool(const value: string): TCEToolItem; end; - TCETools = class(TWritableLfmTextComponent, ICEMainMenuProvider, ICEEditableShortcut, ICEDocumentObserver) + TCETools = class(TWritableLfmTextComponent, ICEEditableShortcut, ICEDocumentObserver) private fTools: TCEToolItems; fShctCount: Integer; fDoc: TCESynMemo; + fMenu: TMenuItem; function getTool(index: Integer): TCEToolItem; procedure setTools(value: TCEToolItems); // - procedure menuDeclare(item: TMenuItem); - procedure menuUpdate(item: TMenuItem); - function menuHasItems: boolean; procedure executeToolFromMenu(sender: TObject); // procedure docNew(document: TCESynMemo); @@ -94,6 +92,7 @@ type constructor create(aOwner: TComponent); override; destructor destroy; override; // + procedure updateMenu; function addTool: TCEToolItem; procedure executeTool(tool: TCEToolItem); overload; procedure executeTool(index: Integer); overload; @@ -290,60 +289,37 @@ end; {$ENDREGION} {$REGION ICEMainMenuProvider ---------------------------------------------------} -procedure TCETools.executeToolFromMenu(sender: TObject); -begin - executeTool(TCEToolItem(TMenuItem(sender).tag)); -end; - -procedure TCETools.menuDeclare(item: TMenuItem); +procedure TCETools.updateMenu; var - i: Integer; + mnu: ICEMainMenu = nil; itm: TMenuItem; colitm: TCEToolItem; + i: integer; begin - if tools.Count = 0 then exit; - // - item.Caption := 'Custom tools'; - item.Clear; + if fMenu.isNil then + begin + mnu := getMainMenu; + if not assigned(mnu) then + exit; + fMenu := mnu.mnuAdd; + fMenu.Caption:='Custom tools'; + end; + fMenu.Clear; for i := 0 to tools.Count-1 do begin colitm := tool[i]; - // - itm := TMenuItem.Create(item); + itm := TMenuItem.Create(fMenu); itm.ShortCut:= colitm.shortcut; itm.Caption := colitm.toolAlias; itm.tag := ptrInt(colitm); itm.onClick := @executeToolFromMenu; - item.add(itm); + fMenu.add(itm); end; end; -procedure TCETools.menuUpdate(item: TMenuItem); -var - i: Integer; - colitm: TCEToolItem; - mnuitm: TMenuItem; +procedure TCETools.executeToolFromMenu(sender: TObject); begin - if item.isNil then exit; - if item.Count <> tools.Count then - menuDeclare(item) - else for i:= 0 to tools.Count-1 do - begin - colitm := tool[i]; - mnuitm := item.Items[i]; - // - if mnuitm.Tag <> ptrInt(colitm) then - mnuitm.Tag := ptrInt(colitm); - if mnuitm.Caption <> colitm.toolAlias then - mnuitm.Caption := colitm.toolAlias; - if mnuitm.shortcut <> colitm.shortcut then - mnuitm.shortcut := colitm.shortcut; - end; -end; - -function TCETools.menuHasItems: boolean; -begin - result := tools.Count <> 0; + executeTool(TCEToolItem(TMenuItem(sender).tag)); end; {$ENDREGION} diff --git a/src/ce_toolseditor.pas b/src/ce_toolseditor.pas index 7454080b..a95407fc 100644 --- a/src/ce_toolseditor.pas +++ b/src/ce_toolseditor.pas @@ -48,6 +48,7 @@ constructor TCEToolsEditorWidget.create(aOwner: TComponent); begin inherited; propsEd.CheckboxForBoolean := true; + propsEd.PropertyEditorHook.AddHandlerModified(@propsEdModified); rebuildToolList; end; @@ -68,6 +69,7 @@ begin lstTools.AddItem(CustomTools[i].toolAlias, nil); if lstTools.Count > 0 then lstTools.ItemIndex := 0; + CustomTools.updateMenu; end; procedure TCEToolsEditorWidget.updateToolList; @@ -76,6 +78,7 @@ var begin for i := 0 to CustomTools.tools.Count-1 do lstTools.Items[i] := CustomTools[i].toolAlias; + CustomTools.updateMenu; end; procedure TCEToolsEditorWidget.lstToolsSelectionChange(Sender: TObject; @@ -90,7 +93,8 @@ procedure TCEToolsEditorWidget.propsEdModified(Sender: TObject); begin if propsEd.ItemIndex = -1 then exit; - if propsEd.Rows[propsEd.ItemIndex].Name = 'toolAlias' then + if (propsEd.Rows[propsEd.ItemIndex].Name = 'toolAlias') + or (propsEd.Rows[propsEd.ItemIndex].Name = 'shortcut') then updateToolList; end;