The R13B03 release.OTP_R13B03

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 -----
+