(*
    GTK-Kylix Library: GTKMenus - Menu handling and related routines
    Version 0.6.13  (last updated 2003-07-10)
    Copyright (C) 2003 Tomas Bzatek <tbzatek@users.sourceforge.net>

    This library is free software; you can redistribute it and/or
    modify it under the terms of the GNU Library General Public
    License as published by the Free Software Foundation; either
    version 2 of the License, or (at your option) any later version.

    This library 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.  See the GNU
    Library General Public License for more details.

    You should have received a copy of the GNU Library General Public
    License along with this library; if not, write to the
    Free Software Foundation, Inc., 59 Temple Place - Suite 330,
    Boston, MA  02111-1307  USA.

*)

unit GTKMenus;

interface

uses gtk2, gdk2, glib2, Classes, GTKControls, GTKConsts, GTKUtils, GTKPixbuf;
   //  Quick jump: QForms QControls QMenus


type
(****************************************** TGDKSHORTCUTS ***********************************************************************)
  TGDKShortCut = record
    Key: word;
    Locked: boolean;
    ModAlt: boolean;
    ModShift: boolean;
    ModCtrl: boolean;
  end;
  TGDKShortCuts = class(TComponent)
  private
    FList: TList;
    FOwner: TGTKControl;
    function GetCount: Integer;
    function GetItem(Index: Integer): TGDKShortCut;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Add(Item: TGDKShortCut);
    procedure AddName(Item: string);
    procedure Clear;
    procedure Delete(Index: Integer);
    procedure Insert(Index: Integer; Item: TGDKShortCut);
    function IndexOf(Item: TGDKShortCut): Integer;
    property Count: Integer read GetCount;
    property Items[Index: Integer]: TGDKShortCut read GetItem; default;
  end;

(****************************************** TGTKMENUITEM ************************************************************************)
  TGTKMenuItemType = (itLabel, itSeparator, itTearOff, itCheck, itImageText, itRadio);
  TGTKMenuItemGroup = PGSList;
  TGTKMenuItem = class(TGTKBin)
  private
    FItems: TList;
    FTearOffTitle: string;
    FOnClick: TNotifyEvent;
    FUKey: guint;
    FItemType: TGTKMenuItemType;
    FNotify: TNotifyEvent;
    FImageWidget: PGtkWidget;
    FData: Pointer;
    FOnPopup: TNotifyEvent;
    function GetCount: Integer;
    function GetItem(Index: Integer): TGTKMenuItem;
    function GetCaption: string;
    function GetRightJustified: boolean;
    function GetTornOff: boolean;
    function GetChecked: boolean;
    function GetGroup: TGTKMenuItemGroup;
    procedure SetCaption(Value: string);
    procedure SetTearOffTitle(Value: string);
    procedure SetRightJustified(Value: boolean);
    procedure SetItemType(Value: TGTKMenuItemType);
    procedure SetTornOff(Value: boolean);
    procedure SetChecked(Value: boolean);
    procedure SetStockIcon(Value: string);
    procedure SetIcon(Value: TGDKPixbuf);
    procedure SetGroup(Value: TGTKMenuItemGroup);
  protected
  public
    FMenu: PGtkWidget;
    FParentMenu: TGTKControl;
    ShortCuts: TGDKShortCuts;
    constructor Create(AOwner: TComponent); override;
    constructor CreateTyped(AOwner: TComponent; const ItemType: TGTKMenuItemType; AGroup: TGTKMenuItemGroup = nil);
    destructor Destroy; override;
    procedure Recreate(AGroup: TGTKMenuItemGroup = nil);
    procedure Add(Item: TGTKMenuItem);
    procedure Clear;
    procedure Delete(Index: Integer);
    procedure Insert(Index: Integer; Item: TGTKMenuItem);
    procedure TearOff;
    procedure UnTearOff;
    procedure PopUp;
    procedure PopDown;
    procedure SetCaptionPlain(Value: string);
    property Count: Integer read GetCount;
    property Items[Index: Integer]: TGTKMenuItem read GetItem; default;
    property Caption: string read GetCaption write SetCaption;
    property TearOffTitle: string read FTearOffTitle write SetTearOffTitle;
    property RightJustified: boolean read GetRightJustified write SetRightJustified default False;
    property OnClick: TNotifyEvent read FOnClick write FOnClick;
    property ItemType: TGTKMenuItemType read FItemType write SetItemType default itLabel;
    property TornOff: boolean read GetTornOff write SetTornOff;
    property Checked: boolean read GetChecked write SetChecked;
    property Notify: TNotifyEvent read FNotify write FNotify;
    property StockIcon: string write SetStockIcon;
    property Icon: TGDKPixbuf write SetIcon;
    property Data: Pointer read FData write FData;
    property OnPopup: TNotifyEvent read FOnPopup write FOnPopup;
    property Group: TGTKMenuItemGroup read GetGroup write SetGroup;
  end;


