%% %% %CopyrightBegin% %% %% Copyright Ericsson AB 1996-2012. 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% %% %% -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}).