1{ $Id$}
2{
3 *****************************************************************************
4 *                              Gtk2WSMenus.pp                               *
5 *                              --------------                               *
6 *                                                                           *
7 *                                                                           *
8 *****************************************************************************
9
10 *****************************************************************************
11  This file is part of the Lazarus Component Library (LCL)
12
13  See the file COPYING.modifiedLGPL.txt, included in this distribution,
14  for details about the license.
15 *****************************************************************************
16}
17unit Gtk2WSMenus;
18
19{$mode objfpc}{$H+}
20
21interface
22
23uses
24  // RTL
25  Classes, Types, glib2, gdk2, gtk2,
26  // LazUtils
27  LazTracer,
28  // LCL
29  Gtk2Int, Gtk2Proc, Gtk2Globals, Gtk2Def, Gtk2Extra,
30  LCLType, LCLIntf, InterfaceBase, WSMenus, LMessages, Graphics, Menus, Forms;
31
32type
33
34  { TGtk2WSMenuItem }
35
36  TGtk2WSMenuItem = class(TWSMenuItem)
37  protected
38    class procedure SetCallbacks(const AGtkWidget: PGtkWidget; const AWidgetInfo: PWidgetInfo);
39  published
40    class procedure AttachMenu(const AMenuItem: TMenuItem); override;
41    class function CreateHandle(const AMenuItem: TMenuItem): HMENU; override;
42    class procedure DestroyHandle(const AMenuItem: TMenuItem); override;
43    class procedure SetCaption(const AMenuItem: TMenuItem; const ACaption: string); override;
44    class procedure SetShortCut(const AMenuItem: TMenuItem; const ShortCutK1, ShortCutK2: TShortCut); override;
45    class procedure SetVisible(const AMenuItem: TMenuItem; const Visible: boolean); override;
46    class function SetCheck(const AMenuItem: TMenuItem; const Checked: boolean): boolean; override;
47    class function SetEnable(const AMenuItem: TMenuItem; const Enabled: boolean): boolean; override;
48    class function SetRadioItem(const AMenuItem: TMenuItem; const {%H-}RadioItem: boolean): boolean; override;
49    class function SetRightJustify(const AMenuItem: TMenuItem; const Justified: boolean): boolean; override;
50    class procedure UpdateMenuIcon(const AMenuItem: TMenuItem; const HasIcon: Boolean; const {%H-}AIcon: TBitmap); override;
51  end;
52
53  { TGtk2WSMenu }
54
55  TGtk2WSMenu = class(TWSMenu)
56  published
57    class function CreateHandle(const AMenu: TMenu): HMENU; override;
58    class procedure SetBiDiMode(const AMenu: TMenu; UseRightToLeftAlign, {%H-}UseRightToLeftReading : Boolean); override;
59  end;
60
61  { TGtk2WSMainMenu }
62
63  TGtk2WSMainMenu = class(TWSMainMenu)
64  published
65  end;
66
67  { TGtk2WSPopupMenu }
68
69  TGtk2WSPopupMenu = class(TWSPopupMenu)
70  protected
71    class procedure SetCallbacks(const AGtkWidget: PGtkWidget; const AWidgetInfo: PWidgetInfo); virtual;
72  published
73    class function CreateHandle(const AMenu: TMenu): HMENU; override;
74    class procedure Popup(const APopupMenu: TPopupMenu; const X, Y: integer); override;
75  end;
76
77
78implementation
79
80{$I gtk2defines.inc}
81
82var
83  MenuWidget: PGtkWidget = nil;
84
85function Gtk2MenuItemButtonPress(widget: PGtkWidget; event: PGdkEventButton;
86 {%H-}user_data: gpointer): gboolean; cdecl;
87var
88  Parent: PGtkWidget;
89  WidgetInfo: PWidgetInfo;
90begin
91  Result := False;
92  if (event^._type = GDK_BUTTON_PRESS) then
93  begin
94    Parent := gtk_widget_get_parent(Widget);
95    if (Parent <> nil) and GTK_IS_MENU_BAR(Parent) then
96    begin
97      if (gtk_menu_item_get_submenu(PGtkMenuItem(Widget)) = nil) then
98      begin
99        WidgetInfo := GetWidgetInfo(Widget);
100        if Assigned(TMenuItem(WidgetInfo^.LCLObject).OnClick) then
101        begin
102          gtk_menu_item_activate(PGtkMenuItem(Widget));
103          // must be true because of issue #22616
104          Result := True;
105        end;
106      end;
107    end;
108  end;
109end;
110
111function Gtk2MenuItemActivate(widget: PGtkMenuItem; data: gPointer) : GBoolean; cdecl;
112var
113  Mess: TLMActivate;
114  LCLMenuItem: TMenuItem;
115begin
116  Result:= True;
117  {$IFDEF EventTrace}
118  EventTrace('activate', data);
119  {$ENDIF}
120
121  ResetDefaultIMContext;
122
123  if LockOnChange(PgtkObject(Widget),0) > 0 then Exit;
124
125  LCLMenuItem := TMenuItem(Data);
126
127  // the gtk fires activate for radio buttons when unchecking them
128  // the LCL expects only uncheck
129  if LCLMenuItem.RadioItem
130  and GtkWidgetIsA(PGtkWidget(Widget), GTK_TYPE_CHECK_MENU_ITEM)
131  and (not gtk_check_menu_item_get_active(PGTKCheckMenuItem(Widget))) then Exit;
132
133  FillChar(Mess{%H-}, SizeOf(Mess), #0);
134  Mess.Msg := LM_ACTIVATE;
135  Mess.Active := WA_ACTIVE;
136  Mess.Minimized := False;
137  Mess.ActiveWindow := 0;
138  Mess.Result := 0;
139  DeliverMessage(Data, Mess);
140
141  Result := CallBackDefaultReturn;
142end;
143
144function Gtk2MenuItemToggled(AMenuItem: PGTKCheckMenuItem;
145                             AData: gPointer): GBoolean; cdecl;
146var
147  LCLMenuItem: TMenuItem;
148  Mess: TLMessage;
149  b: Boolean;
150  w: PGtkWidget;
151  WidgetInfo: PWidgetInfo;
152begin
153  Result := CallBackDefaultReturn;
154  {$IFDEF EventTrace}
155  EventTrace('toggled', AData);
156  {$ENDIF}
157  if LockOnChange(PgtkObject(AMenuItem),0) > 0 then Exit;
158
159  LCLMenuItem := TMenuItem(AData);
160
161  if (csDesigning in LCLMenuItem.ComponentState) then
162    exit;
163
164  w := gtk_get_event_widget(gtk_get_current_event);
165
166  if not GTK_IS_RADIO_MENU_ITEM(w) then
167    exit;
168
169  b := gtk_check_menu_item_get_active(AMenuItem);
170
171  if not LCLMenuItem.Checked then
172    g_signal_stop_emission_by_name(AMenuItem, 'toggled')
173  else
174    g_signal_stop_emission_by_name(AMenuItem, 'activate');
175
176  if b <> LCLMenuItem.Checked then
177    gtk_check_menu_item_set_active(AMenuItem, LCLMenuItem.Checked);
178
179  {we must trigger OnClick() somehow, since we stopped signals}
180  if b and (w <> nil) and (w <> PGtkWidget(AMenuItem)) then
181  begin
182    WidgetInfo := GetWidgetInfo(w);
183    FillChar(Mess{%H-},SizeOf(Mess),#0);
184    Mess.Msg := LM_ACTIVATE;
185    WidgetInfo^.LCLObject.Dispatch(Mess);
186  end;
187end;
188
189function Gtk2MenuItemSelect({%H-}item: PGtkMenuItem; AMenuItem: gPointer): GBoolean; cdecl;
190begin
191  TMenuItem(AMenuItem).IntfDoSelect;
192  Result := CallBackDefaultReturn;
193end;
194
195procedure Gtk2MenuItemToggleSizeRequest(AMenuItem: PGtkMenuItem; requisition: Pgint; LCLItem: TMenuItem); cdecl;
196var
197  spacing: guint;
198  IconWidth: Integer;
199  DC: HDC;
200begin
201  if LCLItem.HasIcon then
202  begin
203    DC := Widgetset.GetDC(HWND({%H-}PtrUInt(AMenuItem)));
204    IconWidth := LCLItem.GetIconSize(DC).X;
205    WidgetSet.ReleaseDC(HWND({%H-}PtrUInt(AMenuItem)), DC);
206    if IconWidth > 0 then
207    begin
208      gtk_widget_style_get(PGtkWidget(AMenuItem), 'toggle-spacing', [@spacing, nil]);
209      requisition^ := IconWidth + spacing;
210    end
211    else
212      requisition^ := 0;
213  end
214  else
215    GTK_MENU_ITEM_GET_CLASS(AMenuItem)^.toggle_size_request(AMenuItem, requisition);
216end;
217
218procedure Gtk2MenuItemSizeRequest(AMenuItem: PGtkMenuItem; requisition: PGtkRequisition; LCLItem: TMenuItem); cdecl;
219var
220  IconHeight: Integer;
221  DC: HDC;
222begin
223  GTK_WIDGET_GET_CLASS(AMenuItem)^.size_request(PGtkWidget(AMenuItem), requisition);
224  DC := Widgetset.GetDC(HWND({%H-}PtrUInt(AMenuItem)));
225  IconHeight := LCLItem.GetIconSize(DC).Y;
226  Widgetset.ReleaseDC(HWND({%H-}PtrUInt(AMenuItem)), DC);
227  if requisition^.height < IconHeight then
228    requisition^.height := IconHeight;
229end;
230
231function Gtk2MenuItemDeselect({%H-}item: Pointer; {%H-}AMenuItem: TMenuItem): GBoolean; cdecl;
232begin
233  Application.Hint := '';
234  Result := CallBackDefaultReturn;
235end;
236
237{ TGtk2WSMenuItem }
238
239class procedure TGtk2WSMenuItem.SetCallbacks(const AGtkWidget: PGtkWidget;
240  const AWidgetInfo: PWidgetInfo);
241begin
242  // connect activate signal (i.e. clicked)
243  {button-press-event is needed by root menu items which have not
244  submenu, but OnClick() is assigned - fix for #15986 }
245  g_signal_connect_after(PGTKObject(AGtkWidget), 'button-press-event',
246    TGTKSignalFunc(@Gtk2MenuItemButtonPress), AWidgetInfo^.LCLObject);
247  g_signal_connect(PGTKObject(AGtkWidget), 'activate',
248                   TGTKSignalFunc(@Gtk2MenuItemActivate), AWidgetInfo^.LCLObject);
249  g_signal_connect(PGTKObject(AGtkWidget), 'select',
250    TGTKSignalFunc(@Gtk2MenuItemSelect), AWidgetInfo^.LCLObject);
251  g_signal_connect(PGTKObject(AGtkWidget), 'deselect',
252    TGTKSignalFunc(@Gtk2MenuItemDeselect), AWidgetInfo^.LCLObject);
253  g_signal_connect(PGTKObject(AGtkWidget), 'toggle-size-request',
254    TGTKSignalFunc(@Gtk2MenuItemToggleSizeRequest), AWidgetInfo^.LCLObject);
255  g_signal_connect(PGTKObject(AGtkWidget), 'size-request',
256    TGTKSignalFunc(@Gtk2MenuItemSizeRequest), AWidgetInfo^.LCLObject);
257end;
258
259class procedure TGtk2WSMenuItem.AttachMenu(const AMenuItem: TMenuItem);
260var
261  MenuItem, ParentMenuWidget, ContainerMenu: PGtkWidget;
262begin
263  with AMenuItem do
264  begin
265    MenuItem := {%H-}PGtkWidget(Handle);
266    if MenuItem=nil then
267      RaiseGDBException('TGtkWidgetSet.AttachMenu Handle=0');
268    ParentMenuWidget := {%H-}PGtkWidget(Parent.Handle);
269    if ParentMenuWidget=nil then
270      RaiseGDBException('TGtkWidgetSet.AttachMenu ParentMenuWidget=nil');
271
272    if GTK_IS_MENU_BAR(ParentMenuWidget) then
273    begin
274      // mainmenu (= a menu bar)
275      ContainerMenu := ParentMenuWidget;
276      gtk_menu_bar_insert(ParentMenuWidget, MenuItem, AMenuItem.MenuVisibleIndex);
277    end
278    else
279    begin
280      // if it is a menu
281      if GTK_IS_MENU(ParentMenuWidget) then
282        ContainerMenu := ParentMenuWidget
283      else // menu item
284        ContainerMenu := PGtkWidget(g_object_get_data(PGObject(ParentMenuWidget),
285                                    'ContainerMenu')); // find the menu container
286
287      if ContainerMenu = nil then
288      begin
289        if (GetParentMenu is TPopupMenu) and (Parent.Parent=nil) then
290        begin
291          ContainerMenu := {%H-}PGtkWidget(GetParentMenu.Handle);
292          g_object_set_data(PGObject(ContainerMenu), 'ContainerMenu',
293                              ContainerMenu);
294        end else
295        begin
296          ContainerMenu := gtk_menu_new;
297          g_object_set_data(PGObject(ParentMenuWidget), 'ContainerMenu',
298                              ContainerMenu);
299          gtk_menu_item_set_submenu(PGTKMenuItem(ParentMenuWidget), ContainerMenu);
300        end;
301      end;
302      gtk_menu_insert(ContainerMenu, MenuItem, AMenuItem.MenuVisibleIndex);
303    end;
304
305    if GtkWidgetIsA(MenuItem, GTK_TYPE_RADIO_MENU_ITEM) then
306      TGtk2WidgetSet(WidgetSet).RegroupMenuItem(HMENU({%H-}PtrUInt(MenuItem)), GroupIndex);
307  end;
308end;
309
310class function TGtk2WSMenuItem.CreateHandle(const AMenuItem: TMenuItem): HMENU;
311var
312  Widget: PGtkWidget;
313  WidgetInfo: PWidgetInfo;
314begin
315  // create the menuitem widget (normal, check or radio)
316  if AMenuItem.Caption = cLineCaption then // create separator
317    Widget := gtk_separator_menu_item_new
318  else
319  if AMenuItem.RadioItem and not AMenuItem.HasIcon then
320    Widget := gtk_radio_menu_item_new(nil)
321  else
322  if AMenuItem.IsCheckItem or AMenuItem.HasIcon then
323    Widget := gtk_check_menu_item_new
324  else
325    Widget := gtk_menu_item_new;
326
327  WidgetInfo := CreateWidgetInfo(Widget);
328  WidgetInfo^.LCLObject := AMenuItem;
329
330  if GtkWidgetIsA(Widget, GTK_TYPE_CHECK_MENU_ITEM) then
331  begin
332    // check or radio
333    // set 'ShowAlwaysCheckable'
334    gtk_check_menu_item_set_show_toggle(PGtkCheckMenuItem(Widget),
335      AMenuItem.ShowAlwaysCheckable);
336    // set 'Checked'
337    gtk_check_menu_item_set_active(PGtkCheckMenuItem(Widget),
338      AMenuItem.Checked);
339
340    g_signal_connect(PGTKObject(Widget), 'toggled',
341      TGTKSignalFunc(@Gtk2MenuItemToggled), Pointer(AMenuItem));
342  end;
343
344  // set attributes (enabled and rightjustify)
345  gtk_widget_set_sensitive(Widget, AMenuItem.Enabled);
346  if AMenuItem.RightJustify then
347    gtk_menu_item_right_justify(PGtkMenuItem(Widget));
348
349  // create the hbox containing the label and the icon
350  UpdateInnerMenuItem(AMenuItem, Widget);
351
352  SetCallbacks(Widget, WidgetInfo);
353
354  gtk_widget_show(Widget);
355  {$IFDEF DebugLCLComponents}
356  DebugGtkWidgets.MarkCreated(Widget, dbgsName(AMenuItem));
357  {$ENDIF}
358  Result := HMENU({%H-}PtrUInt(Widget));
359end;
360
361class procedure TGtk2WSMenuItem.DestroyHandle(const AMenuItem: TMenuItem);
362begin
363  { TODO: cleanup }
364  TGtk2WidgetSet(WidgetSet).DestroyLCLComponent(AMenuItem);
365end;
366
367class procedure TGtk2WSMenuItem.SetCaption(const AMenuItem: TMenuItem;
368  const ACaption: string);
369var
370  MenuItemWidget: PGtkWidget;
371begin
372  if not WSCheckMenuItem(AMenuItem, 'SetCaption') then
373    Exit;
374  if gtk_is_separator_menu_item({%H-}PGTKWidget(AMenuItem.Handle)) Or (ACaption = cLineCaption) then
375   AMenuItem.RecreateHandle
376  else
377   begin
378    MenuItemWidget:={%H-}PGtkWidget(AMenuItem.Handle);
379    UpdateInnerMenuItem(AMenuItem,MenuItemWidget);
380    gtk_widget_set_sensitive({%H-}PGtkWidget(AMenuItem.Handle), AMenuItem.Enabled);
381   end;
382end;
383
384class procedure TGtk2WSMenuItem.SetShortCut(const AMenuItem: TMenuItem;
385  const ShortCutK1, ShortCutK2: TShortCut);
386//var
387  //MenuWidget: PGtkMenuItem;
388  //accel_path: String;
389  //CurKey: Word;
390  //CurShift: TShiftState;
391begin
392  if not WSCheckMenuItem(AMenuItem, 'SetShortCut') then  Exit;
393
394  // Temporary: At least it writes the names of the shortcuts
395  UpdateInnerMenuItem(AMenuItem, {%H-}PGTKWidget(AMenuItem.Handle), ShortCutK1, ShortCutK2);
396
397{  // Gets the inner widgets. They should already be created by now
398  MenuWidget := PGtkMenuItem(AMenuItem.Handle);
399  if (MenuWidget=nil) then Exit;
400  // Converts the shortcut to a gtk friendly format and sets it
401  ShortCutToKey(NewShortCut, CurKey, CurShift);
402  accel_path := 'LCLApp/Menu/' + GetAcceleratorString(CurKey, CurShift);
403  gtk_accel_map_add_entry(accel_path, CurKey, ShiftToGdkModifierType);
404  gtk_menu_item_set_accel_path(); }
405end;
406
407class procedure TGtk2WSMenuItem.SetVisible(const AMenuItem: TMenuItem;
408  const Visible: boolean);
409var
410  MenuItemWidget: PGtkWidget;
411begin
412  if not WSCheckMenuItem(AMenuItem, 'SetVisible') then
413    Exit;
414  MenuItemWidget := {%H-}PGtkWidget(AMenuItem.Handle);
415  if gtk_widget_visible(MenuItemWidget) = Visible then
416    Exit;
417  if Visible then
418    gtk_widget_show(MenuItemWidget)
419  else
420    gtk_widget_hide(MenuItemWidget);
421end;
422
423class function TGtk2WSMenuItem.SetCheck(const AMenuItem: TMenuItem;
424  const Checked: boolean): boolean;
425var
426  IsRadio: Boolean;
427  Group: PGSList;
428  Item: Pointer;
429begin
430  Result:=false;
431  if not WSCheckMenuItem(AMenuItem, 'SetCheck') then
432    Exit;
433  Item := {%H-}Pointer(AMenuItem.Handle);
434  IsRadio := gtk_is_radio_menu_item(Item);
435  if IsRadio or gtk_is_check_menu_item(Item)
436  then begin
437    if IsRadio
438    then begin
439      Group := gtk_radio_menu_item_group(Item);
440      LockRadioGroupOnChange(Group, +1);
441    end
442    else LockOnChange(Item, +1);
443    gtk_check_menu_item_set_active(Item, Checked);
444    if IsRadio
445    then LockRadioGroupOnChange(Group, -1)
446    else LockOnChange(Item, -1);
447    Result := True;
448  end
449  else begin
450    AMenuItem.RecreateHandle;
451    Result := True;
452  end;
453end;
454
455class function TGtk2WSMenuItem.SetEnable(const AMenuItem: TMenuItem;
456  const Enabled: boolean): boolean;
457begin
458  Result := False;
459  if not WSCheckMenuItem(AMenuItem, 'SetEnable') then
460    Exit;
461  gtk_widget_set_sensitive({%H-}PGtkWidget(AMenuItem.Handle), Enabled);
462  Result := True;
463end;
464
465class function TGtk2WSMenuItem.SetRadioItem(const AMenuItem: TMenuItem;
466  const RadioItem: boolean): boolean;
467begin
468  AMenuItem.RecreateHandle;
469  Result := True;
470end;
471
472class function TGtk2WSMenuItem.SetRightJustify(const AMenuItem: TMenuItem;
473  const Justified: boolean): boolean;
474var
475  MenuItemWidget: PGtkMenuItem;
476begin
477  Result := False;
478  if not WSCheckMenuItem(AMenuItem, 'SetRightJustify') then
479    Exit;
480  MenuItemWidget := {%H-}PGtkMenuItem(AMenuItem.Handle);
481  gtk_menu_item_set_right_justified(MenuItemWidget, Justified);
482  gtk_widget_queue_resize(GTK_WIDGET(MenuItemWidget));
483  Result := True;
484end;
485
486class procedure TGtk2WSMenuItem.UpdateMenuIcon(const AMenuItem: TMenuItem;
487  const HasIcon: Boolean; const AIcon: TBitmap);
488begin
489  if not WSCheckMenuItem(AMenuItem, 'UpdateMenuIcon') then
490    Exit;
491  // recreating menu handle without icon may lead to failures like
492  // main menu bar vanishing, see mantis issue #37607
493  if HasIcon then
494    AMenuItem.RecreateHandle;
495end;
496
497{ TGtk2WSMenu }
498
499class function TGtk2WSMenu.CreateHandle(const AMenu: TMenu): HMENU;
500var
501  Widget: PGtkWidget;
502  WidgetInfo: PWidgetInfo;
503  Box: Pointer;
504  ParentForm: TCustomForm;
505const
506  MenuDirection : array[Boolean] of Longint = (
507    GTK_PACK_DIRECTION_LTR,
508    GTK_PACK_DIRECTION_RTL);
509begin
510  Widget := gtk_menu_bar_new();
511  // get the VBox, the form has one child, a VBox
512  ParentForm := TCustomForm(AMenu.Parent);
513  if (ParentForm=nil) or (not (ParentForm is TCustomForm)) then
514    RaiseGDBException('MainMenu without form');
515  if ParentForm.Menu <> AMenu then
516    RaiseGDBException('Form already has a MainMenu');
517  if ParentForm.HandleAllocated then
518  begin
519    Box := {%H-}PGTKBin(ParentForm.Handle)^.Child;
520    gtk_box_pack_start(Box, Widget, False, False, 0);
521  end;
522
523  gtk_menu_bar_set_pack_direction(PGtkMenuBar(Widget), MenuDirection[AMenu.UseRightToLeftAlignment]);
524  gtk_widget_show(Widget);
525
526  {$IFDEF DebugLCLComponents}
527  DebugGtkWidgets.MarkCreated(Widget, dbgsName(AMenu));
528  {$ENDIF}
529  Result := THandle({%H-}PtrUInt(Widget));
530  WidgetInfo := CreateWidgetInfo(Widget);
531  WidgetInfo^.LCLObject := AMenu;
532  // no callbacks for main menu
533end;
534
535class procedure TGtk2WSMenu.SetBiDiMode(const AMenu : TMenu;
536  UseRightToLeftAlign, UseRightToLeftReading : Boolean);
537const
538  WidgetDirection : array[boolean] of longint = (GTK_TEXT_DIR_LTR, GTK_TEXT_DIR_RTL);
539{$ifdef GTK_2_8}
540const
541  MenuDirection : array[Boolean] of Longint = (
542    GTK_PACK_DIRECTION_LTR,
543    GTK_PACK_DIRECTION_RTL);
544{$endif}
545  procedure Switch(AMenuItem: TMenuItem; Flip: Boolean);
546  var
547    i: Integer;
548  begin
549    if Flip then
550    begin
551      if AMenuItem.HandleAllocated then begin
552        gtk_widget_set_direction({%H-}PGtkWidget(AMenuItem.Handle), WidgetDirection[UseRightToLeftAlign]);
553        UpdateInnerMenuItem(AMenuItem, {%H-}PGtkWidget(AMenuItem.Handle));
554      end;
555    end;
556    for i := 0 to AMenuItem.Count -1 do
557      Switch(AMenuItem[i], True);
558  end;
559begin
560  {$ifdef GTK_2_8}
561    gtk_menu_bar_set_pack_direction({%H-}PGtkMenuBar(AMenu.Handle), MenuDirection[UseRightToLeftAlign]);
562    gtk_menu_bar_set_child_pack_direction({%H-}PGtkMenuBar(AMenu.Handle), MenuDirection[UseRightToLeftAlign]);
563  {$endif}
564  //gtk_widget_set_direction(PGtkWidget(AMenu.Handle), WidgetDirection[UseRightToLeftAlign]);
565  Switch(AMenu.Items, False);
566end;
567
568{ TGtk2WSPopupMenu }
569
570procedure GtkWS_Popup(menu: PGtkMenu; X, Y: pgint; {%H-}push_in: pgboolean;
571  WidgetInfo: PWidgetInfo); cdecl;
572var
573  Requisition: TGtkRequisition;
574  Alignment: TPopupAlignment;
575  ScreenHeight: gint;
576begin
577  X^ := PPoint(WidgetInfo^.UserData)^.X;
578  Y^ := PPoint(WidgetInfo^.UserData)^.Y;
579
580  if WidgetInfo^.LCLObject is TPopupMenu then
581  begin
582    // make menu to fit the screen vertically
583    gtk_widget_size_request(PGtkWidget(menu), @Requisition);
584    ScreenHeight := gdk_screen_height();
585    if Y^ + Requisition.height > ScreenHeight then
586    begin
587      Y^ := ScreenHeight - Requisition.height;
588      if Y^ < 0 then Y^ := 0;
589    end;
590
591    // get actual alignment
592    Alignment := TPopupMenu(WidgetInfo^.LCLObject).Alignment;
593    if TPopupMenu(WidgetInfo^.LCLObject).UseRightToLeftAlignment then
594    begin
595      if Alignment = paLeft then
596        Alignment := paRight
597      else
598      if Alignment = paRight then
599        Alignment := paLeft;
600    end;
601
602    case Alignment of
603      paCenter: X^ := X^ - Requisition.width div 2;
604      paRight: X^ := X^ - Requisition.width;
605    end;
606  end;
607end;
608
609function gtkWSPopupDelayedClose(Data: Pointer): gboolean; cdecl;
610var
611  PopupMenu: TPopupMenu absolute data;
612begin
613  Result := False;
614  if PopupMenu is TPopupMenu then
615  begin
616    PopupMenu.Close;
617    // Fix freezing some controls (eg SpeedButton) when close PopupMenu
618    LastMouse.Button := 0;
619    LastMouse.ClickCount := 0;
620    LastMouse.Down := False;
621    LastMouse.MousePos := Point(0, 0);
622    LastMouse.Time := 0;
623    LastMouse.WinControl := nil;
624  end;
625end;
626
627procedure gtkWSPopupMenuDeactivate(widget: PGtkWidget; data: gPointer); cdecl;
628begin
629  if widget = MenuWidget then
630    MenuWidget := nil;
631  if data <> nil then
632    g_idle_add(@gtkWSPopupDelayedClose, Pointer(PWidgetInfo(data)^.LCLObject));
633end;
634
635
636class procedure TGtk2WSPopupMenu.SetCallbacks(const AGtkWidget: PGtkWidget;
637  const AWidgetInfo: PWidgetInfo);
638begin
639  g_signal_connect_after(PGtkObject(AGtkWidget), 'deactivate',
640    gtk_signal_func(@gtkWSPopupMenuDeactivate), AWidgetInfo);
641end;
642
643class function TGtk2WSPopupMenu.CreateHandle(const AMenu: TMenu): HMENU;
644var
645  Widget: PGtkWidget;
646  WidgetInfo: PWidgetInfo;
647begin
648  Widget := gtk_menu_new;
649  Result := HMENU({%H-}PtrUInt(Widget));
650  {$IFDEF DebugLCLComponents}
651  DebugGtkWidgets.MarkCreated(Widget, dbgsName(AMenu));
652  {$ENDIF}
653  WidgetInfo := CreateWidgetInfo(Widget);
654  WidgetInfo^.LCLObject := AMenu;
655  SetCallbacks(Widget, WidgetInfo);
656end;
657
658class procedure TGtk2WSPopupMenu.Popup(const APopupMenu: TPopupMenu; const X,
659  Y: integer);
660var
661  APoint: TPoint;
662  AProc: Pointer;
663  WidgetInfo: PWidgetInfo;
664begin
665  if MenuWidget<>nil then //cannot popup when another popup menu is visible
666    Exit;
667
668  ReleaseMouseCapture;
669  APoint.X := X;
670  APoint.Y := Y;
671  AProc := @GtkWS_Popup;
672
673  MenuWidget := {%H-}PGtkWidget(APopupMenu.Handle);
674  WidgetInfo := GetWidgetInfo(MenuWidget);
675  WidgetInfo^.UserData := @APoint;
676  WidgetInfo^.DataOwner := False;
677  // MenuWidget can be either GtkMenu or GtkMenuItem submenu
678  if GTK_IS_MENU_ITEM(MenuWidget) then
679    MenuWidget := gtk_menu_item_get_submenu(PGtkMenuItem(MenuWidget));
680  gtk_menu_popup(PGtkMenu(MenuWidget), nil, nil, TGtkMenuPositionFunc(AProc),
681                 WidgetInfo, 0, gtk_get_current_event_time());
682  repeat
683    try
684      WidgetSet.AppProcessMessages; // process all events
685    except
686      if Application.CaptureExceptions then
687        Application.HandleException(APopupMenu)
688      else
689        raise;
690    end;
691    if Application.Terminated or not Assigned(MenuWidget) then
692      break;
693    Application.Idle(true);
694  until False;
695end;
696
697end.
698