(****************************************** TGTKMENUBAR *************************************************************************)
  TGTKMenuBar = class(TGTKContainer)
  private
    FItems: TGTKMenuItem;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property Items: TGTKMenuItem read FItems;
  end;

  
function MakeGDKShortCut(Key: word; Locked, ModAlt, ModShift, ModCtrl : boolean): TGDKShortCut;

(********************************************************************************************************************************)
(********************************************************************************************************************************)
(********************************************************************************************************************************)
(********************************************************************************************************************************)
implementation

uses GTKForms, GTKExtCtrls;

(********************************************************************************************************************************)
(********************************************************************************************************************************)
constructor TGTKMenuBar.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FWidget := gtk_menu_bar_new;
  Show;
  FItems := TGTKMenuItem.Create(Self);
  FItems.FParentMenu := Self;
end;

destructor TGTKMenuBar.Destroy;
begin
  if Assigned(FItems) then FItems.Free;
  inherited Destroy;
end;

(********************************************************************************************************************************)
(********************************************************************************************************************************)
procedure TGTKMenuItem_activate(menuitem : PGtkMenuItem; user_data: pgpointer); cdecl;
begin
  if Assigned(TGTKMenuItem(user_data).FOnClick) then TGTKMenuItem(user_data).FOnClick(TGTKMenuItem(user_data));
end;

constructor TGTKMenuItem.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FItemType := itLabel;
  FImageWidget := nil;
  FItems := nil;
  FMenu := nil;
  FOnClick := nil;
  FWidget := nil;
  FParentMenu := nil;
  FNotify := nil;
  FData := nil;
  FOnPopup := nil;
  ShortCuts := TGDKShortCuts.Create(Self);
  FTearOffTitle := '';
  FUKey := 0;
  Recreate;
end;

constructor TGTKMenuItem.CreateTyped(AOwner: TComponent; const ItemType: TGTKMenuItemType; AGroup: TGTKMenuItemGroup = nil);
begin
  inherited Create(AOwner);
  FItemType := ItemType;
  FImageWidget := nil;
  FItems := nil;
  FMenu := nil;
  FOnClick := nil;
  FWidget := nil;
  FParentMenu := nil;
  FNotify := nil;
  FData := nil;
  ShortCuts := TGDKShortCuts.Create(Self);
  FTearOffTitle := '';
  FUKey := 0;
  Recreate(AGroup);
end;

destructor TGTKMenuItem.Destroy;
begin
  if not (csDestroying in ComponentState) then begin
    ShortCuts.Free;
    if FItems <> nil then begin
      Clear;
      FItems.Free;
      FItems := nil;
    end;
  end;
  inherited Destroy;
end;

procedure TGTKMenuItem.Recreate(AGroup: TGTKMenuItemGroup = nil);
begin
  if Assigned(FWidget) then begin
    gtk_widget_unparent(FWidget);
    gtk_widget_hide(FWidget);
    gtk_widget_destroy(FWidget);
  end;
  case FItemType of
    itLabel: FWidget := gtk_menu_item_new_with_mnemonic(Pgchar(SCDefaultMenuItemCaption));
    itSeparator: FWidget := gtk_menu_item_new;
    itTearOff: FWidget := gtk_tearoff_menu_item_new;
    itCheck: FWidget := gtk_check_menu_item_new_with_mnemonic(Pgchar(SCDefaultMenuItemCaption));
    itImageText: begin
                   FWidget := gtk_image_menu_item_new_with_mnemonic(Pgchar(SCDefaultMenuItemCaption));
                   FImageWidget := gtk_image_new;
                   gtk_widget_show(FImageWidget);
                   gtk_image_menu_item_set_image(PGtkImageMenuItem(FWidget), FImageWidget);
                 end;
    itRadio: FWidget := gtk_radio_menu_item_new_with_mnemonic(AGroup, Pgchar(SCDefaultMenuItemCaption));
  end;
  g_signal_connect(PGtkObject(FWidget), 'activate', G_CALLBACK(@TGTKMenuItem_activate), Self);
  Show;
