path: root/lib/gs/src/gstk_generic.erl

%%
%% %CopyrightBegin%
%% 
%% Copyright Ericsson AB 1996-2012. All Rights Reserved.
%% 
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
%% You may obtain a copy of the License at
%%
%%     http://www.apache.org/licenses/LICENSE-2.0
%%
%% Unless required by applicable law or agreed to in writing, software
%% distributed under the License is distributed on an "AS IS" BASIS,
%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
%% See the License for the specific language governing permissions and
%% limitations under the License.
%% 
%% %CopyrightEnd%
%%

%%

-module(gstk_generic).
-compile([{nowarn_deprecated_function,{gs,assq,2}}]).

-export([out_opts/8,
	 read_option/5,
	 mk_tkw_child/2,
	 merge_default_options/3,
	 merge_default_options/2,
	 opts_for_child/3,
	 mk_cmd_and_exec/4,
	 mk_cmd_and_exec/5,
	 mk_cmd_and_exec/6,
	 mk_cmd_and_exec/7,
	 make_command/5,
	 make_command/6,
	 make_command/7,
	 read_option/4,
	 handle_external_opt_call/9,
	 handle_external_read/1,
	 gen_anchor/9,
	 gen_anchor/5,
	 gen_height/9,
	 gen_height/5,
	 gen_width/9,
	 gen_width/5,
	 gen_x/9,
	 gen_x/5,
	 gen_y/9,
	 gen_y/5,
	 gen_raise/9,
	 gen_raise/5,
	 gen_lower/9,
	 gen_lower/5,
	 gen_enable/9,
	 gen_enable/5,
	 gen_align/9,
	 gen_align/5,
	 gen_justify/9,
	 gen_justify/5,
	 gen_padx/9,
	 gen_padx/5,
	 gen_pady/9,
	 gen_pady/5,
	 gen_font/9,
	 gen_font/5,
	 gen_label/9,
	 gen_label/5,
	 gen_activebg/9,
	 gen_activebg/5,
	 gen_activefg/9,
	 gen_activefg/5,
	 gen_default/9,
	 gen_relief/9,
	 gen_relief/5,
	 gen_bw/9,
	 gen_bw/5,
	 gen_font_wh/5,
	 gen_choose_font/5,
	 gen_data/9,
	 gen_data/5,
	 gen_pack_x/9,
	 gen_pack_x/5,
	 gen_pack_y/9,
	 gen_pack_y/5,
	 gen_pack_xy/9,
	 gen_flush/9,
	 gen_flush/5,
	 gen_keep_opt/9,
	 gen_children/5,
	 make_extern_id/2,
	 gen_id/5,
	 gen_parent/5,
	 gen_type/5,
	 gen_beep/9,
	 gen_setfocus/9,
	 gen_setfocus/5,
	 gen_buttonpress/9,
	 gen_buttonpress/5,
	 gen_buttonrelease/9,
	 gen_buttonrelease/5,
	 gen_configure/9,
	 gen_configure/5,
	 gen_destroy/9,
	 gen_destroy/5,
	 gen_enter/9,
	 gen_enter/5,
	 gen_focus_ev/9,
	 gen_focus_ev/5,
	 gen_keypress/9,
	 gen_keypress/5,
	 gen_keyrelease/9,
	 gen_keyrelease/5,
	 gen_leave/9,
	 gen_leave/5,
	 gen_motion/9,
	 gen_motion/5,
	 gen_highlightbw/9,
	 gen_highlightbw/5,
	 gen_highlightbg/9,
	 gen_highlightbg/5,
	 gen_highlightfg/9,
	 gen_highlightfg/5,
	 gen_selectbw/9,
	 gen_selectbw/5,
	 gen_selectfg/9,
	 gen_selectfg/5,
	 gen_selectbg/9,
	 gen_selectbg/5,
	 gen_fg/9,
	 gen_fg/5,
	 gen_bg/9,
	 gen_bg/5,
	 gen_so_activebg/9,
	 gen_so_activebg/5,
	 gen_so_bc/9,
	 gen_so_bc/5,
	 gen_so_scrollfg/9,
	 gen_so_scrollfg/5,
	 gen_so_scrollbg/9,
	 gen_so_scrollbg/5,
	 obj/1,
	 gen_so_bg/9,
	 gen_so_bg/5,
	 gen_so_selectbw/9,
	 gen_so_selectbw/5,
	 gen_so_selectfg/9,
	 gen_so_selectfg/5,
	 gen_so_selectbg/9,
	 gen_so_selectbg/5,
	 gen_so_scrolls/9,
	 gen_so_hscroll/5,
	 gen_so_vscroll/5,
	 cursors/0,
	 gen_cursor/9,
	 gen_cursor/5,
	 gen_citem_coords/9,
	 gen_citem_coords/5,
	 gen_citem_fill/9,
	 gen_citem_fill/5,
	 gen_citem_lower/9,
	 gen_citem_raise/9,
	 gen_citem_move/9,
	 move_coords/3,
	 add_to_coords/3,
	 gen_citem_setfocus/9,
	 gen_citem_setfocus/5,
	 gen_citem_buttonpress/9,
	 gen_citem_buttonrelease/9,
	 gen_citem_enter/9,
	 gen_citem_keypress/9,
	 gen_citem_keyrelease/9,
	 gen_citem_leave/9,
	 gen_citem_motion/9,
	 scrolls_vh/3,
	 parse_scrolls/1,
	 parse_scrolls/2,
	 parse_scrolls/4,
	 bind/5,
	 bind/6,
	 ebind/6,
	 eunbind/6,
	 item_bind/6,
	 item_ebind/6,
	 item_eunbind/5,
	 event/5,
	 read_option/3,
	 make_command/4,
	 mk_create_opts_for_child/4]).

-include("gstk.hrl").
-include("gstk_generic.hrl").

