%% %% %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 Listbox Type %% ------------------------------------------------------------ -module(gstk_listbox). %%----------------------------------------------------------------------------- %% LISTBOX OPTIONS %% %% Attributes: %% activebg Color %% anchor n,w,s,e,nw,se,ne,sw,center %% bc Color %% bg Color %% bw Wth %% data Data %% fg Color %% height Int %% highlightbg Color %% highlightbw Wth %% highlightfg Color %% hscroll Bool | top | bottom %% items [String, String, ... String] %% relief Relief %% scrollbg Color %% scrollfg Color %% selectbg Color %% selectbw Width %% selectfg Color %% selection Index | clear %% selectmode single|browse|multiple|extended %% vscroll Bool | left | right %% width Int %% x Int %% xselection Bool (Good name?????) %% y Int %% %% Commands: %% add {Index, String} | String %% change {Index, String} %% clear %% del Index | {FromIdx, ToIdx} %% get Index %% see Index %% selection => [Idx1,Idx2,Idx3...] %% setfocus Bool %% size Int %% %% Events: %% buttonpress [Bool | {Bool, Data}] %% buttonrelease [Bool | {Bool, Data}] %% click [Bool | {Bool, Data}] %% configure [Bool | {Bool, Data}] %% destroy [Bool | {Bool, Data}] %% doubleclick [Bool | {Bool, Data}] %% enter [Bool | {Bool, Data}] %% focus [Bool | {Bool, Data}] %% keypress [Bool | {Bool, Data}] %% keyrelease [Bool | {Bool, Data}] %% leave [Bool | {Bool, Data}] %% motion [Bool | {Bool, Data}] %% %% Read Options: %% children %% id %% parent %% type %% -export([create/3,config/3,read/3,delete/2,event/5,wid_event/5,option/5, read_option/5]). -include("gstk.hrl"). %%----------------------------------------------------------------------------- %% MANDATORY INTERFACE FUNCTIONS %%----------------------------------------------------------------------------- %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Function : create/7 %% Purpose : Create a widget of the type defined in this module. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% create(DB, GstkId, Opts) -> MainW = gstk_generic:mk_tkw_child(DB,GstkId), Listbox = lists:append(MainW,".z"), {Vscroll, Hscroll, NewOpts} = gstk_generic:parse_scrolls(Opts), WidgetD = #so{main=MainW, object=Listbox, hscroll=Hscroll, vscroll=Vscroll}, Gstkid=GstkId#gstkid{widget=MainW, widget_data=WidgetD}, MandatoryCmd = ["so_create listbox ", MainW], case gstk:call(MandatoryCmd) of {result, _} -> SimplePreCmd = [MainW, " conf"], PlacePreCmd = [";place ", MainW], case gstk_generic:make_command(NewOpts, Gstkid, MainW,SimplePreCmd, PlacePreCmd, DB,Listbox) of {error,Reason} -> {error,Reason}; Cmd when is_list(Cmd) -> gstk:exec(Cmd), gstk:exec([MainW,".sy conf -rel sunken -bo 2;", MainW,".pad.sx conf -rel sunken -bo 2;",Listbox, " conf -bo 2 -relief sunken -highlightth 2 -expo 0;"]), Gstkid end; Bad_Result -> {error, Bad_Result} end. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Function : config/3 %% Purpose : Configure a widget of the type defined in this module. %% Args : DB - The Database %% Gstkid - The gstkid of the widget %% Opts - A list of options for configuring the widget %% %% Return : [true | {bad_result, Reason}] %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% config(DB, Gstkid, Options) -> SO = Gstkid#gstkid.widget_data, MainW = Gstkid#gstkid.widget, Listbox = SO#so.object, NewOpts = gstk_generic:parse_scrolls(Gstkid, Options), SimplePreCmd = [MainW, " conf"], PlacePreCmd = [";place ", MainW], gstk_generic:mk_cmd_and_exec(NewOpts, Gstkid, MainW, SimplePreCmd, PlacePreCmd, DB,Listbox). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% 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) -> SO = Gstkid#gstkid.widget_data, gstk_generic:read_option(DB, Gstkid, Opt,SO#so.object). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% 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) -> gstk_db:delete_widget(DB, Gstkid), Gstkid#gstkid.widget. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Function : event/5 %% Purpose : Construct the event and send it to the owner of the widget %% Args : DB - The Database %% Gstkid - The gstkid of the widget %% Etype - The event type %% Edata - The event data %% Args - The data from tcl/tk %% %% Return : [true | {bad_result, Reason}] %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% event(DB, Gstkid, click, Edata, Args) -> wid_event(DB, Gstkid, click, Edata, Args); event(DB, Gstkid, doubleclick, Edata, Args) -> wid_event(DB, Gstkid, doubleclick, Edata, Args); event(DB, Gstkid, Etype, Edata, Args) -> gstk_generic:event(DB, Gstkid, Etype, Edata, Args). %% widget specific events wid_event(DB, Gstkid, Etype, Edata, _Args) -> SO = Gstkid#gstkid.widget_data, TkW = SO#so.object, CurIdx = tcl2erl:ret_int([TkW," index active;"]), CurTxt = tcl2erl:ret_str([TkW," get active;"]), CurSel = tcl2erl:ret_list([TkW," curselection;"]), Arg2 = [CurIdx,CurTxt,lists:member(CurIdx,CurSel)], gstk_generic:event(DB, Gstkid, Etype, Edata, Arg2). %%----------------------------------------------------------------------------- %% MANDATORY FUNCTIONS %%----------------------------------------------------------------------------- %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Function : option/5 %% Purpose : Take care of options %% Args : Option - An option tuple %% Gstkid - The gstkid of the widget %% MainW - The main tk-widget %% Listbox - The listbox tk-widget %% DB - The Database %% %% Return : A tuple {OptionType, OptionCmd} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% option(Option, Gstkid, MainW,DB, Listbox) -> case Option of {items, Items} when is_list(Items) -> {c, [Listbox," del 0 end ;", Listbox," ins 0 ",item_list(Items)]}; {selection, {From, To}} when is_integer(From),is_integer(To) -> {c,[Listbox," sel set ",gstk:to_ascii(From)," " ,gstk:to_ascii(To)]}; {font, Font} when is_tuple(Font) -> gstk_db:insert_opt(DB,Gstkid,Option), {c, [Listbox," conf -font ",gstk_font:choose_ascii(DB,Font)]}; {selection, clear} -> {c, [Listbox," sel clear 0 end"]}; {selection, Idx} when is_integer(Idx) -> {c, [Listbox, " select set ", gstk:to_ascii(Idx)]}; {selectmode, Mode} -> {c, [Listbox, " conf -selectm ", gstk:to_ascii(Mode)]}; {xselection, Bool} -> {c, [Listbox, " conf -exportse ", gstk:to_ascii(Bool)]}; {fg, Color} -> {c, [Listbox, " conf -fg ", gstk:to_color(Color)]}; {del, {From, To}} -> {c, [Listbox, " del ", integer_to_list(From), " ", integer_to_list(To)]}; {del, Idx} -> {c, [Listbox, " del ", integer_to_list(Idx)]}; clear -> {c, [Listbox," del 0 end"]}; {add, {Idx, Str}} -> {c, [Listbox, " ins ", integer_to_list(Idx), " ", gstk:to_ascii(Str)]}; {add, Str} -> {c, [Listbox," ins end ",gstk:to_ascii(Str)]}; {change, {Idx, Str}} -> {c, [Listbox, " del ", integer_to_list(Idx), $;, Listbox, " ins ", integer_to_list(Idx), " " , gstk:to_ascii(Str)]}; {see, Idx} -> {c, [Listbox," see ",gstk:to_ascii(Idx)]}; {setfocus, true} -> {c, ["focus ", MainW]}; {setfocus, false} -> {c, ["focus ."]}; {click, On} -> cbind(DB, Gstkid, Listbox, click, On); {doubleclick, On} -> cbind(DB, Gstkid, Listbox, doubleclick, On); _ -> invalid_option end. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Function : read_option/3 %% Purpose : Take care of a read option %% Args : DB - The Database %% Gstkid - The gstkid of the widget %% Option - An option %% %% Return : The value of the option or invalid_option %% [OptionValue | {bad_result, Reason}] %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% read_option(Option,GstkId,_MainW,DB,Listbox) -> case Option of fg -> tcl2erl:ret_color([Listbox," cg -fg"]); font -> gstk_db:opt(DB,GstkId,font,undefined); selection -> tcl2erl:ret_list([Listbox, " curselection"]); setfocus -> tcl2erl:ret_focus(Listbox, "focus"); items -> tcl2erl:ret_str_list([Listbox, " get 0 end"]); selectmode -> tcl2erl:ret_atom([Listbox, " cg -selectmode"]); size -> tcl2erl:ret_int([Listbox, " size"]); xselection -> tcl2erl:ret_bool([Listbox, " cg -exportsel"]); {get, Idx} -> tcl2erl:ret_str([Listbox, " get ",gstk:to_ascii(Idx)]); click -> gstk_db:is_inserted(DB, GstkId, click); doubleclick -> gstk_db:is_inserted(DB, GstkId, doubleclick); _ -> {bad_result, {GstkId#gstkid.objtype, invalid_option, Option}} end. %%----------------------------------------------------------------------------- %% PRIMITIVES %%----------------------------------------------------------------------------- item_list([H|T]) -> [gstk:to_ascii(H),$ |item_list(T)]; item_list([]) -> []. cbind(DB, Gstkid, Listbox, Etype, {true, Edata}) -> Button = case Etype of click -> " <ButtonRelease-1> "; doubleclick -> " <Double-ButtonRelease-1> " end, Eref = gstk_db:insert_event(DB, Gstkid, Etype, Edata), {c, ["bind " ,Listbox, Button, "{erlsend ", Eref," }"]}; cbind(DB, Gstkid, Listbox, Etype, true) -> cbind(DB, Gstkid, Listbox, Etype, {true, []}); cbind(DB, Gstkid, Listbox, Etype, _On) -> Button = case Etype of click -> " <Button-1> {}"; doubleclick -> " <Double-Button-1> {}" end, gstk_db:delete_event(DB, Gstkid, Etype), {c, ["bind ",Listbox, Button]}. %%% ----- Done -----