end;

procedure TGTKMenuItem.Add(Item: TGTKMenuItem);
begin
  Insert(GetCount, Item);
end;

procedure TGTKMenuItem.Clear;
var i: Integer;
begin
  if Count > 0 then
    for i := Count - 1 downto 0 do Delete(i);
end;

function TGTKMenuItem.GetCount: Integer;
begin
  if FItems = nil then Result := 0
  else Result := FItems.Count;
end;

function TGTKMenuItem.GetItem(Index: Integer): TGTKMenuItem;
begin
  Result := nil;
  if FItems = nil then Exit;
  Result := FItems[Index];
end;

procedure TGTKMenuItem.Delete(Index: Integer);
begin
  if (Index < 0) or (FItems = nil) or (Index >= GetCount) then Exit;
  if FParentMenu is TGTKMenuBar
    then gtk_container_remove(PGtkContainer(Parent.FWidget), TGTKMenuItem(FItems[Index]).FWidget)
    else gtk_container_remove(PGtkContainer(FMenu), TGTKMenuItem(FItems[Index]).FWidget);
//  Items[Index].Free;
  FItems.Delete(Index);
  if FItems.Count = 0 then begin
    if (FParentMenu is TGTKMenuItem) or (FParentMenu is TGTKMenuBar)
      then begin
             if (FParentMenu is TGTKMenuItem) or (FParentMenu is TGTKMenuBar)
               then gtk_menu_item_remove_submenu(PGtkMenuItem(FWidget));
             gtk_widget_destroy(FMenu);
             FMenu := nil;
           end;
    FItems.Free;
    FItems := nil;
  end;
  if Assigned(Notify) then Notify(Self);
end;

procedure TGTKMenuItem.Insert(Index: Integer; Item: TGTKMenuItem);
begin
  if (Item = Self) or (FItemType in [itSeparator, itTearOff]) then Exit;
  if FItems = nil then begin
    FItems := TList.Create;
    if FMenu = nil then FMenu := gtk_menu_new;
    if (FParentMenu is TGTKMenuItem) or (FParentMenu is TGTKMenuBar)
      then gtk_menu_item_set_submenu(PGtkMenuItem(FWidget), FMenu);
    SetTearOffTitle(FTearOffTitle);
  end;
  Item.FParentMenu := Self;
  FItems.Insert(Index, Item);
  if FParentMenu is TGTKMenuBar
    then gtk_menu_shell_insert(PGtkMenuShell(FParentMenu.FWidget), Item.FWidget, Index)
    else gtk_menu_shell_insert(PGtkMenuShell(FMenu), Item.FWidget, Index);
  if Assigned(Notify) then Notify(Self);
end;

function TGTKMenuItem.GetCaption: string;
begin
  Result := '';
  if FItemType in [itSeparator, itTearOff] then Exit;
  if Assigned(ChildControl) then Result := PgcharToString(gtk_label_get_text(PGtkLabel(ChildControl)));
end;

procedure TGTKMenuItem.SetCaption(Value: string);
begin
  if FItemType in [itSeparator, itTearOff] then Exit;
  gtk_label_set_markup_with_mnemonic(PGtkLabel(ChildControl), StringToPgchar(Value));
  if FTearOffTitle = '' then SetTearOffTitle(Value);
end;

procedure TGTKMenuItem.SetCaptionPlain(Value: string);
begin
  if FItemType in [itSeparator, itTearOff] then Exit;
  gtk_label_set_markup(PGtkLabel(ChildControl), StringToPgchar(Value));
  if FTearOffTitle = '' then SetTearOffTitle(Value);
