lazarus/lcl/interfaces/gtk2/gtk2wsmenus.pp
mattias 1370bedf98 gtk2 intf: Add Bidi to Menus, bug #16387
git-svn-id: trunk@25174 -
2010-05-04 09:58:30 +00:00

525 lines
17 KiB
ObjectPascal

{ $Id$}
{
*****************************************************************************
* Gtk2WSMenus.pp *
* -------------- *
* *
* *
*****************************************************************************
*****************************************************************************
* *
* This file is part of the Lazarus Component Library (LCL) *
* *
* See the file COPYING.modifiedLGPL.txt, 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. *
* *
*****************************************************************************
}
unit Gtk2WSMenus;
{$mode objfpc}{$H+}
interface
uses
glib2, gdk2pixbuf, gdk2, gtk2, Pango,
GtkInt, GtkProc, GtkGlobals, GtkDef, GtkExtra, GtkWSMenus,
Classes, InterfaceBase, Types, LCLProc, LCLType, WSMenus, WSLCLClasses,
LMessages, Graphics, Menus, Forms, LCLIntf;
type
{ TGtk2WSMenuItem }
TGtk2WSMenuItem = class(TWSMenuItem)
protected
class procedure SetCallbacks(const AGtkWidget: PGtkWidget; const AWidgetInfo: PWidgetInfo);
published
class procedure AttachMenu(const AMenuItem: TMenuItem); override;
class function CreateHandle(const AMenuItem: TMenuItem): HMENU; override;
class procedure DestroyHandle(const AMenuItem: TMenuItem); override;
class procedure SetCaption(const AMenuItem: TMenuItem; const ACaption: string); override;
class procedure SetShortCut(const AMenuItem: TMenuItem; const OldShortCut, NewShortCut: TShortCut); override;
class procedure SetVisible(const AMenuItem: TMenuItem; const Visible: boolean); override;
class function SetCheck(const AMenuItem: TMenuItem; const Checked: boolean): boolean; override;
class function SetEnable(const AMenuItem: TMenuItem; const Enabled: boolean): boolean; override;
class function SetRadioItem(const AMenuItem: TMenuItem; const RadioItem: boolean): boolean; override;
class function SetRightJustify(const AMenuItem: TMenuItem; const Justified: boolean): boolean; override;
class procedure UpdateMenuIcon(const AMenuItem: TMenuItem; const HasIcon: Boolean; const AIcon: TBitmap); override;
end;
{ TGtk2WSMenu }
TGtk2WSMenu = class(TGtkWSMenu)
published
class procedure SetBiDiMode(const AMenu: TMenu; UseRightToLeftAlign, UseRightToLeftReading : Boolean); override;
end;
{ TGtk2WSMainMenu }
TGtk2WSMainMenu = class(TWSMainMenu)
published
end;
{ TGtk2WSPopupMenu }
TGtk2WSPopupMenu = class(TWSPopupMenu)
published
end;
implementation
{$I gtkdefines.inc}
function Gtk2MenuItemButtonPress(widget: PGtkWidget; event: PGdkEventButton;
user_data: gpointer): gboolean; cdecl;
var
Parent: PGtkWidget;
WidgetInfo: PWidgetInfo;
begin
Result := False;
if (event^._type = GDK_BUTTON_PRESS) then
begin
Parent := gtk_widget_get_parent(Widget);
if (Parent <> nil) and GTK_IS_MENU_BAR(Parent) then
begin
if (gtk_menu_item_get_submenu(PGtkMenuItem(Widget)) = nil) then
begin
WidgetInfo := GetWidgetInfo(Widget);
if Assigned(TMenuItem(WidgetInfo^.LCLObject).OnClick) then
gtk_menu_item_activate(PGtkMenuItem(Widget));
end;
end;
end;
end;
function Gtk2MenuItemActivate(widget: PGtkWidget; data: gPointer) : GBoolean; cdecl;
var
Mess: TLMActivate;
LCLMenuItem: TMenuItem;
begin
Result:= True;
{$IFDEF EventTrace}
EventTrace('activate', data);
{$ENDIF}
ResetDefaultIMContext;
if LockOnChange(PgtkObject(Widget),0) > 0 then Exit;
LCLMenuItem := TMenuItem(Data);
// the gtk fires activate for radio buttons when unchecking them
// the LCL expects only uncheck
if LCLMenuItem.RadioItem
and GtkWidgetIsA(Widget, GTK_TYPE_CHECK_MENU_ITEM)
and (not gtk_check_menu_item_get_active(PGTKCheckMenuItem(Widget))) then Exit;
FillChar(Mess,SizeOf(Mess),#0);
Mess.Msg := LM_ACTIVATE;
Mess.Active:=true;
Mess.Minimized:=false;
Mess.ActiveWindow:=0;
Mess.Result := 0;
DeliverMessage(Data, Mess);
Result := CallBackDefaultReturn;
end;
function Gtk2MenuItemToggled(AMenuItem: PGTKCheckMenuItem;
AData: gPointer): GBoolean; cdecl;
var
LCLMenuItem: TMenuItem;
Mess: TLMessage;
b: Boolean;
w: PGtkWidget;
WidgetInfo: PWidgetInfo;
begin
Result := CallBackDefaultReturn;
{$IFDEF EventTrace}
EventTrace('toggled', AData);
{$ENDIF}
if LockOnChange(PgtkObject(AMenuItem),0) > 0 then Exit;
LCLMenuItem := TMenuItem(AData);
if (csDesigning in LCLMenuItem.ComponentState) then
exit;
w := gtk_get_event_widget(gtk_get_current_event);
if not GTK_IS_RADIO_MENU_ITEM(w) then
exit;
b := gtk_check_menu_item_get_active(AMenuItem);
if not LCLMenuItem.Checked then
g_signal_stop_emission_by_name(AMenuItem, 'toggled')
else
g_signal_stop_emission_by_name(AMenuItem, 'activate');
if b <> LCLMenuItem.Checked then
gtk_check_menu_item_set_active(AMenuItem, LCLMenuItem.Checked);
{we must trigger OnClick() somehow, since we stopped signals}
if b and (w <> nil) and (w <> PGtkWidget(AMenuItem)) then
begin
WidgetInfo := GetWidgetInfo(w);
FillChar(Mess,SizeOf(Mess),#0);
Mess.Msg := LM_ACTIVATE;
WidgetInfo^.LCLObject.Dispatch(Mess);
end;
end;
function Gtk2MenuItemSelect(item: Pointer; AMenuItem: TMenuItem): GBoolean; cdecl;
begin
AMenuItem.IntfDoSelect;
Result := CallBackDefaultReturn;
end;
procedure Gtk2MenuItemToggleSizeRequest(AMenuItem: PGtkMenuItem; requisition: Pgint; LCLItem: TMenuItem); cdecl;
var
spacing: guint;
IconWidth: Integer;
begin
if LCLItem.HasIcon then
begin
IconWidth := LCLItem.GetIconSize.X;
if IconWidth > 0 then
begin
gtk_widget_style_get(PGtkWidget(AMenuItem), 'toggle-spacing', [@spacing, nil]);
requisition^ := IconWidth + spacing;
end
else
requisition^ := 0;
end
else
GTK_MENU_ITEM_GET_CLASS(AMenuItem)^.toggle_size_request(AMenuItem, requisition);
end;
procedure Gtk2MenuItemSizeRequest(AMenuItem: PGtkMenuItem; requisition: PGtkRequisition; LCLItem: TMenuItem); cdecl;
var
IconHeight: Integer;
begin
GTK_WIDGET_GET_CLASS(AMenuItem)^.size_request(PGtkWidget(AMenuItem), requisition);
IconHeight := LCLItem.GetIconSize.Y;
if requisition^.height < IconHeight then
requisition^.height := IconHeight;
end;
function Gtk2MenuItemDeselect(item: Pointer; AMenuItem: TMenuItem): GBoolean; cdecl;
begin
Application.Hint := '';
Result := CallBackDefaultReturn;
end;
{ TGtk2WSMenuItem }
class procedure TGtk2WSMenuItem.SetCallbacks(const AGtkWidget: PGtkWidget;
const AWidgetInfo: PWidgetInfo);
begin
// connect activate signal (i.e. clicked)
{button-press-event is needed by root menu items which have not
submenu, but OnClick() is assigned - fix for #15986 }
g_signal_connect_after(PGTKObject(AGtkWidget), 'button-press-event',
TGTKSignalFunc(@Gtk2MenuItemButtonPress), AWidgetInfo^.LCLObject);
g_signal_connect(PGTKObject(AGtkWidget), 'activate',
TGTKSignalFunc(@Gtk2MenuItemActivate), AWidgetInfo^.LCLObject);
g_signal_connect(PGTKObject(AGtkWidget), 'select',
TGTKSignalFunc(@Gtk2MenuItemSelect), AWidgetInfo^.LCLObject);
g_signal_connect(PGTKObject(AGtkWidget), 'deselect',
TGTKSignalFunc(@Gtk2MenuItemDeselect), AWidgetInfo^.LCLObject);
g_signal_connect(PGTKObject(AGtkWidget), 'toggle-size-request',
TGTKSignalFunc(@Gtk2MenuItemToggleSizeRequest), AWidgetInfo^.LCLObject);
g_signal_connect(PGTKObject(AGtkWidget), 'size-request',
TGTKSignalFunc(@Gtk2MenuItemSizeRequest), AWidgetInfo^.LCLObject);
end;
class procedure TGtk2WSMenuItem.AttachMenu(const AMenuItem: TMenuItem);
var
//AccelKey: Integer;
//AccelGroup: PGTKAccelGroup;
MenuItem, ParentMenuWidget, ContainerMenu: PGtkWidget;
begin
//DebugLn('TGtkWidgetSet.AttachMenu START ',AMenuItem.Name,':',AMenuItem.ClassName,' Parent=',AMenuItem.Parent.Name,':',AMenuItem.Parent.ClassName);
with AMenuItem do
begin
MenuItem := PGtkWidget(Handle);
if MenuItem=nil then
RaiseGDBException('TGtkWidgetSet.AttachMenu Handle=0');
ParentMenuWidget := PGtkWidget(Parent.Handle);
if ParentMenuWidget=nil then
RaiseGDBException('TGtkWidgetSet.AttachMenu ParentMenuWidget=nil');
if GTK_IS_MENU_BAR(ParentMenuWidget) then
begin
// mainmenu (= a menu bar)
ContainerMenu := ParentMenuWidget;
gtk_menu_bar_insert(ParentMenuWidget, MenuItem, AMenuItem.MenuVisibleIndex);
end
else
begin
// if it is a menu
if GTK_IS_MENU(ParentMenuWidget) then
ContainerMenu := ParentMenuWidget
else // menu item
ContainerMenu := PGtkWidget(gtk_object_get_data(PGtkObject(ParentMenuWidget),
'ContainerMenu')); // find the menu container
if ContainerMenu = nil then
begin
if (GetParentMenu is TPopupMenu) and (Parent.Parent=nil) then
begin
ContainerMenu := PGtkWidget(GetParentMenu.Handle);
gtk_object_set_data(PGtkObject(ContainerMenu), 'ContainerMenu',
ContainerMenu);
end else
begin
ContainerMenu := gtk_menu_new;
gtk_object_set_data(PGtkObject(ParentMenuWidget), 'ContainerMenu',
ContainerMenu);
gtk_menu_item_set_submenu(PGTKMenuItem(ParentMenuWidget), ContainerMenu);
end;
end;
gtk_menu_insert(ContainerMenu, MenuItem, AMenuItem.MenuVisibleIndex);
end;
if GtkWidgetIsA(MenuItem, GTK_TYPE_RADIO_MENU_ITEM) then
TGtkWidgetSet(WidgetSet).RegroupMenuItem(HMENU(PtrUInt(MenuItem)), GroupIndex);
end;
//DebugLn('TGtkWidgetSet.AttachMenu END ',AMenuItem.Name,':',AMenuItem.ClassName);
end;
class function TGtk2WSMenuItem.CreateHandle(const AMenuItem: TMenuItem): HMENU;
var
Widget: PGtkWidget;
WidgetInfo: PWidgetInfo;
begin
// create the menuitem widget (normal, check or radio)
if AMenuItem.Caption = cLineCaption then // create separator
Widget := gtk_menu_item_new
else
if AMenuItem.RadioItem and not AMenuItem.HasIcon then
Widget := gtk_radio_menu_item_new(nil)
else
if AMenuItem.IsCheckItem or AMenuItem.HasIcon then
Widget := gtk_check_menu_item_new
else
Widget := gtk_menu_item_new;
WidgetInfo := CreateWidgetInfo(Widget);
WidgetInfo^.LCLObject := AMenuItem;
if GtkWidgetIsA(Widget, GTK_TYPE_CHECK_MENU_ITEM) then
begin
// check or radio
// set 'ShowAlwaysCheckable'
gtk_check_menu_item_set_show_toggle(PGtkCheckMenuItem(Widget),
AMenuItem.ShowAlwaysCheckable);
// set 'Checked'
gtk_check_menu_item_set_active(PGtkCheckMenuItem(Widget),
AMenuItem.Checked);
g_signal_connect(PGTKObject(Widget), 'toggled',
TGTKSignalFunc(@Gtk2MenuItemToggled), Pointer(AMenuItem));
end;
// set attributes (enabled and rightjustify)
gtk_widget_set_sensitive(Widget,
AMenuItem.Enabled and (AMenuItem.Caption <> cLineCaption));
if AMenuItem.RightJustify then
gtk_menu_item_right_justify(PGtkMenuItem(Widget));
// create the hbox containing the label and the icon
UpdateInnerMenuItem(AMenuItem, Widget);
SetCallbacks(Widget, WidgetInfo);
gtk_widget_show(Widget);
{$IFDEF DebugLCLComponents}
DebugGtkWidgets.MarkCreated(Widget, dbgsName(AMenuItem));
{$ENDIF}
Result := HMENU(PtrUInt(Widget));
end;
class procedure TGtk2WSMenuItem.DestroyHandle(const AMenuItem: TMenuItem);
begin
{ TODO: cleanup }
TGtkWidgetSet(WidgetSet).DestroyLCLComponent(AMenuItem);
end;
class procedure TGtk2WSMenuItem.SetCaption(const AMenuItem: TMenuItem;
const ACaption: string);
var
MenuItemWidget: PGtkWidget;
begin
if not WSCheckMenuItem(AMenuItem, 'SetCaption') then
Exit;
MenuItemWidget:=PGtkWidget(AMenuItem.Handle);
UpdateInnerMenuItem(AMenuItem,MenuItemWidget);
gtk_widget_set_sensitive(PGtkWidget(AMenuItem.Handle),
AMenuItem.Enabled and (ACaption <> cLineCaption));
end;
class procedure TGtk2WSMenuItem.SetShortCut(const AMenuItem: TMenuItem;
const OldShortCut, NewShortCut: TShortCut);
//var
//MenuWidget: PGtkMenuItem;
//accel_path: String;
//CurKey: Word;
//CurShift: TShiftState;
begin
if not WSCheckMenuItem(AMenuItem, 'SetShortCut') then Exit;
//DebugLn(['TGtkWSMenuItem.SetShortCut ',dbgsName(AMenuItem),' ',ShortCutToText(NewShortCut)]);
// Temporary: At least it writes the names of the shortcuts
UpdateInnerMenuItem(AMenuItem, PGTKWidget(AMenuItem.Handle), NewShortCut);
{ // Gets the inner widgets. They should already be created by now
MenuWidget := PGtkMenuItem(AMenuItem.Handle);
if (MenuWidget=nil) then Exit;
// Converts the shortcut to a gtk friendly format and sets it
ShortCutToKey(NewShortCut, CurKey, CurShift);
accel_path := 'LCLApp/Menu/' + GetAcceleratorString(CurKey, CurShift);
gtk_accel_map_add_entry(accel_path, CurKey, ShiftToGdkModifierType);
gtk_menu_item_set_accel_path(); }
end;
class procedure TGtk2WSMenuItem.SetVisible(const AMenuItem: TMenuItem;
const Visible: boolean);
var
MenuItemWidget: PGtkWidget;
begin
if not WSCheckMenuItem(AMenuItem, 'SetVisible') then
Exit;
MenuItemWidget := PGtkWidget(AMenuItem.Handle);
if gtk_widget_visible(MenuItemWidget) = Visible then
Exit;
if Visible then
gtk_widget_show(MenuItemWidget)
else
gtk_widget_hide(MenuItemWidget);
end;
class function TGtk2WSMenuItem.SetCheck(const AMenuItem: TMenuItem;
const Checked: boolean): boolean;
var
IsRadio: Boolean;
Group: PGSList;
Item: Pointer;
begin
Result:=false;
if not WSCheckMenuItem(AMenuItem, 'SetCheck') then
Exit;
Item := Pointer(AMenuItem.Handle);
IsRadio := gtk_is_radio_menu_item(Item);
if IsRadio or gtk_is_check_menu_item(Item)
then begin
if IsRadio
then begin
Group := gtk_radio_menu_item_group(Item);
LockRadioGroupOnChange(Group, +1);
end
else LockOnChange(Item, +1);
gtk_check_menu_item_set_active(Item, Checked);
if IsRadio
then LockRadioGroupOnChange(Group, -1)
else LockOnChange(Item, -1);
Result := True;
end
else begin
AMenuItem.RecreateHandle;
Result := True;
end;
end;
class function TGtk2WSMenuItem.SetEnable(const AMenuItem: TMenuItem;
const Enabled: boolean): boolean;
begin
Result := False;
if not WSCheckMenuItem(AMenuItem, 'SetEnable') then
Exit;
gtk_widget_set_sensitive(PGtkWidget(AMenuItem.Handle),
Enabled and (AMenuItem.Caption <> cLineCaption));
Result := True;
end;
class function TGtk2WSMenuItem.SetRadioItem(const AMenuItem: TMenuItem;
const RadioItem: boolean): boolean;
begin
AMenuItem.RecreateHandle;
Result := True;
end;
class function TGtk2WSMenuItem.SetRightJustify(const AMenuItem: TMenuItem;
const Justified: boolean): boolean;
var
MenuItemWidget: PGtkMenuItem;
begin
Result := False;
if not WSCheckMenuItem(AMenuItem, 'SetRightJustify') then
Exit;
MenuItemWidget := PGtkMenuItem(AMenuItem.Handle);
gtk_menu_item_set_right_justified(MenuItemWidget, Justified);
gtk_widget_queue_resize(GTK_WIDGET(MenuItemWidget));
Result := True;
end;
class procedure TGtk2WSMenuItem.UpdateMenuIcon(const AMenuItem: TMenuItem;
const HasIcon: Boolean; const AIcon: TBitmap);
begin
if not WSCheckMenuItem(AMenuItem, 'UpdateMenuIcon') then
Exit;
if gtk_is_check_menu_item(Pointer(AMenuItem.Handle)) <> HasIcon then
AMenuItem.RecreateHandle;
end;
{ TGtk2WSMenu }
class procedure TGtk2WSMenu.SetBiDiMode(const AMenu : TMenu;
UseRightToLeftAlign, UseRightToLeftReading : Boolean);
const
WidgetDirection : array[boolean] of longint = (GTK_TEXT_DIR_LTR, GTK_TEXT_DIR_RTL);
{$ifdef GTK_2_8}
const
MenuDirection : array[Boolean] of Longint = (
GTK_PACK_DIRECTION_LTR,
GTK_PACK_DIRECTION_RTL);
{$endif}
procedure Switch(AMenuItem: TMenuItem; Flip: Boolean);
var
i: Integer;
begin
if Flip then
begin
gtk_widget_set_direction(PGtkWidget(AMenuItem.Handle), WidgetDirection[UseRightToLeftAlign]);
UpdateInnerMenuItem(AMenuItem, PGtkWidget(AMenuItem.Handle));
end;
for i := 0 to AMenuItem.Count -1 do
Switch(AMenuItem[i], True);
end;
begin
{$ifdef GTK_2_8}
gtk_menu_bar_set_pack_direction(PGtkMenuBar(AMenu.Handle), MenuDirection[UseRightToLeftAlign]);
gtk_menu_bar_set_child_pack_direction(PGtkMenuBar(AMenu.Handle), MenuDirection[UseRightToLeftAlign]);
{$endif}
//gtk_widget_set_direction(PGtkWidget(AMenu.Handle), WidgetDirection[UseRightToLeftAlign]);
Switch(AMenu.Items, False);
end;
end.