%%----------------------------------------------------------------------
%% Returns: a new unique TkWidget (string())
%%----------------------------------------------------------------------
mk_tkw_child(DB,#gstkid{parent=P,objtype=Ot}) ->
    Pgstkid = gstk_db:lookup_gstkid(DB, P),
    PW = Pgstkid#gstkid.widget,
    Oref = gstk_db:counter(DB, Ot),
    PF = gstk_widgets:suffix(Ot),
    _TkW = lists:concat([PW, PF, Oref]).

%%----------------------------------------------------------------------
%% Purpose: Merges options. Opts have higher priority than BuiltIn
%%          (and ParentOpts have higher than BuiltIn)
%% Returns: A list of new options.
%%----------------------------------------------------------------------
merge_default_options(ParOpts, BuildInOpts, Opts) ->
    %% parents options first
    Tmp=merge_default_options(ParOpts, lists:sort(Opts)), 
    merge_default_options(BuildInOpts,Tmp).

merge_default_options([Def|Ds],[Opt|Os]) 
  when element(1,Def) < element(1,Opt) ->
    [Def | merge_default_options(Ds,[Opt|Os])];

merge_default_options([Def|Ds],[Opt|Os]) 
  when element(1,Def) > element(1,Opt) ->
    [Opt | merge_default_options([Def|Ds],Os)];

merge_default_options([Def|Ds],[Opt|Os]) 
  when element(1,Def) == element(1,Opt) ->
    [Opt | merge_default_options(Ds,Os)];

merge_default_options(Defs,[Opt|Os]) ->
    [Opt | merge_default_options(Defs,Os)];

merge_default_options([],Opts) -> Opts;
merge_default_options(Defs,[]) -> Defs.

opts_for_child(DB,Childtype,ParId) ->
    case gs_widgets:container(Childtype) of
	true -> 
	    gstk_db:default_container_opts(DB,ParId,Childtype);
	false ->
	    gstk_db:default_opts(DB,ParId,Childtype)
    end.

mk_create_opts_for_child(DB,#gstkid{objtype=ChildType}, Pgstkid, Opts) ->
    merge_default_options(
      opts_for_child(DB,ChildType,Pgstkid#gstkid.id),
      gs_widgets:default_options(ChildType),
      Opts).

mk_cmd_and_exec(Opts,Gstkid,Scmd,DB) ->
    TkW = Gstkid#gstkid.widget,
    mk_cmd_and_exec(Opts,Gstkid,TkW,Scmd,[";place ", TkW],DB,dummy).
mk_cmd_and_exec(Opts,Gstkid,Scmd,Pcmd,DB) ->
    mk_cmd_and_exec(Opts,Gstkid,Gstkid#gstkid.widget,Scmd,Pcmd,DB,dummy).
mk_cmd_and_exec(Options, Gstkid, TkW, SCmd, PCmd, DB) ->
    mk_cmd_and_exec(Options, Gstkid, TkW, SCmd, PCmd, DB,dummy).
mk_cmd_and_exec(Options, Gstkid, TkW, SCmd, PCmd, DB,ExtraArg) ->
    case gstk_generic:make_command(Options,Gstkid,TkW,SCmd,PCmd,DB,ExtraArg) of
	{error,Reason} -> {error,Reason};
	Cmd when is_list(Cmd) ->
	    gstk:exec(Cmd)
    end.

%%----------------------------------------------------------------------
%% SCmd: SimplePreCommand - prepended to simple (s) options
%% PCmd: PlacePreCommand - prepended to placer (p) options
%%       (should start with ';' (at least if preceeded with simple cmds))
%% Comment: If some function changes the gstkid,
%%          it's responsible for storing it in the DB.
%%----------------------------------------------------------------------
make_command(Opts,Gstkid,Scmd,DB) ->
    TkW = Gstkid#gstkid.widget,
    make_command(Opts,Gstkid,TkW,Scmd,[";place ", TkW],DB,dummy).
make_command(Opts,Gstkid,Scmd,Pcmd,DB) ->
    make_command(Opts,Gstkid,Gstkid#gstkid.widget,Scmd,Pcmd,DB,dummy).
make_command(Options, Gstkid, TkW, SCmd, PCmd, DB) ->
    make_command(Options, Gstkid, TkW, SCmd, PCmd, DB,dummy).
make_command(Options, Gstkid, TkW, SCmd, PCmd, DB,ExtraArg) ->
    case out_opts(Options, Gstkid, TkW, DB, ExtraArg, [], [], []) of
	{[], [], []} -> [];
	{Si, [], []} -> [SCmd, Si,$;];
	{[], Pl, []} -> [PCmd, Pl,$;];
	{[], [], Co} -> [$;,Co];
	{[], Pl, Co} -> [PCmd, Pl, $;, Co];
	{Si, [], Co} -> [SCmd, Si, $;, Co];
	{Si, Pl, []} -> [SCmd, Si, PCmd, Pl, $;];
	{Si, Pl, Co} -> [SCmd, Si, PCmd, Pl, $;, Co];
	{error,Reason} -> {error,Reason}
    end.

read_option(DB,Gstkid,Opt) ->
    read_option(DB,Gstkid,Gstkid#gstkid.widget,Opt,dummy).
read_option(DB,Gstkid,Opt,ExtraArg) ->
    read_option(DB,Gstkid,Gstkid#gstkid.widget,Opt,ExtraArg).

%%----------------------------------------------------------------------
%% Args: Args is [Gstkid, TkW, DB, ExtraArg]
%% Comment: An optimization:don't reconstruct the arg list for apply each time.
%%          This is the option-engine so we should optimize.
%%----------------------------------------------------------------------
handle_external_opt_call([Opt|Options],Gstkid,TkW,DB,ExtraArg,ExtRes,S,P,C) ->
    case ExtRes of
	{s, Cmd} ->
	    out_opts(Options,Gstkid, TkW,DB, ExtraArg, [Cmd|S], P, C);
	{p, Cmd} ->
	    out_opts(Options, Gstkid,TkW,DB, ExtraArg, S, [Cmd|P], C);
	{c, Cmd} ->
	    out_opts(Options, Gstkid,TkW,DB, ExtraArg,S, P, [Cmd,$;|C]);
	none ->
	    out_opts(Options, Gstkid,TkW,DB,ExtraArg, S, P, C);
						%	{s, NGstkid, Cmd} ->
						%	    out_opts(Options,NGstkid,TkW,DB,ExtraArg, [Cmd|S], P, C);
						%	{p, NGstkid, Cmd} ->
						%	    out_opts(Options,NGstkid,TkW,DB,ExtraArg, S, [Cmd|P], C);
	{c, NGstkid, Cmd} ->
	    out_opts(Options,NGstkid,TkW,DB, ExtraArg,S,P,[Cmd,$;|C]);
	{none, NGstkid} ->
	    out_opts(Options,NGstkid,TkW,DB, ExtraArg, S, P, C);
	{sp,{Scmd,Pcmd}} ->
	    out_opts(Options,Gstkid,TkW,DB,ExtraArg,[Scmd|S],[Pcmd|P],C);
	invalid_option ->
	    {error,{invalid_option,Gstkid#gstkid.objtype,Opt}};
	break -> % a hack. it is possible to abort generic option handling at
	    %% any time (without even inserting the gstkid inte to DB (for
	    %% performance reasons)).
	    {S, P, C}
    end.

handle_external_read(Res) ->
    %% We have removed dead code here that attempted to translate
    %% a bad return value from {bad_result,{A,B,C}} to {error,{A,B,C}}.
    %% Since the gs application is deprecated, we don't want to introduce
    %% a potential incompatibility; thus we have removed the dead code
    %% instead of correcting it.
    Res.

%%----------------------------------------------------------------------
%% Generic options
%%----------------------------------------------------------------------

gen_anchor(How,Opts,Gstkid,TkW,DB,ExtraArg,S,P,C) ->
    out_opts(Opts,Gstkid,TkW,DB,ExtraArg,S,[" -anc ", gstk:to_ascii(How)|P],C).
gen_anchor(_Opt,_Gstkid,TkW,_DB,_ExtraArg) ->
    tcl2erl:ret_place(anchor, TkW).

gen_height(Height,Opts,Gstkid,TkW,DB,ExtraArg,S,P,C) ->
    gstk_db:insert_opt(DB,Gstkid,{height,Height}),
    out_opts(Opts,Gstkid,TkW,DB,ExtraArg,S,
	     [" -he ", gstk:to_ascii(Height)|P],C).
gen_height(_Opt,Gstkid,_TkW,DB,_ExtraArg) ->
    gstk_db:opt(DB,Gstkid,height).

gen_width(Width,Opts,Gstkid,TkW,DB,ExtraArg,S,P,C) ->
    gstk_db:insert_opt(DB,Gstkid,{width,Width}),
    out_opts(Opts,Gstkid,TkW,DB,ExtraArg,S,
	     [" -wi ", gstk:to_ascii(Width)|P],C).
gen_width(_Opt,Gstkid,_TkW,DB,_ExtraArg) ->
    gstk_db:opt(DB,Gstkid,width).

gen_x(X,Opts,Gstkid,TkW,DB,ExtraArg,S,P,C) ->
    gstk_db:insert_opt(DB,Gstkid,{x,X}),
    out_opts(Opts,Gstkid,TkW,DB,ExtraArg,S,
	     [" -x ", gstk:to_ascii(X)|P],C).
gen_x(_Opt,Gstkid,_TkW,DB,_ExtraArg) ->
    gstk_db:opt(DB,Gstkid,x).

gen_y(Y,Opts,Gstkid,TkW,DB,ExtraArg,S,P,C) ->
    gstk_db:insert_opt(DB,Gstkid,{y,Y}),
    out_opts(Opts,Gstkid,TkW,DB,ExtraArg,S,
	     [" -y ", gstk:to_ascii(Y)|P],C).
gen_y(_Opt,Gstkid,_TkW,DB,_ExtraArg) ->
    gstk_db:opt(DB,Gstkid,y).

gen_raise(_,Opts,Gstkid,TkW,DB,ExtraArg,S,P,C) ->
    out_opts(Opts,Gstkid,TkW,DB,ExtraArg,S,P,["raise ", TkW,$;|C]).
gen_raise(_Opt,_Gstkid,_TkW,_DB,_ExtraArg) ->
    undefined.

gen_lower(_,Opts,Gstkid,TkW,DB,ExtraArg,S,P,C) ->
    out_opts(Opts,Gstkid,TkW,DB,ExtraArg,S,P,["lower ", TkW,$;|C]).
gen_lower(_Opt,_Gstkid,_TkW,_DB,_ExtraArg) ->
    undefined.

gen_enable(true,Opts,Gstkid,TkW,DB,ExtraArg,S,P,C) ->
    out_opts(Opts,Gstkid,TkW,DB,ExtraArg,[" -st normal"|S],P,C);
gen_enable(false,Opts,Gstkid,TkW,DB,ExtraArg,S,P,C) ->
    out_opts(Opts,Gstkid,TkW,DB,ExtraArg,[" -st disabled"|S],P,C).
gen_enable(_Opt,_Gstkid,TkW,_DB,_ExtraArg) ->
    tcl2erl:ret_enable([TkW, " cg -st"]).

gen_align(How,Opts,Gstkid,TkW,DB,ExtraArg,S,P,C) ->
    out_opts(Opts,Gstkid,TkW,DB,ExtraArg,[" -an ", gstk:to_ascii(How)|S],P,C).
gen_align(_Opt,_Gstkid,TkW,_DB,_ExtraArg) ->
    tcl2erl:ret_atom([TkW, " cg -anch"]).

gen_justify(How,Opts,Gstkid,TkW,DB,ExtraArg,S,P,C) ->
    out_opts(Opts,Gstkid,TkW,DB,ExtraArg,[" -ju ", gstk:to_ascii(How)|S],P,C).
gen_justify(_Opt,_Gstkid,TkW,_DB,_ExtraArg) ->
    tcl2erl:ret_atom([TkW, " cg -ju"]).

gen_padx(Pad,Opts,Gstkid,TkW,DB,ExtraArg,S,P,C) ->
    out_opts(Opts,Gstkid,TkW,DB,ExtraArg,[" -padx ", gstk:to_ascii(Pad)|S],P,C).
gen_padx(_Opt,_Gstkid,TkW,_DB,_ExtraArg) ->
    tcl2erl:ret_atom([TkW, " cg -padx"]).

gen_pady(Pad,Opts,Gstkid,TkW,DB,ExtraArg,S,P,C) ->
    out_opts(Opts,Gstkid,TkW,DB,ExtraArg,[" -pady ", gstk:to_ascii(Pad)|S],P,C).
gen_pady(_Opt,_Gstkid,TkW,_DB,_ExtraArg) ->
    tcl2erl:ret_atom([TkW, " cg -pady"]).


gen_font(Font,Opts,Gstkid,TkW,DB,ExtraArg,S,P,C) ->
    gstk_db:insert_opt(DB,Gstkid,{font,Font}),
    out_opts(Opts,Gstkid,TkW,DB,ExtraArg,
	     [" -font ", gstk_font:choose_ascii(DB,Font)|S],P,C).
gen_font(_Opt,Gstkid,_TkW,DB,_ExtraArg) ->
    gstk_db:opt(DB,Gstkid,font,undefined).

gen_label({text,Text},Opts,Gstkid,TkW,DB,ExtraArg,S,P,C) ->
    out_opts(Opts,Gstkid,TkW,DB,ExtraArg,[" -text ", gstk:to_ascii(Text), " -bi {}"|S],P,C);
gen_label({image,Img},Opts,Gstkid,TkW,DB,ExtraArg,S,P,C) ->
    I2 = re:replace(Img, [92,92], "/", [global,{return,list}]),
    out_opts(Opts,Gstkid,TkW,DB,ExtraArg,[" -bi \"@", I2, "\" -text {}"|S],P,C).
gen_label(_Opt,_Gstkid,TkW,_DB,_ExtraArg) ->
    case gstk:call([TkW, " cg -bit"]) of
	{result, [$@|Image]} -> {image,Image};
	_Nope ->
	    case gstk:call([TkW, " cg -text"]) of
		{result, Txt} -> {text, Txt};
		Bad_Result -> Bad_Result
	    end
    end.

gen_activebg(Color,Opts,Gstkid,TkW,DB,ExtraArg,S,P,C) ->
    out_opts(Opts,Gstkid,TkW,DB,ExtraArg,[" -activeba ", gstk:to_color(Color)|S],P,C).
gen_activebg(_Opt,_Gstkid,TkW,_DB,_ExtraArg) ->
    tcl2erl:ret_color([TkW, " cg -activeba"]).

gen_activefg(Color,Opts,Gstkid,TkW,DB,ExtraArg,S,P,C) ->
    out_opts(Opts,Gstkid,TkW,DB,ExtraArg,[" -activef ", gstk:to_color(Color)|S],P,C).
gen_activefg(_Opt,_Gstkid,TkW,_DB,_ExtraArg) ->
    tcl2erl:ret_color([TkW, " cg -activef"]).


gen_default(Opt,Opts,Gstkid,TkW,DB,ExtraArg,S,P,C) ->
    case Opt of
	{all, {font, Font}} ->
	    C2 = ["option a *",tl(TkW), % have to remove preceeding dot
		  "*font ",gstk_font:choose_ascii(DB, Font)],
	    gstk_db:insert_def(Gstkid,grid,{font,Font}),
	    gstk_db:insert_def(Gstkid,text,{font,Font}),
	    out_opts(Opts,Gstkid,TkW,DB,ExtraArg,S,P,[C2,$;|C]);
	{buttons, {font, Font}} ->
	    C2 = ["option a *",tl(TkW), % have to remove preceeding dot
		  ".Button.font ",gstk_font:choose_ascii(DB, Font)],
	    out_opts(Opts,Gstkid,TkW,DB,ExtraArg,S,P,[C2,$;|C]);
	{buttons,{Key,Val}} ->
	    gstk_db:insert_def(Gstkid,button,{Key,Val}),
	    gstk_db:insert_def(Gstkid,checkbutton,{Key,Val}),
	    gstk_db:insert_def(Gstkid,radiobutton,{Key,Val}),
	    out_opts(Opts,Gstkid,TkW,DB,ExtraArg,S,P,C);
	{ObjType, {Key,Val}} ->
	    gstk_db:insert_def(Gstkid,ObjType,{Key,Val}),
	    out_opts(Opts,Gstkid,TkW,DB,ExtraArg,S,P,C)
    end.


gen_relief(Relief,Opts,Gstkid,TkW,DB,ExtraArg,S,P,C) ->
    out_opts(Opts,Gstkid,TkW,DB,ExtraArg,[" -reli ",gstk:to_ascii(Relief)|S],P,C).
gen_relief(_Opt,_Gstkid,TkW,_DB,_ExtraArg) ->
    tcl2erl:ret_atom([TkW, " cg -reli"]).

gen_bw(Wth,Opts,Gstkid,TkW,DB,ExtraArg,S,P,C) ->
    out_opts(Opts,Gstkid,TkW,DB,ExtraArg,[" -bd ", gstk:to_ascii(Wth)|S],P,C).
gen_bw(_Opt,_Gstkid,TkW,_DB,_ExtraArg) ->
    tcl2erl:ret_int([TkW, " cg -bd"]).



gen_font_wh({font_wh,{Font, Txt}},_Gstkid,_TkW,DB,_) ->
    gstk_font:width_height(DB, gstk_font:choose(DB,Font), Txt).

gen_choose_font({choose_font,Font},_Gstkid,_TkW,DB,_ExtraArg) ->
    gstk_font:choose(DB,Font).

gen_data(Data,Opts,Gstkid,TkW,DB,ExtraArg,S,P,C) ->
    gstk_db:insert_opt(DB,Gstkid,{data,Data}),
    out_opts(Opts,Gstkid,TkW,DB,ExtraArg,S,P,C).
gen_data(_Opt,Gstkid,_TkW,DB,_ExtraArg) ->
    gstk_db:opt(DB,Gstkid,data).

gen_pack_x({Start,Stop},Opts,Gstkid,TkW,DB,ExtraArg,S,P,C) ->
    gstk_db:insert_opt(DB,Gstkid,{pack_x,{Start,Stop}}),
    out_opts(Opts,Gstkid,TkW,DB,ExtraArg,S,P,C);
gen_pack_x(Col,Opts,Gstkid,TkW,DB,ExtraArg,S,P,C) when is_integer(Col) ->
    gstk_db:insert_opt(DB,Gstkid,{pack_x,{Col,Col}}),
    out_opts(Opts,Gstkid,TkW,DB,ExtraArg,S,P,C).
gen_pack_x(_Opt,Gstkid,_TkW,DB,_ExtraArg) ->
    gstk_db:opt(DB,Gstkid,pack_x, undefined).

gen_pack_y({Start,Stop},Opts,Gstkid,TkW,DB,ExtraArg,S,P,C) ->
    gstk_db:insert_opt(DB,Gstkid,{pack_y,{Start,Stop}}),
    out_opts(Opts,Gstkid,TkW,DB,ExtraArg,S,P,C);
gen_pack_y(Row,Opts,Gstkid,TkW,DB,ExtraArg,S,P,C) when is_integer(Row) ->
    gstk_db:insert_opt(DB,Gstkid,{pack_y,{Row,Row}}),
    out_opts(Opts,Gstkid,TkW,DB,ExtraArg,S,P,C).
gen_pack_y(_Opt,Gstkid,_TkW,DB,_ExtraArg) ->
    gstk_db:opt(DB,Gstkid,pack_y, undefined).

gen_pack_xy({Col,Row},Opts,Gstkid,TkW,DB,ExtraArg,S,P,C)
  when is_integer(Col), is_integer(Row) ->
    gstk_db:insert_opt(DB,Gstkid,{pack_x,{Col,Col}}),
    gstk_db:insert_opt(DB,Gstkid,{pack_y,{Row,Row}}),
    out_opts(Opts,Gstkid,TkW,DB,ExtraArg,S,P,C);
gen_pack_xy({Col,{StartRow,StopRow}},Opts,Gstkid,TkW,DB,ExtraArg,S,P,C)
  when is_integer(Col) ->
    gstk_db:insert_opt(DB,Gstkid,{pack_x,{Col,Col}}),
    gstk_db:insert_opt(DB,Gstkid,{pack_y,{StartRow,StopRow}}),
    out_opts(Opts,Gstkid,TkW,DB,ExtraArg,S,P,C);
gen_pack_xy({{StartCol,StopCol},Row},Opts,Gstkid,TkW,DB,ExtraArg,S,P,C)
  when is_integer(Row) ->
    gstk_db:insert_opt(DB,Gstkid,{pack_x,{StartCol,StopCol}}),
    gstk_db:insert_opt(DB,Gstkid,{pack_y,{Row,Row}}),
    out_opts(Opts,Gstkid,TkW,DB,ExtraArg,S,P,C);
gen_pack_xy({Col,Row},Opts,Gstkid,TkW,DB,ExtraArg,S,P,C) ->
    gstk_db:insert_opt(DB,Gstkid,{pack_x,Col}),
    gstk_db:insert_opt(DB,Gstkid,{pack_y,Row}),
    out_opts(Opts,Gstkid,TkW,DB,ExtraArg,S,P,C).


gen_flush(_Opt,Opts,Gstkid,TkW,DB,ExtraArg,S,P,C)  -> 
    tcl2erl:ret_int(["update idletasks;expr 1+1"]),
    out_opts(Opts,Gstkid,TkW,DB,ExtraArg,S,P,C).
gen_flush(_Opt,_Gstkid,_TkW,_DB,_ExtraArg) ->
    tcl2erl:ret_int(["update idletasks;expr 1+1"]).

						% a hidden impl option.
gen_keep_opt(Opt,Opts,Gstkid,TkW,DB,ExtraArg,S,P,C)  -> 
    gstk_db:insert_opt(DB,Gstkid,Opt),
    out_opts(Opts,Gstkid,TkW,DB,ExtraArg,S,P,C).

gen_children(_Opt,Gstkid,_TkW,DB,_ExtraArg) ->
    make_extern_id(gstk_db:lookup_kids(DB, Gstkid#gstkid.id), DB).

make_extern_id([Id|Ids], DB) ->
    [gstk:make_extern_id(Id, DB) | make_extern_id(Ids, DB)];
make_extern_id([], _) -> [].

gen_id(_Opt,#gstkid{id=Id},_TkW,DB,_ExtraArg) ->
    gstk:make_extern_id(Id, DB).

gen_parent(_Opt,Gstkid,_TkW,DB,_ExtraArg) ->
    gstk:make_extern_id(Gstkid#gstkid.parent, DB).

gen_type(_Opt,Gstkid,_TkW,_DB,_ExtraArg) ->
    Gstkid#gstkid.objtype.

gen_beep(_,Opts,Gstkid,TkW,DB,ExtraArg,S,P,C) ->
    out_opts(Opts,Gstkid,TkW,DB,ExtraArg,S,P,["bell;",$;|C]).

gen_setfocus(true,Opts,Gstkid,TkW,DB,ExtraArg,S,P,C) ->
    out_opts(Opts,Gstkid,TkW,DB,ExtraArg,S,P,["focus ", TkW,$;|C]);
gen_setfocus(false,Opts,Gstkid,TkW,DB,ExtraArg,S,P,C) ->
    out_opts(Opts,Gstkid,TkW,DB,ExtraArg,S,P,["focus .",$;|C]).

gen_setfocus(_Opt,_Gstkid,TkW,_DB,_ExtraArg) ->
    tcl2erl:ret_focus(TkW, "focus").

gen_buttonpress(On,Opts,Gstkid,TkW,DB,ExtraArg,S,P,C) ->
    Cmd = bind(DB, Gstkid, TkW, buttonpress, On),
    out_opts(Opts,Gstkid,TkW,DB,ExtraArg,S,P,[Cmd,$;|C]).
gen_buttonpress(_Opt,Gstkid,_TkW,DB,_ExtraArg) ->
    gstk_db:is_inserted(DB, Gstkid, buttonpress).

gen_buttonrelease(On,Opts,Gstkid,TkW,DB,ExtraArg,S,P,C) ->
    Cmd = bind(DB, Gstkid, TkW, buttonrelease, On),
    out_opts(Opts,Gstkid,TkW,DB,ExtraArg,S,P,[Cmd,$;|C]).
gen_buttonrelease(_Opt,Gstkid,_TkW,DB,_ExtraArg) ->
    gstk_db:is_inserted(DB,Gstkid,buttonrelease).

gen_configure(On,Opts,Gstkid,TkW,DB,ExtraArg,S,P,C) ->
    Cmd = bind(DB, Gstkid, TkW, configure, On),
    out_opts(Opts,Gstkid,TkW,DB,ExtraArg,S,P,[Cmd,$;|C]).
gen_configure(_Opt,Gstkid,_TkW,DB,_ExtraArg) ->
    gstk_db:is_inserted(DB,Gstkid,configure).

gen_destroy(On,Opts,Gstkid,TkW,DB,ExtraArg,S,P,C) ->
    Cmd = bind(DB, Gstkid, TkW, destroy, On),
    out_opts(Opts,Gstkid,TkW,DB,ExtraArg,S,P,[Cmd,$;|C]).
gen_destroy(_Opt,Gstkid,_TkW,DB,_ExtraArg) ->
    gstk_db:is_inserted(DB,Gstkid,destroy).

gen_enter(On,Opts,Gstkid,TkW,DB,ExtraArg,S,P,C) ->
    Cmd = bind(DB, Gstkid, TkW, enter, On),
    out_opts(Opts,Gstkid,TkW,DB,ExtraArg,S,P,[Cmd,$;|C]).
gen_enter(_Opt,Gstkid,_TkW,DB,_ExtraArg) ->
    gstk_db:is_inserted(DB,Gstkid,enter).

gen_focus_ev(On,Opts,Gstkid,TkW,DB,ExtraArg,S,P,C) ->
    Cmd = bind(DB, Gstkid, TkW, focus, On),
    out_opts(Opts,Gstkid,TkW,DB,ExtraArg,S,P,[Cmd,$;|C]).
gen_focus_ev(_Opt,Gstkid,_TkW,DB,_ExtraArg) ->
    gstk_db:is_inserted(DB,Gstkid,focus).

gen_keypress(On,Opts,Gstkid,TkW,DB,ExtraArg,S,P,C) ->
    Cmd = bind(DB, Gstkid, TkW, keypress, On),
    out_opts(Opts,Gstkid,TkW,DB,ExtraArg,S,P,[Cmd,$;|C]).
gen_keypress(_Opt,Gstkid,_TkW,DB,_ExtraArg) ->
    gstk_db:is_inserted(DB,Gstkid,keypress).

gen_keyrelease(On,Opts,Gstkid,TkW,DB,ExtraArg,S,P,C) ->
    Cmd = bind(DB, Gstkid, TkW, keyrelease, On),
    out_opts(Opts,Gstkid,TkW,DB,ExtraArg,S,P,[Cmd,$;|C]).
gen_keyrelease(_Opt,Gstkid,_TkW,DB,_ExtraArg) ->
    gstk_db:is_inserted(DB,Gstkid,keyrelease).

gen_leave(On,Opts,Gstkid,TkW,DB,ExtraArg,S,P,C) ->
    Cmd = bind(DB, Gstkid, TkW, leave, On),
    out_opts(Opts,Gstkid,TkW,DB,ExtraArg,S,P,[Cmd,$;|C]).
gen_leave(_Opt,Gstkid,_TkW,DB,_ExtraArg) ->
    gstk_db:is_inserted(DB,Gstkid,leave).

gen_motion(On,Opts,Gstkid,TkW,DB,ExtraArg,S,P,C) ->
    Cmd = bind(DB, Gstkid, TkW, motion, On),
    out_opts(Opts,Gstkid,TkW,DB,ExtraArg,S,P,[Cmd,$;|C]).
gen_motion(_Opt,Gstkid,_TkW,DB,_ExtraArg) ->
    gstk_db:is_inserted(DB,Gstkid,motion).

gen_highlightbw(Wth,Opts,Gstkid,TkW,DB,ExtraArg,S,P,C) ->
    out_opts(Opts,Gstkid,TkW,DB,ExtraArg,[" -highlightt ", gstk:to_ascii(Wth)|S],P,C).
gen_highlightbw(_Opt,_Gstkid,TkW,_DB,_ExtraArg) ->
    tcl2erl:ret_int([TkW, " cg -highlightt"]).

gen_highlightbg(Color,Opts,Gstkid,TkW,DB,ExtraArg,S,P,C) ->
    out_opts(Opts,Gstkid,TkW,DB,ExtraArg,[" -highlightb ", gstk:to_color(Color)|S],P,C).
gen_highlightbg(_Opt,_Gstkid,TkW,_DB,_ExtraArg) ->
    tcl2erl:ret_color([TkW, " cg -highlightb"]).

gen_highlightfg(Color,Opts,Gstkid,TkW,DB,ExtraArg,S,P,C) ->
    out_opts(Opts,Gstkid,TkW,DB,ExtraArg,[" -highlightc ", gstk:to_color(Color)|S],P,C).
gen_highlightfg(_Opt,_Gstkid,TkW,_DB,_ExtraArg) ->
    tcl2erl:ret_color([TkW,  " cg -highlightc"]).


gen_selectbw(Width,Opts,Gstkid,TkW,DB,ExtraArg,S,P,C) ->
    out_opts(Opts,Gstkid,TkW,DB,ExtraArg,S,P,[TkW, " conf -selectbo ", gstk:to_ascii(Width),$;|C]).
gen_selectbw(_Opt,_Gstkid,TkW,_DB,_ExtraArg) ->
    tcl2erl:ret_int([TkW," cg -selectbo"]).

gen_selectfg(Color,Opts,Gstkid,TkW,DB,ExtraArg,S,P,C) ->
    out_opts(Opts,Gstkid,TkW,DB,ExtraArg,S,P,[TkW, " conf -selectfo ", gstk:to_color(Color),$;|C]).
gen_selectfg(_Opt,_Gstkid,TkW,_DB,_ExtraArg) ->
    tcl2erl:ret_color([TkW," cg -selectfo"]).

gen_selectbg(Color,Opts,Gstkid,TkW,DB,ExtraArg,S,P,C) ->
    out_opts(Opts,Gstkid,TkW,DB,ExtraArg,S,P,[TkW, " conf -selectba ", gstk:to_color(Color),$;|C]).
gen_selectbg(_Opt,_Gstkid,TkW,_DB,_ExtraArg) ->
    tcl2erl:ret_color([TkW," cg -selectba"]).

gen_fg(Color,Opts,Gstkid,TkW,DB,ExtraArg,S,P,C) ->
    out_opts(Opts,Gstkid,TkW,DB,ExtraArg,[" -fg ", gstk:to_color(Color)|S],P,C).
gen_fg(_Opt,_Gstkid,TkW,_DB,_ExtraArg) ->
    tcl2erl:ret_color([TkW, " cg -fg"]).

gen_bg(Color,Opts,Gstkid,TkW,DB,ExtraArg,S,P,C) ->
    out_opts(Opts,Gstkid,TkW,DB,ExtraArg,[" -bg ", gstk:to_color(Color)|S],P,C).
gen_bg(_Opt,_Gstkid,TkW,_DB,_ExtraArg) ->
    tcl2erl:ret_color([TkW, " cg -bg"]).

%%----------------------------------------------------------------------
%% Generic functions for scrolled objects
%%----------------------------------------------------------------------
gen_so_activebg(Color,Opts,Gstkid,TkW,DB,ExtraArg,S,P,C) ->
    Col = gstk:to_color(Color),
    C2 = [TkW, ".sy conf -activeba ", Col,$;,
	  TkW, ".pad.sx conf -activeba ", Col],
    out_opts(Opts,Gstkid,TkW,DB,ExtraArg,S,P,[C2,$;|C]).
gen_so_activebg(_Opt,_Gstkid,TkW,_DB,_ExtraArg) ->
    tcl2erl:ret_color([TkW,".sy cg -activeba"]).

gen_so_bc(Color,Opts,Gstkid,TkW,DB,ExtraArg,S,P,C) ->
    Col = gstk:to_color(Color),
    C2= [TkW, " conf -bg ", Col,$;,
	 TkW, ".sy conf -highlightba ", Col,$;,
	 TkW, ".pad.it conf -bg ", Col,$;,
	 TkW, ".pad.sx conf -highlightba ", Col],
    out_opts(Opts,Gstkid,TkW,DB,ExtraArg,S,P,[C2,$;|C]).
gen_so_bc(_Opt,_Gstkid,TkW,_DB,_ExtraArg) ->
    tcl2erl:ret_color([TkW," cg -bg"]).

gen_so_scrollfg(Color,Opts,Gstkid,TkW,DB,ExtraArg,S,P,C) ->
    Col = gstk:to_color(Color),
    C2=[TkW, ".sy conf -bg ", Col,$;,
	TkW, ".pad.sx conf -bg ", Col],
    out_opts(Opts,Gstkid,TkW,DB,ExtraArg,S,P,[C2,$;|C]).
gen_so_scrollfg(_Opt,_Gstkid,TkW,_DB,_ExtraArg) ->
    tcl2erl:ret_color([TkW,".sy cg -bg"]).


gen_so_scrollbg(Color,Opts,Gstkid,TkW,DB,ExtraArg,S,P,C) ->
    Col = gstk:to_color(Color),
    C2 = [TkW, ".sy conf -troughc ", Col, $;,
	  TkW, ".pad.sx conf -troughc ", Col],
    out_opts(Opts,Gstkid,TkW,DB,ExtraArg,S,P,[C2,$;|C]).

gen_so_scrollbg(_Opt,_Gstkid,TkW,_DB,_ExtraArg) ->
    tcl2erl:ret_color([TkW,".sy cg -troughc"]).

obj(#gstkid{widget_data=SO}) ->
    SO#so.object.

gen_so_bg(Color,Opts,Gstkid,TkW,DB,ExtraArg,S,P,C) ->
    C2= [obj(Gstkid), " conf -bg ", gstk:to_color(Color)],
    out_opts(Opts,Gstkid,TkW,DB,ExtraArg,S,P,[C2,$;|C]).
gen_so_bg(_Opt,Gstkid,_TkW,_DB,_ExtraArg) ->
    tcl2erl:ret_color([obj(Gstkid)," cg -bg"]).

gen_so_selectbw(Width,Opts,Gstkid,TkW,DB,ExtraArg,S,P,C) ->
    C2 = [obj(Gstkid), " conf -selectbo ", gstk:to_ascii(Width)],
    out_opts(Opts,Gstkid,TkW,DB,ExtraArg,S,P,[C2,$;|C]).
gen_so_selectbw(_Opt,Gstkid,_TkW,_DB,_ExtraArg) ->
    tcl2erl:ret_int([obj(Gstkid)," cg -selectbo"]).

gen_so_selectfg(Color,Opts,Gstkid,TkW,DB,ExtraArg,S,P,C) ->
    C2 = [obj(Gstkid), " conf -selectfo ", gstk:to_color(Color)],
    out_opts(Opts,Gstkid,TkW,DB,ExtraArg,S,P,[C2,$;|C]).
gen_so_selectfg(_Opt,Gstkid,_TkW,_DB,_ExtraArg) ->
    tcl2erl:ret_color([obj(Gstkid)," cg -selectfo"]).

gen_so_selectbg(Color,Opts,Gstkid,TkW,DB,ExtraArg,S,P,C) ->
    C2 = [obj(Gstkid), " conf -selectba ", gstk:to_color(Color)],
    out_opts(Opts,Gstkid,TkW,DB,ExtraArg,S,P,[C2,$;|C]).
gen_so_selectbg(_Opt,Gstkid,_TkW,_DB,_ExtraArg) ->
    tcl2erl:ret_color([obj(Gstkid)," cg -selectba"]).

gen_so_scrolls({Vscroll, Hscroll},Opts,Gstkid,TkW,DB,ExtraArg,S,P,C) ->
    SO = Gstkid#gstkid.widget_data,
    NewSO = SO#so{hscroll=Hscroll, vscroll=Vscroll},
    C2 = scrolls_vh(TkW, Vscroll, Hscroll),
    Ngstkid = Gstkid#gstkid{widget_data=NewSO},
    gstk_db:update_widget(DB,Ngstkid),
    out_opts(Opts,Ngstkid,TkW,DB,ExtraArg,S,P,[C2,$;|C]).

						% read-only
gen_so_hscroll(_Opt,#gstkid{widget_data=SO},_TkW,_DB,_) ->
    SO#so.hscroll.

						% read-only
gen_so_vscroll(_Opt,#gstkid{widget_data=SO},_TkW,_DB,_) ->
    SO#so.vscroll.

cursors() -> [{arrow,"top_left_arrow"},{busy,"watch"},{cross,"X_cursor"},
	      {hand,"hand2"},{help,"question_arrow"},{resize,"fleur"},
	      {text,"xterm"}].

gen_cursor(parent,Opts,Gstkid,TkW,DB,ExtraArg,S,P,C) ->
    out_opts(Opts,Gstkid,TkW,DB,ExtraArg,[" -cur {}"|S],P,C);
gen_cursor(Cur,Opts,Gstkid,TkW,DB,ExtraArg,S,P,C) ->
    case gs:assq(Cur,cursors()) of
	{value, TxtCur} ->
	    out_opts(Opts,Gstkid,TkW,DB,ExtraArg,[" -cur ",TxtCur|S],P,C);
	_ ->
	    {error,{invalid_cursor,Gstkid#gstkid.objtype,Cur}}
    end.
gen_cursor(_Opt,_Gstkid,TkW,_DB,_ExtraArg) ->
    case tcl2erl:ret_str([TkW," cg -cur"]) of
	"" -> parent;
	Txt when is_list(Txt) ->
	    case lists:keysearch(Txt,2,cursors()) of
		{value,{Cur,_}} -> Cur;
		_ -> {bad_result, read_cursor}
	    end;
	Bad_Result -> Bad_Result
    end.

gen_citem_coords(Coords,Opts,Gstkid,TkW,DB,AItem,S,P,C) ->
    gstk_db:insert_opt(DB,Gstkid,{coords,Coords}),
    out_opts(Opts,Gstkid,TkW,DB,AItem,S,P,
	     [TkW, " coords ", AItem," ",gstk_canvas:coords(Coords),$;|C]).
gen_citem_coords(_Opt,Gstkid,_TkW,DB,_ExtraArg) ->
    gstk_db:opt(DB,Gstkid, coords).

gen_citem_fill(none,Opts,Gstkid,TkW,DB,AItem,S,P,C) ->
    out_opts(Opts,Gstkid,TkW,DB,AItem,[" -f {}"|S],P,C);
gen_citem_fill(Color,Opts,Gstkid,TkW,DB,AItem,S,P,C) ->
    out_opts(Opts,Gstkid,TkW,DB,AItem,[" -f ",gstk:to_color(Color)|S],P,C).
gen_citem_fill(_Opt,_Gstkid,TkW,_DB,AItem) ->
    tcl2erl:ret_color([TkW, " itemcg ", AItem, " -f"]).

gen_citem_lower(_,Opts,Gstkid,TkW,DB,AItem,S,P,C) ->
    out_opts(Opts,Gstkid,TkW,DB,AItem,S,P,
	     [TkW, " lower ", AItem,$;|C]).

gen_citem_raise(_,Opts,Gstkid,TkW,DB,AItem,S,P,C) ->
    out_opts(Opts,Gstkid,TkW,DB,AItem,S,P,
	     [TkW, " raise ", AItem,$;|C]).

gen_citem_move({Dx,Dy},Opts,Gstkid,TkW,DB,AItem,S,P,C) ->
    NewCoords = move_coords(Dx,Dy,gstk_db:opt(DB,Gstkid,coords)),
    gstk_db:insert_opt(DB,Gstkid,NewCoords),
    out_opts(Opts,Gstkid,TkW,DB,AItem,S,P,
	     [TkW, " move ", AItem, " ",
	      gstk:to_ascii(Dx), " ", gstk:to_ascii(Dy),$;|C]).

move_coords(Dx,Dy,Coords) ->
    Coords2 = add_to_coords(Dx,Dy, Coords),
    {coords,Coords2}.

add_to_coords(Dx,Dy,[{X,Y}|Coords]) ->
    [{X+Dx,Y+Dy}|add_to_coords(Dx,Dy,Coords)];
add_to_coords(_,_,[]) -> [].


gen_citem_setfocus(true,Opts,Gstkid,TkW,DB,AItem,S,P,C) ->
    out_opts(Opts,Gstkid,TkW,DB,AItem,S,P,
	     [TkW, " focus ", AItem,$;|C]);
gen_citem_setfocus(false,Opts,Gstkid,TkW,DB,AItem,S,P,C) ->
    out_opts(Opts,Gstkid,TkW,DB,AItem,S,P,
	     [TkW, " focus {}",$;|C]).
gen_citem_setfocus(_Opt,_Gstkid,TkW,_DB,_ExtraArg) ->
    tcl2erl:ret_focus(gstk:to_ascii(bug_aitem),[TkW, " focus"]).

gen_citem_buttonpress(On,Opts,Gstkid,TkW,DB,AItem,S,P,C) ->
    out_opts(Opts,Gstkid,TkW,DB,AItem,S,P,
	     [item_bind(DB, Gstkid, TkW, AItem,buttonpress, On),$;|C]).
gen_citem_buttonrelease(On,Opts,Gstkid,TkW,DB,AItem,S,P,C) ->
    out_opts(Opts,Gstkid,TkW,DB,AItem,S,P,
	     [item_bind(DB,Gstkid,TkW,AItem,buttonrelease, On),$;|C]).
gen_citem_enter(On,Opts,Gstkid,TkW,DB,AItem,S,P,C) ->
    out_opts(Opts,Gstkid,TkW,DB,AItem,S,P,
	     [item_bind(DB, Gstkid, TkW, AItem, enter, On),$;|C]).

gen_citem_keypress(On,Opts,Gstkid,TkW,DB,AItem,S,P,C) ->
    out_opts(Opts,Gstkid,TkW,DB,AItem,S,P,
	     [item_bind(DB, Gstkid, TkW, AItem, keypress, On),$;|C]).
gen_citem_keyrelease(On,Opts,Gstkid,TkW,DB,AItem,S,P,C) ->
    out_opts(Opts,Gstkid,TkW,DB,AItem,S,P,
	     [item_bind(DB, Gstkid, TkW, AItem, keyrelease, On),$;|C]).

gen_citem_leave(On,Opts,Gstkid,TkW,DB,AItem,S,P,C) ->
    out_opts(Opts,Gstkid,TkW,DB,AItem,S,P,
	     [item_bind(DB, Gstkid, TkW, AItem, leave, On),$;|C]).
gen_citem_motion(On,Opts,Gstkid,TkW,DB,AItem,S,P,C) ->
    out_opts(Opts,Gstkid,TkW,DB,AItem,S,P,
	     [item_bind(DB, Gstkid, TkW, AItem, motion, On),$;|C]).


scrolls_vh(W, V,       true) -> scrolls_vh(W, V, bottom);
scrolls_vh(W, true,       H) -> scrolls_vh(W, left, H);
scrolls_vh(W, left,  bottom) -> ["so_bottom_left ",W];
scrolls_vh(W, left,     top) -> ["so_top_left ",W];
scrolls_vh(W, left,       _) -> ["so_left ",W];
scrolls_vh(W, right, bottom) -> ["so_bottom_right ",W];
scrolls_vh(W, right,    top) -> ["so_top_right ",W];
scrolls_vh(W, right,      _) -> ["so_right ",W];
scrolls_vh(W, _,     bottom) -> ["so_bottom ",W];
scrolls_vh(W, _,        top) -> ["so_top ",W];
scrolls_vh(W, _,          _) -> ["so_plain ",W].

%% create version
parse_scrolls(Opts) ->
    {Vscroll, Hscroll, NewOpts} = parse_scrolls(Opts, false, false, []),
    {Vscroll, Hscroll, [{scrolls, {Vscroll, Hscroll}} | NewOpts]}.

%% config version
parse_scrolls(Gstkid, Opts) ->
    SO = Gstkid#gstkid.widget_data,
    Vscroll = SO#so.vscroll,
    Hscroll = SO#so.hscroll,
    case parse_scrolls(Opts, Vscroll, Hscroll, []) of
	{Vscroll, Hscroll, Opts} -> Opts;
	{NewVscroll, NewHscroll, NewOpts} -> 
	    [{scrolls, {NewVscroll, NewHscroll}} | NewOpts]
    end.


parse_scrolls([Option | Rest], Vscroll, Hscroll, Opts) when is_tuple(Option) ->
    case element(1, Option) of
	vscroll ->
	    parse_scrolls(Rest, element(2, Option), Hscroll, Opts);
	hscroll ->
	    parse_scrolls(Rest, Vscroll, element(2, Option), Opts);
	_ ->
	    parse_scrolls(Rest, Vscroll, Hscroll, [Option | Opts])
    end;

parse_scrolls([Option | Rest], Vscroll, Hscroll, Opts) ->
    parse_scrolls(Rest, Vscroll, Hscroll, [Option | Opts]);

parse_scrolls([], Vscroll, Hscroll, Opts) ->
    {Vscroll, Hscroll, Opts}.


%%
%% Event bind main function
%%
%% Should return a list of tcl commands or invalid_option
%%
%% WS = Widget suffix for complex widgets
%%
bind(DB, Gstkid, TkW, Etype, On) ->
    WD = Gstkid#gstkid.widget_data,
    TkW2 = if is_record(WD, so) ->
		   WD#so.object;
	      true -> TkW
	   end,
    case bind(DB, Gstkid, TkW2, Etype, On, "") of
	invalid_option -> invalid_option;
	Cmd ->
	    Cmd
    end.

bind(DB, Gstkid, TkW, Etype, On, WS) ->
    case On of
	true  -> ebind(DB, Gstkid, TkW, Etype, WS, "");
	false -> eunbind(DB, Gstkid, TkW, Etype, WS, "");
	{true, Edata} -> ebind(DB, Gstkid, TkW, Etype, WS, Edata);
	{false, Edata} -> eunbind(DB, Gstkid, TkW, Etype, WS, Edata);
	_     -> invalid_option
    end.


%%
%% Event bind on
%%
%% Should return a list of tcl commands or invalid_option
%%
%% WS = Widget suffix for complex widgets
%%
ebind(DB, Gstkid, TkW, Etype, WS, Edata) ->
    Eref = gstk_db:insert_event(DB, Gstkid, Etype, Edata),
    P = ["bind ", TkW, WS],
    Cmd = case Etype of
	      motion -> [P, " <Motion> {erlsend ", Eref, " %x %y}"];
	      keypress ->
		  [P, " <KeyPress> {erlsend ", Eref," %K %N 0 0};",
		   P, " <Shift-KeyPress> {erlsend ", Eref, " %K %N 1 0};",
		   P, " <Control-KeyPress> {erlsend ", Eref, " %K %N 0 1};",
		   P," <Control-Shift-KeyPress> {erlsend ", Eref," %K %N 1 1}"];
	      keyrelease ->
		  [P, " <KeyRelease> {erlsend ", Eref," %K %N 0 0};",
		   P, " <Shift-KeyRelease> {erlsend ", Eref, " %K %N 1 0};",
		   P, " <Control-KeyRelease> {erlsend ", Eref, " %K %N 0 1};",
		   P," <Control-Shift-KeyRelease> {erlsend ",Eref," %K %N 1 1}"];
	      buttonpress ->
		  [P, " <ButtonPress> {erlsend ", Eref, " %b %x %y}"];
	      buttonrelease ->
		  [P, " <ButtonRelease> {erlsend ", Eref, " %b %x %y}"];
	      leave -> [P, " <Leave> {erlsend ", Eref, "}"];
	      enter -> [P, " <Enter> {erlsend ", Eref, "}"];
	      destroy ->
		  [P, " <Destroy> {if {\"%W\"==\"", [TkW, WS], 
		   "\"} {erlsend ", Eref, "}}"];
	      focus ->
		  [P, " <FocusIn> {erlsend ", Eref, " 1};" ,
		   P, " <FocusOut> {erlsend ", Eref, " 0}"];
	      configure ->
		  [P, " <Configure> {if {\"%W\"==\"", [TkW, WS], 
		   "\"} {erlsend ", Eref, " %w %h %x %y}}"]
	  end,
    Cmd.


%%
%% Unbind event
%%
%% Should return a list of tcl commands
%% Already checked for validation in bind/5
%%
%% WS = Widget suffix for complex widgets
%%
eunbind(DB, Gstkid, TkW, Etype, WS, _Edata) ->
    gstk_db:delete_event(DB, Gstkid, Etype),
    P = ["bind ", TkW, WS],
    Cmd = case Etype of
	      motion ->
		  [P, " <Motion> {}"];
	      keypress -> 
		  [P, " <KeyPress> {};",
		   P, " <Shift-KeyPress> {};",
		   P, " <Control-KeyPress> {};",
		   P, " <Control-Shift-KeyPress> {}"];
	      keyrelease -> 
		  [P, " <KeyRelease> {};",
		   P, " <Shift-KeyRelease> {};",
		   P, " <Control-KeyRelease> {};",
		   P, " <Control-Shift-KeyRelease> {}"];
	      buttonpress ->
		  [P, " <ButtonPress> {}"];
	      buttonrelease ->
		  [P, " <ButtonRelease> {}"];
	      leave ->
		  [P, " <Leave> {}"];
	      enter ->
		  [P, " <Enter> {}"];
	      destroy ->
		  [P, " <Destroy> {}"];
	      focus ->
		  [P, " <FocusIn> {};",
		   P, " <FocusOut> {}"];
	      configure ->
		  [P, " <Configure> {}"]
	  end,
    Cmd.


%%
%% Event item bind main function
%%
%% Should return a list of tcl commands or invalid_option
%%
item_bind(DB, Gstkid, Canvas, Item, Etype, On) ->
    case On of
	true          -> item_ebind(DB, Gstkid, Canvas, Item, Etype, "");
	{true, Edata} -> item_ebind(DB, Gstkid, Canvas, Item, Etype, Edata);
	_Other         -> item_eunbind(DB, Gstkid, Canvas, Item, Etype)
    end.

%%
%% Event bind on
%%
%% Should return a list of tcl commands or invalid_option
%%
item_ebind(DB, Gstkid, Canvas, Item, Etype, Edata) ->
    Eref = gstk_db:insert_event(DB, Gstkid, Etype, Edata),
    P = [Canvas, " bind ", Item],
    case Etype of
	enter  -> [P, " <Enter> {erlsend ", Eref, "}"];
	leave  -> [P, " <Leave> {erlsend ", Eref, "}"];
	motion -> [P, " <Motion> {erlsend ", Eref, " [",
		   Canvas, " canvasx %x] [", Canvas, " canvasy %y] %x %y}"];
	keypress ->
	    [P, " <Key> {erlsend ", Eref," %K %N 0 0 [",
	     Canvas, " canvasx %x] [", Canvas, " canvasy %y]};",
	     P, " <Shift-Key> {erlsend ", Eref, " %K %N 1 0 [",
	     Canvas, " canvasx %x] [", Canvas, " canvasy %y]};",
	     P, " <Control-Key> {erlsend ", Eref, " %K %N 0 1 [",
	     Canvas, " canvasx %x] [", Canvas, " canvasy %y]};",
	     P, " <Control-Shift-Key> {erlsend ", Eref," %K %N 1 1 [",
	     Canvas, " canvasx %x] [", Canvas, " canvasy %y]}"];
	keyrelease ->
	    [P, " <KeyRelease> {erlsend ", Eref," %K %N 0 0 [",
	     Canvas, " canvasx %x] [", Canvas, " canvasy %y]};",
	     P, " <Shift-KeyRelease> {erlsend ", Eref, " %K %N 1 0 [",
	     Canvas, " canvasx %x] [", Canvas, " canvasy %y]};",
	     P, " <Control-KeyRelease> {erlsend ", Eref, " %K %N 0 1 [",
	     Canvas, " canvasx %x] [", Canvas, " canvasy %y]};",
	     P, " <Control-Shift-KeyRelease> {erlsend ", Eref," %K %N 1 1[",
	     Canvas, " canvasx %x] [", Canvas, " canvasy %y]}"];
	buttonpress ->
	    [P, " <Button> {erlsend ", Eref, " %b [",
	     Canvas, " canvasx %x] [", Canvas, " canvasy %y] %x %y}"];
	buttonrelease ->
	    [P, " <ButtonRelease> {erlsend ", Eref, " %b [",
	     Canvas, " canvasx %x] [", Canvas, " canvasy %y] %x %y}"]
    end.


%%
%% Unbind event
%%
%% Should return a list of tcl commands
%% Already checked for validation in bind/5
%%
item_eunbind(DB, Gstkid, Canvas, Item, Etype) ->
    gstk_db:delete_event(DB, Gstkid, Etype),
    P = [Canvas, " bind ", Item],
    Cmd = case Etype of
	      enter         -> [P, " <Enter> {}"];
	      leave         -> [P, " <Leave> {}"];
	      motion        -> [P, " <Motion> {}"];
	      keypress -> 
		  [P, " <KeyPress> {};",
		   P, " <Shift-KeyPress> {};",
		   P, " <Control-KeyPress> {};",
		   P, " <Control-Shift-KeyPress> {}"];
	      keyrelease -> 
		  [P, " <KeyRelease> {};",
		   P, " <Shift-KeyRelease> {};",
		   P, " <Control-KeyRelease> {};",
		   P, " <Control-Shift-KeyRelease> {}"];
	      buttonpress   -> [P, " <Button> {}"];
	      buttonrelease -> [P, " <ButtonRelease> {}"]
	  end,
    Cmd.



event(DB, Gstkid, Etype, _Edata, Args) ->
    #gstkid{owner=Ow,id=Id} = Gstkid,
    Data = gstk_db:opt(DB,Gstkid,data),
    gs_frontend:event(get(gs_frontend),Ow,{gs,Id,Etype,Data,Args}).