aboutsummaryrefslogtreecommitdiffstats
path: root/lib/gs/src/gstk_listbox.erl
diff options
context:
space:
mode:
authorErlang/OTP <[email protected]>2009-11-20 14:54:40 +0000
committerErlang/OTP <[email protected]>2009-11-20 14:54:40 +0000
commit84adefa331c4159d432d22840663c38f155cd4c1 (patch)
treebff9a9c66adda4df2106dfd0e5c053ab182a12bd /lib/gs/src/gstk_listbox.erl
downloadotp-84adefa331c4159d432d22840663c38f155cd4c1.tar.gz
otp-84adefa331c4159d432d22840663c38f155cd4c1.tar.bz2
otp-84adefa331c4159d432d22840663c38f155cd4c1.zip
The R13B03 release.OTP_R13B03
Diffstat (limited to 'lib/gs/src/gstk_listbox.erl')
-rw-r--r--lib/gs/src/gstk_listbox.erl323
1 files changed, 323 insertions, 0 deletions
diff --git a/lib/gs/src/gstk_listbox.erl b/lib/gs/src/gstk_listbox.erl
new file mode 100644
index 0000000000..4b5dd76b24
--- /dev/null
+++ b/lib/gs/src/gstk_listbox.erl
@@ -0,0 +1,323 @@
+%%
+%% %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 -----