aboutsummaryrefslogtreecommitdiffstats
path: root/lib/gs/src/gstk_radiobutton.erl
diff options
context:
space:
mode:
Diffstat (limited to 'lib/gs/src/gstk_radiobutton.erl')
-rw-r--r--lib/gs/src/gstk_radiobutton.erl342
1 files changed, 342 insertions, 0 deletions
diff --git a/lib/gs/src/gstk_radiobutton.erl b/lib/gs/src/gstk_radiobutton.erl
new file mode 100644
index 0000000000..fac150e010
--- /dev/null
+++ b/lib/gs/src/gstk_radiobutton.erl
@@ -0,0 +1,342 @@
+%%
+%% %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 Radiobutton Type
+%% ------------------------------------------------------------
+
+-module(gstk_radiobutton).
+
+%%------------------------------------------------------------------------------
+%% RADIOBUTTON OPTIONS
+%%
+%% Attributes:
+%% activebg Color
+%% activefg Color
+%% align n,w,s,e,nw,se,ne,sw,center
+%% anchor n,w,s,e,nw,se,ne,sw,center
+%% bg Color
+%% bw Int
+%% data Data
+%% disabledfg Color
+%% enable Bool
+%% fg Color
+%% group Atom
+%% groupid Groupid
+%% height Int
+%% highlightbg Color
+%% highlightbw Int
+%% highlightfg Color
+%% justify left|right|center
+%% label {text, String} | {image, BitmapFile}
+%% padx Int (Pixels)
+%% pady Int (Pixels)
+%% relief Relief [flat|raised|sunken|ridge|groove]
+%% selectbg Color
+%% underline Int
+%% value Atom
+%% width Int
+%% wraplength Int
+%% x Int
+%% y Int
+%%
+%% Commands:
+%% flash
+%% invoke
+%% select Bool
+%% setfocus Bool
+%%
+%% Events:
+%% buttonpress [Bool | {Bool, Data}]
+%% buttonrelease [Bool | {Bool, Data}]
+%% click [Bool | {Bool, Data}]
+%% configure [Bool | {Bool, Data}]
+%% destroy [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
+%%
+%% Not Implemented:
+%% cursor ??????
+%% focus ?????? (-takefocus)
+%% font ??????
+%%
+
+-export([create/3,config/3,read/3,delete/2,event/5,option/5,read_option/5]).
+
+-include("gstk.hrl").
+
+%%------------------------------------------------------------------------------
+%% MANDATORY INTERFACE FUNCTIONS
+%%------------------------------------------------------------------------------
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Function : create/3
+%% Purpose : Create a widget of the type defined in this module.
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+create(DB, GstkId, Opts) ->
+ TkW = gstk_generic:mk_tkw_child(DB,GstkId),
+ {G, GID, V, NOpts} = fix_group_and_value(Opts, DB, GstkId#gstkid.owner),
+ NGstkId=GstkId#gstkid{widget=TkW,widget_data={G, GID, V}},
+ PlacePreCmd = [";place ", TkW],
+ case gstk_generic:make_command(NOpts, NGstkId, TkW, "", PlacePreCmd, DB) of
+ {error,Reason} -> {error,Reason};
+ Cmd when is_list(Cmd) ->
+ gstk:exec(["radiobutton ", TkW," -bo 2 -indi true ",Cmd]),
+ NGstkId
+ 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, Opts) ->
+ TkW = Gstkid#gstkid.widget,
+ {NOpts, NGstkid} = fix_group_and_value(Opts, DB, Gstkid#gstkid.owner, Gstkid),
+ SimplePreCmd = [TkW, " conf"],
+ PlacePreCmd = [";place ", TkW],
+ gstk_generic:mk_cmd_and_exec(NOpts,NGstkid,TkW,SimplePreCmd,PlacePreCmd,DB).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Function : read/3
+%% Purpose : Read one option from a widget
+%% Args : DB - The Database
+%% Gstkid - The gstkid of the widget
+%% Opt - An option to read
+%%
+%% Return : [OptionValue | {bad_result, Reason}]
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+read(DB, Gstkid, Opt) ->
+ gstk_generic:read_option(DB, Gstkid, Opt).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Function : delete/2
+%% Purpose : Delete widget from databas and return tkwidget to destroy
+%% Args : DB - The Database
+%% Gstkid - The gstkid of the widget
+%%
+%% Return : TkWidget to destroy
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+delete(DB, Gstkid) ->
+ gstk_db:delete_widget(DB, Gstkid),
+ {_, Gid, _} = Gstkid#gstkid.widget_data,
+ gstk_db:delete_bgrp(DB, Gid),
+ 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, Etype, Edata, Args) ->
+ Arg2 = case Etype of
+ click ->
+ [Text, _Grp | Rest] = Args,
+ {G, _Gid, V} = Gstkid#gstkid.widget_data,
+ [Text, G, V | Rest];
+ _Other ->
+ Args
+ end,
+ gstk_generic:event(DB, Gstkid, Etype, Edata, Arg2).
+
+
+
+%%------------------------------------------------------------------------------
+%% MANDATORY FUNCTIONS
+%%------------------------------------------------------------------------------
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Function : option/4
+%% Purpose : Take care of options
+%% Args : Option - An option tuple
+%% Gstkid - The gstkid of the widget
+%% TkW - The tk-widget
+%% DB - The Database
+%%
+%% Return : A tuple {OptionType, OptionCmd}
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+option(Option, Gstkid, TkW, DB,_) ->
+ case Option of
+ {disabledfg, Color} -> {s, [" -disabledforegr ", gstk:to_color(Color)]};
+ {group, Group} -> {s, [" -var ", gstk:to_ascii(Group)]};
+ {selectbg, Color} -> {s, [" -selectc ", gstk:to_color(Color)]};
+ {underline, Int} -> {s, [" -un ", gstk:to_ascii(Int)]};
+ {value, V} -> {s, [" -val ", gstk:to_ascii(V)]};
+ {wraplength, Int} -> {s, [" -wr ", gstk:to_ascii(Int)]};
+ flash -> {c, [TkW, " f;"]};
+ invoke -> {c, [TkW, " i;"]};
+ {select, true} -> {c, [TkW, " se;"]};
+ {select, false} -> {c, [TkW, " des;"]};
+ {click, On} -> cbind(DB, Gstkid, click, On);
+ _ -> invalid_option
+ end.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Function : read_option/4
+%% 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, TkW,DB,_) ->
+ case Option of
+ disabledfg -> tcl2erl:ret_color([TkW," cg -disabledforegr"]);
+ group -> {G, _, _} = Gstkid#gstkid.widget_data, G;
+ groupid -> {_, Gid, _} = Gstkid#gstkid.widget_data, Gid;
+ selectbg -> tcl2erl:ret_color([TkW," cg -selectc"]);
+ underline -> tcl2erl:ret_int([TkW," cg -un"]);
+ value -> {_, _, V} = Gstkid#gstkid.widget_data, V;
+ wraplength -> tcl2erl:ret_int([TkW," cg -wr"]);
+
+ select ->
+ Cmd = ["list [set x [",TkW," cg -var];global $x;set $x] [",
+ TkW," cg -val]"],
+ case tcl2erl:ret_tuple(Cmd) of
+ {X, X} -> true;
+ _Other -> false
+ end;
+
+ click -> gstk_db:is_inserted(DB, Gstkid, click);
+ _ -> {bad_result, {Gstkid#gstkid.objtype, invalid_option, Option}}
+ end.
+
+%%------------------------------------------------------------------------------
+%% PRIMITIVES
+%%------------------------------------------------------------------------------
+
+%% create version
+fix_group_and_value(Opts, DB, Owner) ->
+ {G, GID, V, NOpts} = fgav(Opts, erlNIL, erlNIL, erlNIL, []),
+ RV = case V of
+ erlNIL -> list_to_atom(lists:concat([v,gstk_db:counter(DB,value)]));
+ Other0 -> Other0
+ end,
+ NG = case G of
+ erlNIL -> rb;
+ Other1 -> Other1
+ end,
+ RGID = case GID of
+ erlNIL -> {rbgrp, NG, Owner};
+ Other2 -> Other2
+ end,
+ RG = gstk_db:insert_bgrp(DB, RGID),
+ {NG, RGID, RV, [{group, RG}, {value, RV} | NOpts]}.
+
+%% config version
+fix_group_and_value(Opts, DB, Owner, Gstkid) ->
+ {RG, RGID, RV} = Gstkid#gstkid.widget_data,
+ {G, GID, V, NOpts} = fgav(Opts, RG, RGID, RV, []),
+ case {G, GID, V} of
+ {RG, RGID, RV} ->
+ {NOpts, Gstkid};
+ {NG, RGID, RV} ->
+ NGID = {rbgrp, NG, Owner},
+ gstk_db:delete_bgrp(DB, RGID),
+ NRG = gstk_db:insert_bgrp(DB, NGID),
+ NGstkid = Gstkid#gstkid{widget_data={NG,NGID,RV}},
+ gstk_db:insert_widget(DB, NGstkid),
+ {[{group, NRG} | NOpts], NGstkid};
+ {RG, RGID, NRV} ->
+ NGstkid = Gstkid#gstkid{widget_data={RG,RGID,NRV}},
+ gstk_db:insert_widget(DB, NGstkid),
+ {[{value,NRV} | NOpts], NGstkid};
+ {_, NGID, RV} when NGID =/= RGID ->
+ gstk_db:delete_bgrp(DB, RGID),
+ NRG = gstk_db:insert_bgrp(DB, NGID),
+ NGstkid = Gstkid#gstkid{widget_data={RG,NGID,RV}},
+ gstk_db:insert_widget(DB, NGstkid),
+ {[{group, NRG} | NOpts], NGstkid};
+ {_, NGID, NRV} when NGID =/= RGID ->
+ gstk_db:delete_bgrp(DB, RGID),
+ NRG = gstk_db:insert_bgrp(DB, NGID),
+ NGstkid = Gstkid#gstkid{widget_data={RG,NGID,NRV}},
+ gstk_db:insert_widget(DB, NGstkid),
+ {[{group, NRG}, {value,NRV} | NOpts], NGstkid};
+ {NG, RGID, NRV} ->
+ NGID = {rbgrp, NG, Owner},
+ gstk_db:delete_bgrp(DB, RGID),
+ NRG = gstk_db:insert_bgrp(DB, NGID),
+ NGstkid = Gstkid#gstkid{widget_data={NG,NGID,NRV}},
+ gstk_db:insert_widget(DB, NGstkid),
+ {[{group, NRG}, {value,NRV} | NOpts], NGstkid}
+ end.
+
+
+
+fgav([{group, G} | Opts], _, GID, V, Nopts) ->
+ fgav(Opts, G, GID, V, Nopts);
+
+fgav([{groupid, GID} | Opts], G, _, V, Nopts) ->
+ fgav(Opts, G, GID, V, Nopts);
+
+fgav([{value, V} | Opts], G, GID, _, Nopts) ->
+ fgav(Opts, G, GID, V, Nopts);
+
+fgav([Opt | Opts], G, GID, V, Nopts) ->
+ fgav(Opts, G, GID, V, [Opt | Nopts]);
+
+fgav([], Group, GID, Value, Opts) ->
+ {Group, GID, Value, Opts}.
+
+%%
+%% Config bind
+%%
+cbind(DB, Gstkid, Etype, On) ->
+ TkW = Gstkid#gstkid.widget,
+ Cmd = case On of
+ {true, Edata} ->
+ Eref = gstk_db:insert_event(DB, Gstkid, Etype, Edata),
+ [" -command {erlsend ", Eref,
+ " \\\"[", TkW, " cg -text]\\\" [", TkW, " cg -var]}"];
+ true ->
+ Eref = gstk_db:insert_event(DB, Gstkid, Etype, ""),
+ [" -command {erlsend ", Eref,
+ " \\\"[", TkW, " cg -text]\\\" [", TkW, " cg -var]}"];
+ _Other ->
+ gstk_db:delete_event(DB, Gstkid, Etype),
+ " -command {}"
+ end,
+ {s, Cmd}.
+
+%% ----- Done -----
+
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-11 19:38:32 +0000