From 73d6dcef825f51eed052cb10a329bc41613867ed Mon Sep 17 00:00:00 2001 From: marc Date: Mon, 21 Jul 2003 23:43:32 +0000 Subject: [PATCH] * Fixed radiogroup menuitems git-svn-id: trunk@4414 - --- ide/debugoptionsfrm.lfm | 42 ++++++----- ide/debugoptionsfrm.lrs | 46 ++++++------ ide/debugoptionsfrm.pas | 23 ++++++ lcl/include/menuitem.inc | 41 +++++++++-- lcl/interfaces/gtk/gtkcallback.inc | 47 ++++++++----- lcl/interfaces/gtk/gtkproc.inc | 70 ++++++++++++------- lcl/interfaces/gtk/gtkproc.pp | 2 + lcl/interfaces/gtk/gtkwinapi.inc | 108 ++++++++++++++++++++++++++++- lcl/menus.pp | 7 ++ 9 files changed, 295 insertions(+), 91 deletions(-) diff --git a/ide/debugoptionsfrm.lfm b/ide/debugoptionsfrm.lfm index 09016a8955..c88851ed5b 100644 --- a/ide/debugoptionsfrm.lfm +++ b/ide/debugoptionsfrm.lfm @@ -8,13 +8,13 @@ object DebuggerOptionsForm: TDebuggerOptionsForm POSITION = podefaultposonly HORZSCROLLBAR.PAGE = 481 VERTSCROLLBAR.PAGE = 443 - LEFT = 523 + LEFT = 515 HEIGHT = 442 - TOP = 319 + TOP = 247 WIDTH = 480 object nbDebugOptions: TNOTEBOOK ALIGN = altop - PAGEINDEX = 2 + PAGEINDEX = 3 HEIGHT = 398 WIDTH = 480 object pgGeneral: TPAGE @@ -149,10 +149,10 @@ object DebuggerOptionsForm: TDebuggerOptionsForm end object seLimitLinecount: TSPINEDIT ENABLED = False - CLIMB_RATE = 7.62096543442854E-34 - MINVALUE = 7.62096543442854E-34 - MAXVALUE = 7.62096543442854E-34 - VALUE = 7.62096543442854E-34 + CLIMB_RATE = 7.22976091447488E-34 + MINVALUE = 7.22976091447488E-34 + MAXVALUE = 7.22976091447488E-34 + VALUE = 7.22976091447488E-34 LEFT = 28 HEIGHT = 20 TOP = 53 @@ -358,16 +358,6 @@ object DebuggerOptionsForm: TDebuggerOptionsForm end object lvSignals: TLISTVIEW COLUMNS = < - item - CAPTION = 'Handled by' - VISIBLE = True - WIDTH = 75 - end - item - CAPTION = 'Resume' - VISIBLE = True - WIDTH = 75 - end item CAPTION = 'Name' VISIBLE = True @@ -377,6 +367,16 @@ object DebuggerOptionsForm: TDebuggerOptionsForm CAPTION = 'ID' VISIBLE = True WIDTH = 50 + end + item + CAPTION = 'Handled by' + VISIBLE = True + WIDTH = 75 + end + item + CAPTION = 'Resume' + VISIBLE = True + WIDTH = 75 end> POPUPMENU = popSignal VIEWSTYLE = vsreport @@ -415,22 +415,30 @@ object DebuggerOptionsForm: TDebuggerOptionsForm left = 408 top = 20 object mnuHandledByProgram: TMENUITEM + AUTOCHECK = True CAPTION = 'Handled by Program' + GROUPINDEX = 1 RADIOITEM = True end object mnuiHandledByDebugger: TMENUITEM + AUTOCHECK = True CAPTION = 'Handled by Debugger' + GROUPINDEX = 1 RADIOITEM = True end object N1: TMENUITEM CAPTION = '-' end object mnuResumeHandled: TMENUITEM + AUTOCHECK = True CAPTION = 'Resume Handled' + GROUPINDEX = 2 RADIOITEM = True end object mnuResumeUnhandled: TMENUITEM + AUTOCHECK = True CAPTION = 'Resume Unhandled' + GROUPINDEX = 2 RADIOITEM = True end end diff --git a/ide/debugoptionsfrm.lrs b/ide/debugoptionsfrm.lrs index 3c1a4ae9c7..18655ed309 100644 --- a/ide/debugoptionsfrm.lrs +++ b/ide/debugoptionsfrm.lrs @@ -5,11 +5,11 @@ LazarusResources.Add('TDebuggerOptionsForm','FORMDATA',[ +'sdialog'#7'CAPTION'#6#16'Debugger Options'#12'CLIENTHEIGHT'#3#186#1#11'CLIE' +'NTWIDTH'#3#224#1#8'ONCREATE'#7#25'DebuggerOptionsFormCREATE'#9'ONDESTROY'#7 +#26'DebuggerOptionsFormDESTROY'#8'POSITION'#7#16'podefaultposonly'#18'HORZSC' - +'ROLLBAR.PAGE'#3#225#1#18'VERTSCROLLBAR.PAGE'#3#187#1#4'LEFT'#3#11#2#6'HEIGH' - +'T'#3#186#1#3'TOP'#3'?'#1#5'WIDTH'#3#224#1#0#9'TNOTEBOOK'#14'nbDebugOptions' - +#5'ALIGN'#7#5'altop'#9'PAGEINDEX'#2#2#6'HEIGHT'#3#142#1#5'WIDTH'#3#224#1#0#5 - +'TPAGE'#9'pgGeneral'#7'CAPTION'#6#7'General'#11'CLIENTWIDTH'#3#220#1#12'CLIE' - +'NTHEIGHT'#3'p'#1#4'LEFT'#2#2#6'HEIGHT'#3'p'#1#3'TOP'#2#28#5'WIDTH'#3#220#1#0 + +'ROLLBAR.PAGE'#3#225#1#18'VERTSCROLLBAR.PAGE'#3#187#1#4'LEFT'#3#3#2#6'HEIGHT' + +#3#186#1#3'TOP'#3#247#0#5'WIDTH'#3#224#1#0#9'TNOTEBOOK'#14'nbDebugOptions'#5 + +'ALIGN'#7#5'altop'#9'PAGEINDEX'#2#3#6'HEIGHT'#3#142#1#5'WIDTH'#3#224#1#0#5'T' + +'PAGE'#9'pgGeneral'#7'CAPTION'#6#7'General'#11'CLIENTWIDTH'#3#220#1#12'CLIEN' + +'THEIGHT'#3'p'#1#4'LEFT'#2#2#6'HEIGHT'#3'p'#1#3'TOP'#2#28#5'WIDTH'#3#220#1#0 +#9'TGROUPBOX'#14'gbDebuggerType'#7'CAPTION'#6#22'Debugger type and path'#12 +'CLIENTHEIGHT'#2'%'#11'CLIENTWIDTH'#3#212#1#11'PARENTCTL3D'#8#8'TABORDER'#2#0 +#4'LEFT'#2#2#6'HEIGHT'#2'6'#3'TOP'#2#8#5'WIDTH'#3#216#1#0#9'TCOMBOBOX'#15'cm' @@ -39,9 +39,9 @@ LazarusResources.Add('TDebuggerOptionsForm','FORMDATA',[ +'CHECKBOX'#17'chkLimitLinecount'#11'ALLOWGRAYED'#9#8'AUTOSIZE'#9#7'CAPTION'#6 +#18'Limit linecount to'#10'DRAGCURSOR'#2#0#8'TABORDER'#2#1#7'TABSTOP'#9#4'LE' +'FT'#2#4#6'HEIGHT'#2#20#3'TOP'#2#29#5'WIDTH'#2'w'#0#0#9'TSPINEDIT'#16'seLimi' - +'tLinecount'#7'ENABLED'#8#10'CLIMB_RATE'#5#0#0#0#0#0#1'@'#253#144'?'#8'MINVA' - +'LUE'#5#0#0#0#0#0#1'@'#253#144'?'#8'MAXVALUE'#5#0#0#0#0#0#1'@'#253#144'?'#5 - +'VALUE'#5#0#0#0#0#0#1'@'#253#144'?'#4'LEFT'#2#28#6'HEIGHT'#2#20#3'TOP'#2'5'#5 + +'tLinecount'#7'ENABLED'#8#10'CLIMB_RATE'#5#0#0#0#0#0#1'@'#240#144'?'#8'MINVA' + +'LUE'#5#0#0#0#0#0#1'@'#240#144'?'#8'MAXVALUE'#5#0#0#0#0#0#1'@'#240#144'?'#5 + +'VALUE'#5#0#0#0#0#0#1'@'#240#144'?'#4'LEFT'#2#28#6'HEIGHT'#2#20#3'TOP'#2'5'#5 +'WIDTH'#2'>'#0#0#0#9'TGROUPBOX'#10'gbMessages'#7'CAPTION'#6#8'Messages'#12'C' +'LIENTHEIGHT'#3#171#0#11'CLIENTWIDTH'#3#228#0#7'ENABLED'#8#11'PARENTCTL3D'#8 +#8'TABORDER'#2#1#4'LEFT'#3#242#0#6'HEIGHT'#3#188#0#3'TOP'#2#8#5'WIDTH'#3#232 @@ -88,20 +88,22 @@ LazarusResources.Add('TDebuggerOptionsForm','FORMDATA',[ +'TABORDER'#2#0#4'LEFT'#3'}'#1#6'HEIGHT'#2#25#3'TOP'#3'1'#1#5'WIDTH'#2'K'#0#0 +#7'TBUTTON'#12'cmdSignalAdd'#7'CAPTION'#6#3'Add'#7'TABSTOP'#9#8'TABORDER'#2#1 +#4'LEFT'#3'('#1#6'HEIGHT'#2#25#3'TOP'#3'1'#1#5'WIDTH'#2'K'#0#0#9'TLISTVIEW'#9 - +'lvSignals'#7'COLUMNS'#14#1#7'CAPTION'#6#10'Handled by'#7'VISIBLE'#9#5'WIDTH' - +#2'K'#0#1#7'CAPTION'#6#6'Resume'#7'VISIBLE'#9#5'WIDTH'#2'K'#0#1#7'CAPTION'#6 - +#4'Name'#7'VISIBLE'#9#5'WIDTH'#3#200#0#0#1#7'CAPTION'#6#2'ID'#7'VISIBLE'#9#5 - +'WIDTH'#2'2'#0#0#9'POPUPMENU'#7#9'popSignal'#9'VIEWSTYLE'#7#8'vsreport'#4'LE' - +'FT'#2#8#6'HEIGHT'#3'$'#1#3'TOP'#2#5#5'WIDTH'#3#192#1#0#0#0#0#0#7'TBUTTON'#9 - +'cmdCancel'#11'MODALRESULT'#2#2#6'CANCEL'#9#7'CAPTION'#6#6'Cancel'#7'TABSTOP' - +#9#8'TABORDER'#2#1#4'LEFT'#3#144#1#6'HEIGHT'#2#25#3'TOP'#3#152#1#5'WIDTH'#2 - +'K'#0#0#7'TBUTTON'#5'cmdOK'#7'DEFAULT'#9#11'MODALRESULT'#2#1#7'CAPTION'#6#2 + +'lvSignals'#7'COLUMNS'#14#1#7'CAPTION'#6#4'Name'#7'VISIBLE'#9#5'WIDTH'#3#200 + +#0#0#1#7'CAPTION'#6#2'ID'#7'VISIBLE'#9#5'WIDTH'#2'2'#0#1#7'CAPTION'#6#10'Han' + +'dled by'#7'VISIBLE'#9#5'WIDTH'#2'K'#0#1#7'CAPTION'#6#6'Resume'#7'VISIBLE'#9 + +#5'WIDTH'#2'K'#0#0#9'POPUPMENU'#7#9'popSignal'#9'VIEWSTYLE'#7#8'vsreport'#4 + +'LEFT'#2#8#6'HEIGHT'#3'$'#1#3'TOP'#2#5#5'WIDTH'#3#192#1#0#0#0#0#0#7'TBUTTON' + +#9'cmdCancel'#11'MODALRESULT'#2#2#6'CANCEL'#9#7'CAPTION'#6#6'Cancel'#7'TABST' + +'OP'#9#8'TABORDER'#2#1#4'LEFT'#3#144#1#6'HEIGHT'#2#25#3'TOP'#3#152#1#5'WIDTH' + +#2'K'#0#0#7'TBUTTON'#5'cmdOK'#7'DEFAULT'#9#11'MODALRESULT'#2#1#7'CAPTION'#6#2 +'OK'#7'TABSTOP'#9#8'TABORDER'#2#2#7'ONCLICK'#7#10'cmdOKCLICK'#4'LEFT'#3'@'#1 +#6'HEIGHT'#2#25#3'TOP'#3#152#1#5'WIDTH'#2'K'#0#0#10'TPOPUPMENU'#9'popSignal' - +#4'left'#3#152#1#3'top'#2#20#0#9'TMENUITEM'#19'mnuHandledByProgram'#7'CAPTIO' - +'N'#6#18'Handled by Program'#9'RADIOITEM'#9#0#0#9'TMENUITEM'#21'mnuiHandledB' - +'yDebugger'#7'CAPTION'#6#19'Handled by Debugger'#9'RADIOITEM'#9#0#0#9'TMENUI' - +'TEM'#2'N1'#7'CAPTION'#6#1'-'#0#0#9'TMENUITEM'#16'mnuResumeHandled'#7'CAPTIO' - +'N'#6#14'Resume Handled'#9'RADIOITEM'#9#0#0#9'TMENUITEM'#18'mnuResumeUnhandl' - +'ed'#7'CAPTION'#6#16'Resume Unhandled'#9'RADIOITEM'#9#0#0#0#0 + +#4'left'#3#152#1#3'top'#2#20#0#9'TMENUITEM'#19'mnuHandledByProgram'#9'AUTOCH' + +'ECK'#9#7'CAPTION'#6#18'Handled by Program'#10'GROUPINDEX'#2#1#9'RADIOITEM'#9 + +#0#0#9'TMENUITEM'#21'mnuiHandledByDebugger'#9'AUTOCHECK'#9#7'CAPTION'#6#19'H' + +'andled by Debugger'#10'GROUPINDEX'#2#1#9'RADIOITEM'#9#0#0#9'TMENUITEM'#2'N1' + +#7'CAPTION'#6#1'-'#0#0#9'TMENUITEM'#16'mnuResumeHandled'#9'AUTOCHECK'#9#7'CA' + +'PTION'#6#14'Resume Handled'#10'GROUPINDEX'#2#2#9'RADIOITEM'#9#0#0#9'TMENUIT' + +'EM'#18'mnuResumeUnhandled'#9'AUTOCHECK'#9#7'CAPTION'#6#16'Resume Unhandled' + +#10'GROUPINDEX'#2#2#9'RADIOITEM'#9#0#0#0#0 ]); diff --git a/ide/debugoptionsfrm.pas b/ide/debugoptionsfrm.pas index 0515c7f598..0bbad757d2 100644 --- a/ide/debugoptionsfrm.pas +++ b/ide/debugoptionsfrm.pas @@ -62,6 +62,7 @@ type private FExceptionDeleteList: TStringList; procedure AddExceptionLine(const AException: TIDEException; AName: String); + procedure AddSignalLine(const ASignal: TIDESignal); public end; @@ -70,6 +71,10 @@ var implementation +const + HANDLEDBY_CAPTION: array [Boolean] of String = ('Program', 'Debugger'); + RESUME_CAPTION: array[Boolean] of String = ('Unhandled', 'Handled'); + { TDebuggerOptionsForm } procedure TDebuggerOptionsForm.AddExceptionLine(const AException: TIDEException; AName: String); @@ -84,6 +89,18 @@ begin clbExceptions.Checked[idx] := (AException = nil) or AException.Enabled; end; +procedure TDebuggerOptionsForm.AddSignalLine(const ASignal: TIDESignal); +var + Item: TListItem; +begin + Item := lvSignals.Items.Add; + Item.Caption := ASignal.Name; + Item.SubItems.Add(IntToStr(ASignal.ID)); + Item.SubItems.Add(HANDLEDBY_CAPTION[ASignal.HandledByDebugger]); + Item.SubItems.Add(RESUME_CAPTION[ASignal.ResumeHandled]); + Item.Data := ASignal; +end; + procedure TDebuggerOptionsForm.clbExceptionsCLICK (Sender: TObject ); begin cmdExceptionRemove.Enabled := clbExceptions.ItemIndex <> -1; @@ -169,6 +186,12 @@ begin begin AddExceptionLine(DebugBoss.Exceptions[n], ''); end; + + for n := 0 to DebugBoss.Signals.Count - 1 do + begin + AddSignalLine(DebugBoss.Signals[n]); + end; + end; procedure TDebuggerOptionsForm.DebuggerOptionsFormDESTROY(Sender: TObject); diff --git a/lcl/include/menuitem.inc b/lcl/include/menuitem.inc index bba70aaf2f..62076ddaae 100644 --- a/lcl/include/menuitem.inc +++ b/lcl/include/menuitem.inc @@ -52,7 +52,11 @@ begin if (not Assigned(ActionLink) and AutoCheck) or (Assigned(ActionLink) and not (ActionLink.IsAutoCheckLinked) and AutoCheck) then - Checked := not Checked; + // Break a little Delphi compatibility + // It makes no sense to uncheck a checked RadioItem (besides, GTK cant handle it) + if not RadioItem or not Checked + then Checked := not Checked; + { Call OnClick if assigned and not equal to associated action's OnExecute. If associated action's OnExecute assigned then call it, otherwise, call OnClick. } @@ -487,18 +491,24 @@ begin if FItems = nil then FItems := TList.Create; // adjust GroupIndex + (* + * MWE: Disabled this feature, it makes not much sense + * suppose a menu with items grouped like : G=2, G=2, ---, G=1, G=1 + * where --- is separator with G=0 + * Inserting G=1 after --- is OK according to the next check + if (Index>0) and (Index < FItems.Count) then if Item.GroupIndex < TMenuItem(FItems[Index - 1]).GroupIndex then Item.GroupIndex := TMenuItem(FItems[Index - 1]).GroupIndex; VerifyGroupIndex(Index, Item.GroupIndex); - + *) + Item.FParent := Self; Item.FOnChange := @SubItemChanged; FItems.Insert(Index, Item); if HandleAllocated then begin Item.HandleNeeded; - //InterfaceObject.IntSendMessage3(LM_ATTACHMENU, Item, nil); end; MenuChanged(FItems.Count = 1); end; @@ -822,8 +832,12 @@ procedure TMenuItem.SetGroupIndex(AValue: Byte); begin if FGroupIndex <> AValue then begin + (* + * MWE: Disabled this feature, it makes not much sense + * See other comments if Parent <> nil then Parent.VerifyGroupIndex(Parent.IndexOf(Self), AValue); + *) FGroupIndex := AValue; if FChecked and FRadioItem then TurnSiblingsOff; @@ -914,6 +928,9 @@ end; Unchecks all siblings. In contrary to Delphi this will not use SetChecked, because this is up to the interface. This procedure just sets the private variables. + + //todo + MWE: ??? shouln'd we get checked from the interface in that case ??? ------------------------------------------------------------------------------} procedure TMenuItem.TurnSiblingsOff; var @@ -925,11 +942,12 @@ begin begin Item := FParent[I]; if (Item <> Self) - and Item.FRadioItem and (Item.GroupIndex = GroupIndex) then - Item.FChecked:=false; + and Item.FRadioItem and (Item.GroupIndex = GroupIndex) + then Item.FChecked := false; end; end; + {------------------------------------------------------------------------------ Method: TMenuItem.VerifyGroupIndex Params: Position: Integer; Value: Byte @@ -937,6 +955,12 @@ end; Make sure, that all GroupIndex are in ascending order. ------------------------------------------------------------------------------} +(* + * MWE: Disabled this feature, it makes not much sense + * suppose a menu with items grouped like : G=1, G=1, ---, G=2, G=2 + * where --- is separator with G=0 + * It will fail to insert --- + procedure TMenuItem.VerifyGroupIndex(Position: Integer; Value: Byte); var i: Integer; @@ -951,6 +975,7 @@ begin if (Items[i].GroupIndex<>0) and (Items[i].GroupIndex0 then exit; - - if GtkWidgetIsA(widget,GTK_TYPE_MENU_ITEM) then begin - LCLMenuItem:=TMenuItem(GetLCLObject(Widget)); - if (LCLMenuItem<>nil) and LCLMenuItem.IsCheckItem - and (GtkWidgetIsA(widget,GTK_TYPE_CHECK_MENU_ITEM)) then begin - if ((PGtkCheckMenuItem(Widget)^.flag0 and bm_checkmenuitem_active)<>0) - <>LCLMenuItem.Checked - then begin - if (not LCLMenuItem.AutoCheck) then begin - // the gtk always toggles the check flag - // -> restore 'checked' flag - PGtkCheckMenuItem(Widget)^.flag0:= - PGtkCheckMenuItem(Widget)^.flag0 xor bm_checkmenuitem_active; - end; - end; - end; - end; + if LockOnChange(PgtkObject(Widget),0) > 0 then Exit; Mess.Msg := LM_ACTIVATE; Mess.Result := 0; @@ -310,6 +292,30 @@ begin //writeln('gtkactivateCB ',Result); end; +function GTKCheckMenuToggeledCB(AMenuItem: PGTKCheckMenuItem; AData: gPointer): GBoolean; cdecl; +// AData --> LCLMenuItem +var + LCLMenuItem: TMenuItem; +begin + Result := True; + EventTrace('toggled', AData); + + LCLMenuItem := TMenuItem(AData); + // some sanity checks + if LCLMenuItem = nil then Exit; + if not LCLMenuItem.IsCheckItem then Exit; // ??? + + // the gtk always toggles the check flag + // -> restore 'checked' flag if needed + if (AMenuItem^.flag0 and bm_checkmenuitem_active <> 0) = LCLMenuItem.Checked then Exit; + if LCLMenuItem.AutoCheck then Exit; + + // restore it + LockOnChange(PgtkObject(AMenuItem), +1); + gtk_check_menu_item_set_active(AMenuItem, LCLMenuItem.Checked); + LockOnChange(PgtkObject(AMenuItem), -1); +end; + function gtkchangedCB( widget: PGtkWidget; data: gPointer) : GBoolean; cdecl; var Mess : TLMessage; @@ -2781,6 +2787,9 @@ end; { ============================================================================= $Log$ + Revision 1.183 2003/07/21 23:43:32 marc + * Fixed radiogroup menuitems + Revision 1.182 2002/08/17 23:41:34 mattias many clipping fixes diff --git a/lcl/interfaces/gtk/gtkproc.inc b/lcl/interfaces/gtk/gtkproc.inc index e93267143e..3d1c129955 100644 --- a/lcl/interfaces/gtk/gtkproc.inc +++ b/lcl/interfaces/gtk/gtkproc.inc @@ -2587,6 +2587,21 @@ begin Result:=GetRadioMenuItemGroup(TMenuItem(GetLCLObject(MenuItem))); end; +{------------------------------------------------------------------------------ + procedure LockRadioGroupOnChange(RadioGroup: PGSList; const ADelta: Integer); + + Calls LockOnChange for all groupmembers + ------------------------------------------------------------------------------} +procedure LockRadioGroupOnChange(RadioGroup: PGSList; const ADelta: Integer); +begin + while RadioGroup <> nil do + begin + if RadioGroup^.Data <> nil + then LockOnChange(PgtkObject(RadioGroup^.Data), ADelta); + RadioGroup := RadioGroup^.Next; + end; +end; + {------------------------------------------------------------------------------ procedure UpdateRadioGroupChecks(RadioGroup: PGSList); @@ -2595,35 +2610,33 @@ end; procedure UpdateRadioGroupChecks(RadioGroup: PGSList); var CurListItem: PGSList; - MenuItem: PGtkMenuItem; + MenuItem: PGtkCheckMenuItem; LCLMenuItem: TMenuItem; begin - if RadioGroup=nil then exit; - CurListItem:=RadioGroup; - // set active radiomenuitem - while CurListItem<>nil do begin - MenuItem:=PGtkMenuItem(CurListItem^.Data); - if MenuItem<>nil then begin - LCLMenuItem:=TMenuItem(GetLCLObject(MenuItem)); - if (LCLMenuItem<>nil) and LCLMenuItem.Checked then begin - gtk_check_menu_item_set_active(PGtkCheckMenuItem(MenuItem), - LCLMenuItem.Checked); + // Check if it is a single entry + if (RadioGroup = nil) or (RadioGroup^.Next = nil) + then Exit; + + // Lock whole group for update + LockRadioGroupOnChange(RadioGroup, +1); + CurListItem := RadioGroup; + try + // set active radiomenuitem + while CurListItem <> nil do + begin + MenuItem := PGtkCheckMenuItem(CurListItem^.Data); + if MenuItem<>nil + then begin + LCLMenuItem := TMenuItem(GetLCLObject(MenuItem)); + if (LCLMenuItem <> nil) + and (((MenuItem^.flag0 and bm_checkmenuitem_active) = 0) = LCLMenuItem.Checked) + then gtk_check_menu_item_set_active(MenuItem, LCLMenuItem.Checked); end; + CurListItem := CurListItem^.Next; end; - CurListItem:=CurListItem^.Next; - end; - CurListItem:=RadioGroup; - // deactivate the other radiomenuitems - while CurListItem<>nil do begin - MenuItem:=PGtkMenuItem(CurListItem^.Data); - if MenuItem<>nil then begin - LCLMenuItem:=TMenuItem(GetLCLObject(MenuItem)); - if (LCLMenuItem<>nil) then begin - gtk_check_menu_item_set_active(PGtkCheckMenuItem(MenuItem), - LCLMenuItem.Checked); - end; - end; - CurListItem:=CurListItem^.Next; + finally + // Unlock whole group for update + LockRadioGroupOnChange(RadioGroup, -1); end; end; @@ -2867,6 +2880,7 @@ begin MenuItemWidget:=gtk_check_menu_item_new; end else MenuItemWidget:=gtk_menu_item_new; + if GtkWidgetIsA(MenuItemWidget,GTK_TYPE_CHECK_MENU_ITEM) then begin // set 'ShowAlwaysCheckable' gtk_check_menu_item_set_show_toggle(PGtkCheckMenuItem(MenuItemWidget), @@ -2879,8 +2893,11 @@ begin if (OldCheckMenuItemToggleSize=0) then OldCheckMenuItemToggleSize:=MENU_ITEM_CLASS(MenuItemWidget)^.toggle_size; {$endif} + gtk_signal_connect_after(PGTKObject(MenuItemWidget), 'toggled', + TGTKSignalFunc(@GTKCheckMenuToggeledCB), Pointer(LCLMenuItem)); end; + // set attributes (enabled and rightjustify) gtk_widget_set_sensitive(MenuItemWidget, LCLMenuItem.Enabled); if LCLMenuItem.RightJustify then @@ -4259,6 +4276,9 @@ end; { ============================================================================= $Log$ + Revision 1.188 2003/07/21 23:43:32 marc + * Fixed radiogroup menuitems + Revision 1.187 2003/07/02 10:02:51 mattias fixed TPaintStruct diff --git a/lcl/interfaces/gtk/gtkproc.pp b/lcl/interfaces/gtk/gtkproc.pp index 20ee306234..ea55204281 100644 --- a/lcl/interfaces/gtk/gtkproc.pp +++ b/lcl/interfaces/gtk/gtkproc.pp @@ -170,6 +170,7 @@ function gtkFocusOutNotifyCB (widget : PGtkWidget; event : PGdkEvent; function GTKHScrollCB(Adjustment: PGTKAdjustment; data: GPointer): GBoolean; cdecl; function GTKVScrollCB(Adjustment: PGTKAdjustment; data: GPointer): GBoolean; cdecl; +function GTKCheckMenuToggeledCB(AMenuItem: PGTKCheckMenuItem; AData: gPointer): GBoolean; cdecl; function GTKKeySnooper(Widget: PGtkWidget; Event: PGdkEventKey; FuncData: gPointer): gInt; cdecl; function gtkYearChanged(Widget: PGtkWidget; data: gPointer) : GBoolean; cdecl; @@ -429,6 +430,7 @@ function MENU_ITEM_CLASS(widget: PGtkWidget): PGtkMenuItemClass; function CHECK_MENU_ITEM_CLASS(widget: PGtkWidget): PGtkCheckMenuItemClass; function GetRadioMenuItemGroup(LCLMenuItem: TMenuItem): PGSList; function GetRadioMenuItemGroup(MenuItem: PGtkRadioMenuItem): PGSList; +procedure LockRadioGroupOnChange(RadioGroup: PGSList; const ADelta: Integer); procedure UpdateRadioGroupChecks(RadioGroup: PGSList); procedure DrawMenuItemIcon(MenuItem: PGtkCheckMenuItem; Area: PGdkRectangle); cdecl; diff --git a/lcl/interfaces/gtk/gtkwinapi.inc b/lcl/interfaces/gtk/gtkwinapi.inc index 509f0fe111..4c29f75eb4 100644 --- a/lcl/interfaces/gtk/gtkwinapi.inc +++ b/lcl/interfaces/gtk/gtkwinapi.inc @@ -227,11 +227,24 @@ function TgtkObject.CheckMenuItem(hndMenu: HMENU; uIDEnableItem: Integer; bChecked: Boolean): Boolean; var LCLMenuItem: TMenuItem; + IsRadio: Boolean; + Group: PGSList; begin - if GTK_IS_CHECK_MENU_ITEM(Pointer(hndMenu)) then begin - LockOnChange(PgtkObject(hndMenu),1); + IsRadio := gtk_is_radio_menu_item(Pointer(hndMenu)); + if IsRadio or gtk_is_check_menu_item(Pointer(hndMenu)) + then begin + if IsRadio + then begin + Group := gtk_radio_menu_item_group(Pointer(hndMenu)); + LockRadioGroupOnChange(Group, +1); + end + else LockOnChange(PgtkObject(hndMenu),1); gtk_check_menu_item_set_active(PGtkCheckMenuItem(hndMenu),bChecked); - LockOnChange(PgtkObject(hndMenu),-1); + if IsRadio + then begin + LockRadioGroupOnChange(Group, -1); + end + else LockOnChange(PgtkObject(hndMenu),-1); Result:=true; end else begin LCLMenuItem:=TMenuItem(GetLCLObject(Pointer(hndMenu))); @@ -6261,7 +6274,92 @@ end; ------------------------------------------------------------------------------} function TgtkObject.RegroupMenuItem(hndMenu: HMENU; GroupIndex: Integer): Boolean; + +const + GROUPIDX_DATANAME = 'GroupIndex'; + + function GetGroup: PGSList; + var + Item: PGList; + Arg: TGTKArg; + begin + Result := nil; + Arg.theType := GTK_TYPE_OBJECT; + Arg.Name := 'parent'; + gtk_widget_get(Pointer(hndMenu), @Arg); + if Arg.d.object_data = nil then Exit; + + Item := gtk_container_children(PGTKContainer(Arg.d.object_data)); + while Item <> nil do + begin + if (Item^.Data <> Pointer(hndMenu)) // exclude ourself + and gtk_is_radio_menu_item(Item^.Data) + and (GroupIndex = Integer(gtk_object_get_data(Item^.Data, GROUPIDX_DATANAME))) + then begin + Result := gtk_radio_menu_item_group(PGtkRadioMenuItem(Item^.Data)); + Exit; + end; + Item := Item^.Next; + end; + end; + +var + RadioGroup: PGSList; + CurrentGroupIndex: Integer; +begin + Result := False; + if not gtk_is_radio_menu_item(Pointer(hndMenu)) + then begin + writeln('WARNING: TgtkObject.RegroupMenuItem: handle is not a GTK_RADIO_MENU_ITEM'); + Exit; + end; + + CurrentGroupIndex := Integer(gtk_object_get_data(Pointer(hndMenu), GROUPIDX_DATANAME)); + + // Update needed ? + if GroupIndex = CurrentGroupIndex + then begin + Result := True; + Exit; + end; + + // Remove current group + gtk_radio_menu_item_set_group(PGtkRadioMenuItem(hndMenu), nil); + gtk_object_set_data(Pointer(hndMenu), GROUPIDX_DATANAME, nil); + + // Check remove only + if GroupIndex = 0 + then begin + Result := True; + Exit; + end; + + // Try to find new group + RadioGroup := GetGroup; + + // Set new group + gtk_object_set_data(Pointer(hndMenu), GROUPIDX_DATANAME, Pointer(GroupIndex)); + if RadioGroup = nil + then begin + // We're the only member, get a group + RadioGroup := gtk_radio_menu_item_group(PGtkRadioMenuItem(hndMenu)) + end + else begin + gtk_radio_menu_item_set_group(PGtkRadioMenuItem(hndMenu), RadioGroup); + end; + //radiogroup^.data + //radiogroup^.next + // Refetch newgroup list + RadioGroup := gtk_radio_menu_item_group(PGtkRadioMenuItem(hndMenu)); + // Update checks + UpdateRadioGroupChecks(RadioGroup); + Result := True; +end; + +// MWE: Reimplemented to get rid of unneeded group order constraint +// (which doesn't work if the menu isn't created in order) +(* function GetGroup(ParentMenuItem: TMenuItem; GrpIndex, LastRadioItem: integer): PGSList; var @@ -6340,6 +6438,7 @@ begin Result:=false; end; end; +*) {------------------------------------------------------------------------------ Function: ReleaseCapture @@ -8608,6 +8707,9 @@ end; { ============================================================================= $Log$ + Revision 1.264 2003/07/21 23:43:32 marc + * Fixed radiogroup menuitems + Revision 1.263 2003/07/20 06:39:03 mattias added comments diff --git a/lcl/menus.pp b/lcl/menus.pp index facbbda3b5..0be87026eb 100644 --- a/lcl/menus.pp +++ b/lcl/menus.pp @@ -141,7 +141,11 @@ type procedure SubItemChanged(Sender: TObject; Source: TMenuItem; Rebuild: Boolean); procedure TurnSiblingsOff; + (* + * MWE: Disabled this feature, it makes not much sense + * See comments below procedure VerifyGroupIndex(Position: Integer; Value: Byte); + *) protected property ActionLink: TMenuActionLink read FActionLink write FActionLink; procedure CreateHandle; virtual; @@ -382,6 +386,9 @@ end. { $Log$ + Revision 1.50 2003/07/21 23:43:32 marc + * Fixed radiogroup menuitems + Revision 1.49 2003/06/26 17:00:00 mattias fixed result on searching proc in interface