end;

procedure TGTKMenuItem.SetTearOffTitle(Value: string);
begin
  FTearOffTitle := Value;
  if FItemType = itTearOff then begin
    if Assigned(FParentMenu) and (FParentMenu is TGTKMenuItem) and Assigned((FParentMenu as TGTKMenuItem).FMenu)
      then gtk_menu_set_title(PGtkMenu((FParentMenu as TGTKMenuItem).FMenu), StringToPgchar(FTearOffTitle))
    end else if Assigned(FMenu) then gtk_menu_set_title(PGtkMenu(FMenu), StringToPgchar(FTearOffTitle));
end;

function TGTKMenuItem.GetRightJustified: boolean;
begin
  Result := False;
  if FItemType in [itSeparator, itTearOff] then Exit;
  Result := gtk_menu_item_get_right_justified(PGtkMenuItem(FWidget));
end;

procedure TGTKMenuItem.SetRightJustified(Value: boolean);
begin
  if FItemType in [itSeparator, itTearOff] then Exit;
  gtk_menu_item_set_right_justified(PGtkMenuItem(FWidget), Value);
end;

procedure TGTKMenuItem.SetItemType(Value: TGTKMenuItemType);
begin
  if Value <> FItemType then begin
    FItemType := Value;
    Recreate;
  end;
end;

function TGTKMenuItem.GetTornOff: boolean;
begin
  if FItemType = itTearOff then Result := Boolean(torn_off(PGTKTearOffMenuItem(FWidget)^)) else
  if Assigned(FMenu) and (Count > 0) then Result := Boolean(torn_off(PGTKMenu(FMenu)^))
  else Result := False;
end;

procedure TGTKMenuItem.SetTornOff(Value: boolean);
begin
  if FItemType = itTearOff then begin
    if Assigned(FParentMenu) and (FParentMenu is TGTKMenuItem) and Assigned((FParentMenu as TGTKMenuItem).FMenu)
      then gtk_menu_set_tearoff_state(PGtkMenu((FParentMenu as TGTKMenuItem).FMenu), Value);
  end else if Assigned(FMenu) then gtk_menu_set_tearoff_state(PGtkMenu(FMenu), Value);
end;

procedure TGTKMenuItem.TearOff;
begin
  SetTornOff(True);
end;

procedure TGTKMenuItem.UnTearOff;
begin
  SetTornOff(False);
end;

function TGTKMenuItem.GetChecked: boolean;
begin
  Result := False;
  if (FItemType = itCheck) or (FItemType = itRadio) then
    Result := Boolean(active(PGtkCheckMenuItem(FWidget)^));
end;

procedure TGTKMenuItem.SetChecked(Value: boolean);
begin
  if (FItemType = itCheck) or (FItemType = itRadio) then
    gtk_check_menu_item_set_active(PGtkCheckMenuItem(FWidget), Value);
end;

procedure TGTKMenuItem.PopUp;
begin
  if Assigned(FOnPopup) then FOnPopup(Self);
  if (FItems <> nil) and (FItems.Count > 0) then gtk_menu_popup(PGtkMenu(FMenu), nil, nil, nil, nil, 3, gtk_get_current_event_time);
end;

procedure TGTKMenuItem.PopDown;
begin
  if (FItems <> nil) and (FItems.Count > 0) then gtk_menu_popdown(PGtkMenu(FMenu));
end;

procedure TGTKMenuItem.SetStockIcon(Value: string);
begin
  gtk_image_set_from_stock(PGtkImage(FImageWidget), PChar(Value), GTK_ICON_SIZE_MENU);
end;

procedure TGTKMenuItem.SetIcon(Value: TGDKPixbuf);
begin
  gtk_image_set_from_pixbuf(PGtkImage(FImageWidget), Value.FPixbuf);
end;

function TGTKMenuItem.GetGroup: TGTKMenuItemGroup;
begin
  Result := gtk_radio_menu_item_get_group(PGtkRadioMenuItem(FWidget));
end;

