aboutsummaryrefslogtreecommitdiffstats
path: root/lib/gs/src/gstk_menuitem.erl
diff options
context:
space:
mode:
Diffstat (limited to 'lib/gs/src/gstk_menuitem.erl')
-rw-r--r--lib/gs/src/gstk_menuitem.erl582
1 files changed, 582 insertions, 0 deletions
diff --git a/lib/gs/src/gstk_menuitem.erl b/lib/gs/src/gstk_menuitem.erl
new file mode 100644
index 0000000000..36a9253598
--- /dev/null
+++ b/lib/gs/src/gstk_menuitem.erl
@@ -0,0 +1,582 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1996-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+%%
+%% ------------------------------------------------------------
+%% Basic Menuitem Type
+%% ------------------------------------------------------------
+
+-module(gstk_menuitem).
+
+%%-----------------------------------------------------------------------------
+%% MENUITEM OPTIONS
+%%
+%% Attribute:
+%% accelerator String
+%% activebg Color
+%% activefg Color
+%% bg Color
+%% color Color (same as fg)
+%% data Data
+%% fg Color
+%% font Font
+%% group Atom (valid only for radio type)
+%% index Int
+%% itemtype normal|check|radio|separator|cascade (|tearoff)
+%% label {text, String} | {image, BitmapFile}
+%% menu Menu (valid only for cascade type)
+%% selectbg Color
+%% underline Int
+%% value Atom
+%%
+%% Commands:
+%% activate
+%% enable Bool
+%% invoke
+%%
+%% Events:
+%% click [Bool | {Bool, Data}]
+%%
+%% Read Options:
+%% children
+%% id
+%% parent
+%% type
+%%
+%% Not Implemented:
+%% font Font
+%% read menu on cascades
+%%
+
+-export([create/3, config/3, read/3, delete/2, destroy/3, event/5,
+ option/5,read_option/5,mk_create_opts_for_child/4]).
+-include("gstk.hrl").
+
+%%-----------------------------------------------------------------------------
+%% MANDATORY INTERFACE FUNCTIONS
+%%-----------------------------------------------------------------------------
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Function : create/3
+%% Purpose : Create a widget of the type defined in this module.
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+create(DB, GstkId, Opts) ->
+ #gstkid{parent=Parent,owner=Owner,id=Id}=GstkId,
+ Pgstkid = gstk_db:lookup_gstkid(DB, Parent),
+ TkMenu = Pgstkid#gstkid.widget,
+ Widget = "",
+ {Index, Type, Options} = parse_opts(Opts, TkMenu),
+ PreCmd = [TkMenu, " insert ", gstk:to_ascii(Index)],
+ InsertArgs = [DB, Parent,Id, Index],
+ case Type of
+ check ->
+ {G, GID, NOpts} = fix_group(Options, DB, Owner),
+ TypeCmd = " ch",
+ Ngstkid=GstkId#gstkid{widget=Widget,widget_data={Type, G, GID}},
+ GenArgs = [NOpts,Ngstkid,TkMenu,"","",DB,{Type,Index}],
+ CallArgs = [PreCmd,TypeCmd],
+ mk_it(GenArgs,CallArgs,InsertArgs,Ngstkid);
+ radio ->
+ {G, GID, V, NOpts} = fix_group_and_value(Options, DB, Owner),
+ Ngstkid=GstkId#gstkid{widget=Widget, widget_data={Type,G,GID,V}},
+ TypeCmd = " ra",
+ GenArgs = [NOpts,Ngstkid,TkMenu,"", "",DB,{Type,Index}],
+ CallArgs = [PreCmd,TypeCmd],
+ mk_it(GenArgs,CallArgs,InsertArgs,Ngstkid);
+ _ ->
+ Ngstkid=GstkId#gstkid{widget=Widget, widget_data=Type},
+ TypeCmd = case Type of
+ normal -> " co";
+ separator -> " se";
+ cascade -> " ca"
+ end,
+ GenArgs = [Options,Ngstkid,TkMenu,"","",DB,{Type,Index}],
+ CallArgs = [PreCmd,TypeCmd],
+ mk_it(GenArgs,CallArgs,InsertArgs,Ngstkid)
+ end.
+
+mk_it(GenArgs,CallArgs,InsertArgs,Ngstkid) ->
+ case apply(gstk_generic,make_command,GenArgs) of
+ {error,Reason} -> {error,Reason};
+ Cmd when is_list(Cmd) ->
+ case apply(gstk,call,[[CallArgs|Cmd]]) of
+ {result,_} ->
+ apply(gstk_menu,insert_menuitem,InsertArgs),
+ Ngstkid;
+ Bad_Result -> {error,Bad_Result}
+ end
+ end.
+
+mk_create_opts_for_child(DB,Cgstkid, Pgstkid, Opts) ->
+ gstk_generic:mk_create_opts_for_child(DB,Cgstkid,Pgstkid,Opts).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Function : config/3
+%% Purpose : Configure a widget of the type defined in this module.
+%% Args : DB - The Database
+%% Gstkid - The gstkid of the widget
+%% Options - A list of options for configuring the widget
+%%
+%% Return : [true | {bad_result, Reason}]
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+% FIXME: Could we really trust Index? If we create a menu and put one
+% entry in the middle of the meny, don't the entrys after that one
+% renumber?
+
+config(DB, Gstkid, Options) ->
+ Parent = Gstkid#gstkid.parent,
+ Pgstkid = gstk_db:lookup_gstkid(DB, Parent),
+ TkMenu = Pgstkid#gstkid.widget,
+ case Gstkid#gstkid.widget_data of
+ {Type, _, _, _} ->
+ Owner = Gstkid#gstkid.owner,
+ {NOpts, NGstkid} = fix_group_and_value(Options, DB, Owner, Gstkid),
+ Index = gstk_menu:lookup_menuitem_pos(DB, Pgstkid, NGstkid#gstkid.id),
+ PreCmd = [TkMenu, " entryco ", gstk:to_ascii(Index)],
+ gstk_generic:mk_cmd_and_exec(NOpts,NGstkid,TkMenu,PreCmd,"",DB,
+ {Type,Index});
+ {Type, _, _} ->
+ Owner = Gstkid#gstkid.owner,
+ {NOpts, NGstkid} = fix_group(Options, DB, Owner, Gstkid),
+ Index = gstk_menu:lookup_menuitem_pos(DB, Pgstkid, NGstkid#gstkid.id),
+ PreCmd = [TkMenu, " entryco ", gstk:to_ascii(Index)],
+ gstk_generic:mk_cmd_and_exec(NOpts,NGstkid,TkMenu,PreCmd,"",DB,
+ {Type,Index});
+ Type ->
+ Index = gstk_menu:lookup_menuitem_pos(DB, Pgstkid, Gstkid#gstkid.id),
+ PreCmd = [TkMenu, " entryco ", gstk:to_ascii(Index)],
+ gstk_generic:mk_cmd_and_exec(Options,Gstkid,TkMenu,PreCmd,"",
+ DB, {Type,Index})
+ end.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Function : read/3
+%% Purpose : Read one option from a widget
+%% Args : DB - The Database
+%% Gstkid - The gstkid of the widget
+%% Opt - An option to read
+%%
+%% Return : [OptionValue | {bad_result, Reason}]
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+read(DB, Gstkid, Opt) ->
+ gstk_generic:read_option(DB, Gstkid, Opt).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Function : delete/2
+%% Purpose : Delete widget from databas and return tkwidget to destroy
+%% Args : DB - The Database
+%% Gstkid - The gstkid of the widget
+%%
+%% Return : TkWidget to destroy
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+delete(DB, Gstkid) ->
+ Parent = Gstkid#gstkid.parent,
+ Id = Gstkid#gstkid.id,
+ gstk_db:delete_widget(DB, Gstkid),
+ case Gstkid#gstkid.widget_data of
+ {radio, _, Gid, _} -> gstk_db:delete_bgrp(DB, Gid);
+ {check, _, Gid} -> gstk_db:delete_bgrp(DB, Gid);
+ _Other -> true
+ end,
+ {Parent, Id, gstk_menuitem, [Id, Parent]}.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Function : destroy/3
+%% Purpose : Destroy a widget
+%% Args : Menu - The menu tk widget
+%% Item - The index of the menuitem to destroy
+%% Return : [true | {bad_result, Reason}]
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+destroy(DB, Id, Parent) ->
+ Pgstkid = gstk_db:lookup_gstkid(DB, Parent),
+ PW = Pgstkid#gstkid.widget,
+ Idx = gstk_menu:lookup_menuitem_pos(DB, Pgstkid, Id),
+ gstk_menu:delete_menuitem(DB, Parent, Id),
+ gstk:exec([PW, " delete ", gstk:to_ascii(Idx)]).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Function : event/5
+%% Purpose : Construct the event and send it to the owner of the widget
+%% Args : Etype - The event type
+%% Edata - The event data
+%% Args - The data from tcl/tk
+%%
+%% Return : [true | {bad_result, Reason}]
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+event(DB, Gstkid, Etype, Edata, Args) ->
+ Arg2 =
+ case Gstkid#gstkid.widget_data of
+ {radio, G, _GID, V} ->
+ [_Grp, Text, Idx | Args1] = Args,
+ [Text, Idx, G, V | Args1];
+ {check, G, _Gid} ->
+ [Bool, Text, Idx | Args1] = Args,
+ RBool = case Bool of
+ 0 -> false;
+ 1 -> true
+ end,
+ [Text, Idx, G, RBool | Args1];
+ _Other2 ->
+ Args
+ end,
+ gstk_generic:event(DB, Gstkid, Etype, Edata, Arg2).
+
+
+
+%%-----------------------------------------------------------------------------
+%% MANDATORY FUNCTIONS
+%%-----------------------------------------------------------------------------
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Function : option/4
+%% Purpose : Take care of options
+%% Args : Option - An option tuple
+%% TkW - The tk-widget
+%% Return : A tuple {OptionType, OptionCmd}
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+option({click,true}, _Gstkid, _TkW, _DB, {separator,_Index}) ->
+ none; % workaround to be able to have {click,true} as default.
+option(_Option, _Gstkid, _TkW, _DB, {separator,_Index}) ->
+ invalid_option;
+
+option({menu,{Menu,_RestOfExternalId}}, _Gstkid, _TkW, DB, {cascade,_Index}) ->
+ Mgstkid = gstk_db:lookup_gstkid(DB, Menu),
+ MenuW = Mgstkid#gstkid.widget,
+ {s, [" -menu ", MenuW]};
+
+option({select,false}, _Gstkid, TkW, _DB, {check,Index}) ->
+ {c, ["set x [", TkW, " entrycg ", gstk:to_ascii(Index),
+ " -var];global $x;set $x 0"]};
+option({select,true}, _Gstkid, TkW, _DB, {check,Index}) ->
+ {c, ["set x [", TkW, " entrycg ", gstk:to_ascii(Index),
+ " -var];global $x;set $x 1"]};
+
+option({value,Val}, _Gstkid, _TkW, _DB, {radio,_Index}) ->
+ {s, [" -val ", gstk:to_ascii(Val)]};
+option({select,false}, _Gstkid, TkW, _DB, {radio,Index}) ->
+ {c, ["set x [", TkW, " entrycg ", gstk:to_ascii(Index),
+ " -var];global $x;set $x {}"]};
+option({select,true}, _Gstkid, TkW, _DB, {radio,Index}) ->
+ {c, ["set x [", TkW, " entrycg ", gstk:to_ascii(Index),
+ " -var]; set y [", TkW, " entrycg ", gstk:to_ascii(Index),
+ " -val]; global $x; set $x $y"]};
+
+option(Option, Gstkid, TkW, DB, {Kind,Index}) ->
+ case Option of
+ activate -> {c, [TkW, " act ", gstk:to_ascii(Index)]};
+ invoke -> {c, [TkW, " inv ", gstk:to_ascii(Index)]};
+ {accelerator, Acc} -> {s, [" -acc ", gstk:to_ascii(Acc)]};
+ {click, On} -> cbind(On, Gstkid, TkW, Index, Kind, DB);
+ {font, Font} when is_tuple(Font) ->
+ gstk_db:insert_opt(DB,Gstkid,Option),
+ {s, [" -font ", gstk_font:choose_ascii(DB,Font)]};
+ {label, {image,Img}} -> {s, [" -bitm @", Img, " -lab {}"]};
+ % FIXME: insert -command here.....
+ % FIXME: how to get value from image entry???
+ {label, {text,Text}} -> {s, [" -lab ",gstk:to_ascii(Text)," -bitm {}"]};
+ {underline, Int} -> {s, [" -underl ", gstk:to_ascii(Int)]};
+ {activebg, Color} -> {s, [" -activeba ", gstk:to_color(Color)]};
+ {activefg, Color} -> {s, [" -activefo ", gstk:to_color(Color)]};
+ {bg, Color} -> {s, [" -backg ", gstk:to_color(Color)]};
+ {enable, true} -> {s, " -st normal"};
+ {enable, false} -> {s, " -st disabled"};
+ {fg, Color} -> {s, [" -foreg ", gstk:to_color(Color)]};
+ _Other ->
+ case lists:member(Kind,[radio,check]) of
+ true ->
+ case Option of
+ {group,Group} -> {s, [" -var ", gstk:to_ascii(Group)]};
+ {selectbg,Col} -> {s,[" -selectc ",gstk:to_color(Col)]};
+ _ -> invalid_option
+ end;
+ _ -> invalid_option
+ end
+ end.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Function : read_option/5
+%% Purpose : Take care of a read option
+%% Return : The value of the option or invalid_option
+%% [OptionValue | {bad_result, Reason}]
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+read_option(Option,GstkId,_TkW,DB,_) ->
+ ItemId = GstkId#gstkid.id,
+ MenuId = GstkId#gstkid.parent,
+ MenuGstkid = gstk_db:lookup_gstkid(DB, MenuId),
+ MenuW = MenuGstkid#gstkid.widget,
+ Idx = gstk_menu:lookup_menuitem_pos(DB, MenuGstkid, ItemId),
+ PreCmd = [MenuW, " entrycg ", gstk:to_ascii(Idx)],
+ case Option of
+ accelerator -> tcl2erl:ret_str([PreCmd, " -acc"]);
+ activebg -> tcl2erl:ret_color([PreCmd, " -activeba"]);
+ activefg -> tcl2erl:ret_color([PreCmd, " -activefo"]);
+ bg -> tcl2erl:ret_color([PreCmd, " -backg"]);
+ fg -> tcl2erl:ret_color([PreCmd, " -foreg"]);
+ group -> read_group(GstkId, Option);
+ groupid -> read_groupid(GstkId, Option);
+ index -> Idx;
+ itemtype -> case GstkId#gstkid.widget_data of
+ {Type, _, _, _} -> Type;
+ {Type, _, _} -> Type;
+ Type -> Type
+ end;
+ enable -> tcl2erl:ret_enable([PreCmd, " -st"]);
+ font -> gstk_db:opt(DB,GstkId,font,undefined);
+ label -> tcl2erl:ret_label(["list [", PreCmd, " -lab] [",
+ PreCmd, " -bit]"]);
+ selectbg -> tcl2erl:ret_color([PreCmd, " -selectco"]);
+ underline -> tcl2erl:ret_int([PreCmd, " -underl"]);
+ value -> tcl2erl:ret_atom([PreCmd, " -val"]);
+ select -> read_select(MenuW, Idx, GstkId);
+ click -> gstk_db:is_inserted(DB, GstkId, click);
+ _ -> {bad_result, {GstkId#gstkid.objtype, invalid_option, Option}}
+ end.
+
+read_group(Gstkid, Option) ->
+ case Gstkid#gstkid.widget_data of
+ {_, G, _, _} -> G;
+ {_, G, _} -> G;
+ _Other -> {bad_result,{Gstkid#gstkid.objtype, invalid_option, Option}}
+ end.
+
+read_groupid(Gstkid, Option) ->
+ case Gstkid#gstkid.widget_data of
+ {_, _, Gid, _} -> Gid;
+ {_, _, Gid} -> Gid;
+ _Other -> {bad_result,{Gstkid#gstkid.objtype, invalid_option, Option}}
+ end.
+
+
+
+
+read_select(TkMenu, Idx, Gstkid) ->
+ case Gstkid#gstkid.widget_data of
+ {radio, _, _, _} ->
+ Cmd = ["list [set x [", TkMenu, " entrycg ", gstk:to_ascii(Idx),
+ " -var];global $x;set $x] [", TkMenu,
+ " entrycg ", gstk:to_ascii(Idx)," -val]"],
+ case tcl2erl:ret_tuple(Cmd) of
+ {X, X} -> true;
+ _Other -> false
+ end;
+ {check, _, _} ->
+ Cmd = ["set x [", TkMenu, " entrycg ", gstk:to_ascii(Idx),
+ " -var];global $x;set $x"],
+ tcl2erl:ret_bool(Cmd);
+ _Other ->
+ {error,{invalid_option,menuitem,select}}
+ end.
+
+
+
+%%-----------------------------------------------------------------------------
+%% PRIMITIVES
+%%-----------------------------------------------------------------------------
+
+%% create version
+fix_group_and_value(Opts, DB, Owner) ->
+ {G, GID, V, NOpts} = fgav(Opts, erlNIL, erlNIL, erlNIL, []),
+ RV = case V of
+ erlNIL ->
+ list_to_atom(lists:concat([v,gstk_db:counter(DB,value)]));
+ Other0 -> Other0
+ end,
+ NG = case G of
+ erlNIL -> mrb;
+ Other1 -> Other1
+ end,
+ RGID = case GID of
+ erlNIL -> {mrbgrp, NG, Owner};
+ Other2 -> Other2
+ end,
+ RG = gstk_db:insert_bgrp(DB, RGID),
+ {NG, RGID, RV, [{group, RG}, {value, RV} | NOpts]}.
+
+%% config version
+fix_group_and_value(Opts, DB, Owner, Gstkid) ->
+ {Type, RG, RGID, RV} = Gstkid#gstkid.widget_data,
+ {G, GID, V, NOpts} = fgav(Opts, RG, RGID, RV, []),
+ case {G, GID, V} of
+ {RG, RGID, RV} ->
+ {NOpts, Gstkid};
+ {NG, RGID, RV} ->
+ NGID = {rbgrp, NG, Owner},
+ gstk_db:delete_bgrp(DB, RGID),
+ NRG = gstk_db:insert_bgrp(DB, NGID),
+ NGstkid = Gstkid#gstkid{widget_data={Type,NG,NGID,RV}},
+ gstk_db:insert_widget(DB, NGstkid),
+ {[{group, NRG} | NOpts], NGstkid};
+ {RG, RGID, NRV} ->
+ NGstkid = Gstkid#gstkid{widget_data={Type,RG,RGID,NRV}},
+ gstk_db:insert_widget(DB, NGstkid),
+ {[{value,NRV} | NOpts], NGstkid};
+ {_, NGID, RV} when NGID =/= RGID ->
+ gstk_db:delete_bgrp(DB, RGID),
+ NRG = gstk_db:insert_bgrp(DB, NGID),
+ NGstkid = Gstkid#gstkid{widget_data={Type,RG,NGID,RV}},
+ gstk_db:insert_widget(DB, NGstkid),
+ {[{group, NRG} | NOpts], NGstkid};
+ {_, NGID, NRV} when NGID =/= RGID ->
+ gstk_db:delete_bgrp(DB, RGID),
+ NRG = gstk_db:insert_bgrp(DB, NGID),
+ NGstkid = Gstkid#gstkid{widget_data={Type,RG,NGID,NRV}},
+ gstk_db:insert_widget(DB, NGstkid),
+ {[{group, NRG}, {value,NRV} | NOpts], NGstkid};
+ {NG, RGID, NRV} ->
+ NGID = {rbgrp, NG, Owner},
+ gstk_db:delete_bgrp(DB, RGID),
+ NRG = gstk_db:insert_bgrp(DB, NGID),
+ NGstkid = Gstkid#gstkid{widget_data={Type,NG,NGID,NRV}},
+ gstk_db:insert_widget(DB, NGstkid),
+ {[{group, NRG}, {value,NRV} | NOpts], NGstkid}
+ end.
+
+
+
+fgav([{group, G} | Opts], _, GID, V, Nopts) ->
+ fgav(Opts, G, GID, V, Nopts);
+
+fgav([{groupid, GID} | Opts], G, _, V, Nopts) ->
+ fgav(Opts, G, GID, V, Nopts);
+
+fgav([{value, V} | Opts], G, GID, _, Nopts) ->
+ fgav(Opts, G, GID, V, Nopts);
+
+fgav([Opt | Opts], G, GID, V, Nopts) ->
+ fgav(Opts, G, GID, V, [Opt | Nopts]);
+
+fgav([], Group, GID, Value, Opts) ->
+ {Group, GID, Value, Opts}.
+
+
+%% check button version
+%% create version
+fix_group(Opts, DB, Owner) ->
+ {G, GID, NOpts} = fg(Opts, erlNIL, erlNIL, []),
+ NG = case G of
+ erlNIL ->
+ Vref = gstk_db:counter(DB, variable),
+ list_to_atom(lists:flatten(["mcb", gstk:to_ascii(Vref)]));
+ Other1 -> Other1
+ end,
+ RGID = case GID of
+ erlNIL -> {mcbgrp, NG, Owner};
+ Other2 -> Other2
+ end,
+ RG = gstk_db:insert_bgrp(DB, RGID),
+ {NG, RGID, [{group, RG} | NOpts]}.
+
+%% config version
+fix_group(Opts, DB, Owner, Gstkid) ->
+ {Type, RG, RGID} = Gstkid#gstkid.widget_data,
+ {G, GID, NOpts} = fg(Opts, RG, RGID, []),
+ case {G, GID} of
+ {RG, RGID} ->
+ {NOpts, Gstkid};
+ {NG, RGID} ->
+ NGID = {cbgrp, NG, Owner},
+ gstk_db:delete_bgrp(DB, RGID),
+ NRG = gstk_db:insert_bgrp(DB, NGID),
+ NGstkid = Gstkid#gstkid{widget_data={Type,NG,NGID}},
+ gstk_db:insert_widget(DB, NGstkid),
+ {[{group, NRG} | NOpts], NGstkid};
+ {_, NGID} when NGID =/= RGID ->
+ gstk_db:delete_bgrp(DB, RGID),
+ NRG = gstk_db:insert_bgrp(DB, NGID),
+ NGstkid = Gstkid#gstkid{widget_data={Type,RG,NGID}},
+ gstk_db:insert_widget(DB, NGstkid),
+ {[{group, NRG} | NOpts], NGstkid}
+ end.
+
+
+
+fg([{group, G} | Opts], _, GID, Nopts) ->
+ fg(Opts, G, GID, Nopts);
+
+fg([{groupid, GID} | Opts], G, _, Nopts) ->
+ fg(Opts, G, GID, Nopts);
+
+fg([Opt | Opts], G, GID, Nopts) ->
+ fg(Opts, G, GID, [Opt | Nopts]);
+
+fg([], Group, GID, Opts) ->
+ {Group, GID, Opts}.
+
+
+
+parse_opts(Opts, TkMenu) ->
+ parse_opts(Opts, TkMenu, none, none, []).
+
+
+parse_opts([Option | Rest], TkMenu, Idx, Type, Options) ->
+ case Option of
+ {index, I} -> parse_opts(Rest, TkMenu, I, Type, Options);
+ {itemtype, T} -> parse_opts(Rest, TkMenu, Idx, T, Options);
+ _Other -> parse_opts(Rest, TkMenu, Idx, Type,[Option | Options])
+ end;
+parse_opts([], TkMenu, Index, Type, Options) ->
+ RealIdx =
+ case Index of
+ Idx when is_integer(Idx) -> Idx;
+ last -> find_last_index(TkMenu);
+ Other -> gs:error("Invalid index ~p~n",[Other])
+ end,
+ {RealIdx, Type, Options}.
+
+find_last_index(TkMenu) ->
+ case tcl2erl:ret_int([TkMenu, " index last"]) of
+ Last when is_integer(Last) -> Last+1;
+ none -> 0;
+ Other -> gs:error("Couldn't find index ~p~n",[Other])
+ end.
+
+cbind({true, Edata}, Gstkid, TkMenu, Index, Type, DB) ->
+ Eref = gstk_db:insert_event(DB, Gstkid, click, Edata),
+ IdxStr = gstk:to_ascii(Index),
+ case Type of
+ normal ->
+ Cmd = [" -command {erlsend ", Eref,
+ " \\\"[",TkMenu," entrycg ",IdxStr," -label]\\\" ",
+ IdxStr,"}"],
+ {s, Cmd};
+ check ->
+ Cmd = [" -command {erlsend ", Eref,
+ " \[expr \$[", TkMenu, " entrycg ",IdxStr," -var]\] \\\"[",
+ TkMenu, " entrycg ",IdxStr," -label]\\\" ",IdxStr,"}"],
+ {s, Cmd};
+ radio ->
+ Cmd = [" -command {erlsend ", Eref,
+ " [", TkMenu, " entrycg ",IdxStr," -var] \\\"[",
+ TkMenu, " entrycg ",IdxStr," -label]\\\" ",IdxStr,"}"],
+ {s, Cmd};
+ _Other ->
+ none
+ end;
+
+cbind({false, _}, Gstkid, _TkMenu, _Index, _Type, DB) ->
+ gstk_db:delete_event(DB, Gstkid, click),
+ none;
+
+cbind(On, Gstkid, TkMenu, Index, Type, DB) when is_atom(On) ->
+ cbind({On, []}, Gstkid, TkMenu, Index, Type, DB).
+
+
+%%% ----- Done -----
+