procedure TGTKMenuItem.SetGroup(Value: TGTKMenuItemGroup);
begin
  gtk_radio_menu_item_set_group(PGtkRadioMenuItem(FWidget), Value);
end;

(********************************************************************************************************************************)
(********************************************************************************************************************************)
constructor TGDKShortCuts.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FList := TList.Create;
  FOwner := TGTKControl(AOwner);
end;

destructor TGDKShortCuts.Destroy;
begin
  if not (csDestroying in ComponentState) then Clear;
  inherited Destroy;
end;

function TGDKShortCuts.GetCount: Integer;
begin
  Result := FList.Count;
end;

procedure TGDKShortCuts.Add(Item: TGDKShortCut);
begin
  Insert(GetCount, Item);
end;

procedure TGDKShortCuts.AddName(Item: string);
var Key, Modifiers: guint;
begin
  gtk_accelerator_parse(StringToPgchar(Item), @Key, @Modifiers);
  if Key <> 0 then Add(MakeGDKShortCut(Key, False, Modifiers and GDK_MOD1_MASK = GDK_MOD1_MASK, Modifiers and GDK_SHIFT_MASK = GDK_SHIFT_MASK, Modifiers and GDK_CONTROL_MASK = GDK_CONTROL_MASK));
end;

procedure TGDKShortCuts.Clear;
var i: Integer;
begin
  for i := Count - 1 downto 0 do Delete(i);
end;

function GetAccelMods(SC: TGDKShortCut): guint;
begin
  Result := 0;
  if SC.ModShift then Inc(Result, GDK_SHIFT_MASK);
  if SC.ModCtrl then Inc(Result, GDK_CONTROL_MASK);
  if SC.ModAlt then Inc(Result, GDK_MOD1_MASK);
end;

function GetAccelFlags(SC: TGDKShortCut): TGtkAccelFlags;
begin
  Result := GTK_ACCEL_VISIBLE;
  if SC.Locked then Result := GTK_ACCEL_LOCKED;
end;
    
procedure TGDKShortCuts.Delete(Index: Integer);
begin
  if (Index < 0) or (FList = nil) or (Index >= GetCount) then Exit;
  if (GetParentForm(FOwner) <> nil) and (not (csDestroying in ComponentState))
    then gtk_widget_remove_accelerator(FOwner.FWidget, GetParentForm(FOwner).FAccelGroup, TGDKShortCut(FList[Index]^).Key, GetAccelMods(TGDKShortCut(FList[Index]^)));
  FList.Delete(Index);
end;

procedure TGDKShortCuts.Insert(Index: Integer; Item: TGDKShortCut);
begin
  FList.Insert(Index, @Item);
  if GetParentForm(FOwner) <> nil
    then gtk_widget_add_accelerator(FOwner.FWidget, 'activate', GetParentForm(FOwner).FAccelGroup, Item.Key, GetAccelMods(Item), GetAccelFlags(Item));
end;

function TGDKShortCuts.GetItem(Index: Integer): TGDKShortCut;
begin
  Result := TGDKShortCut(FList[Index]^);
end;

function TGDKShortCuts.IndexOf(Item: TGDKShortCut): Integer;
var i : integer;
begin
  Result := -1;
  if FList.Count > 0 then
    for i := 0 to FList.Count - 1 do
      if (TGDKShortCut(FList[i]^).Key = Item.Key) and (TGDKShortCut(FList[i]^).Locked = Item.Locked) and
         (TGDKShortCut(FList[i]^).ModAlt = Item.ModAlt) and (TGDKShortCut(FList[i]^).ModShift = Item.ModShift) and
         (TGDKShortCut(FList[i]^).ModCtrl = Item.ModCtrl) then
        begin
          Result := i;
          Break;
        end;
end;

function MakeGDKShortCut(Key: word; Locked, ModAlt, ModShift, ModCtrl : boolean): TGDKShortCut;
begin
  Result.Key := Key;
  Result.Locked := Locked;
  Result.ModAlt := ModAlt;
  Result.ModShift := ModShift;
  Result.ModCtrl := ModCtrl;
end;

(********************************************************************************************************************************)
(********************************************************************************************************************************)


end.