aboutsummaryrefslogtreecommitdiffstats
path: root/lib/gs/src/gstk_menubutton.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_menubutton.erl
downloadotp-84adefa331c4159d432d22840663c38f155cd4c1.tar.gz
otp-84adefa331c4159d432d22840663c38f155cd4c1.tar.bz2
otp-84adefa331c4159d432d22840663c38f155cd4c1.zip
The R13B03 release.OTP_R13B03
Diffstat (limited to 'lib/gs/src/gstk_menubutton.erl')
-rw-r--r--lib/gs/src/gstk_menubutton.erl237
1 files changed, 237 insertions, 0 deletions
diff --git a/lib/gs/src/gstk_menubutton.erl b/lib/gs/src/gstk_menubutton.erl
new file mode 100644
index 0000000000..6c5abf600f
--- /dev/null
+++ b/lib/gs/src/gstk_menubutton.erl
@@ -0,0 +1,237 @@
+%%
+%% %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 Menubutton Type
+%% ------------------------------------------------------------
+
+-module(gstk_menubutton).
+
+%%------------------------------------------------------------------------------
+%% MENUBUTTON 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
+%% fg Color
+%% font Font
+%% height Int
+%% highlightbg Color
+%% highlightbw Int
+%% highlightfg Color
+%% justify left|right|center (multiline text only)
+%% label {text, String} | {image, BitmapFile}
+%% padx Int (Pixels)
+%% pady Int (Pixels)
+%% relief Relief [flat|raised| sunken | ridge | groove]
+%% side left | right (valid only in menubars)
+%% underline Int
+%% width Int
+%% wraplength Int
+%% x Int (not valid in menubars)
+%% y Int (not valid in menubars)
+%%
+%% Commands:
+%% enable Bool
+%% setfocus Bool
+%%
+%% Events:
+%% buttonpress [Bool | {Bool, Data}]
+%% buttonrelease [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:
+%% activate ?????? (kontra enable, true)
+%% state ??????
+%% cursor ??????
+%% image ??????
+%% focus ?????? (-takefocus)
+%%
+
+-export([create/3,config/3,read/3,delete/2,event/5,option/5,read_option/5,
+ mk_create_opts_for_child/4]).
+
+-include("gstk.hrl").
+
+%%-----------------------------------------------------------------------------
+%% MANDATORY INTERFACE FUNCTIONS
+%%-----------------------------------------------------------------------------
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Function : create/7
+%% Purpose : Create a widget of the type defined in this module.
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+create(DB, GstkId, Opts) ->
+ TkW = gstk_generic:mk_tkw_child(DB,GstkId),
+ NGstkId=GstkId#gstkid{widget=TkW},
+ PlacePreCmd = [";place ", TkW],
+ case gstk_generic:make_command(Opts, NGstkId, TkW, "", PlacePreCmd, DB) of
+ {error,Reason} -> {error,Reason};
+ Cmd when is_list(Cmd) ->
+ gstk:exec(["menubutton ", TkW," -padx 4 -pady 3",Cmd]),
+ NGstkId
+ end.
+
+mk_create_opts_for_child(DB,Cgstkid, Pgstkid, Opts) ->
+ gstk_generic:mk_create_opts_for_child(DB,Cgstkid,Pgstkid,Opts).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% 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,
+ SimplePreCmd = [TkW, " conf"],
+ PlacePreCmd = [";place ", TkW],
+ gstk_generic:mk_cmd_and_exec(Opts,Gstkid,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),
+ Gstkid#gstkid.widget.
+
+event(DB, Gstkid, Etype, Edata, Args) ->
+ gstk_generic:event(DB, Gstkid, Etype, Edata, Args).
+
+%%-----------------------------------------------------------------------------
+%% 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
+ {anchor, How} -> fix_anchor(How, Gstkid, TkW, DB);
+ {disabledfg, Color} -> {s, [" -disabledf ", gstk:to_color(Color)]};
+ {height, Height} -> {s, [" -he ", gstk:to_ascii(Height)]};
+ {side, Side} -> fix_side(Side, Gstkid, TkW, DB);
+ {underline, Int} -> {s, [" -und ", gstk:to_ascii(Int)]};
+ {width, Width} -> {s, [" -wi ", gstk:to_ascii(Width)]};
+ {wraplength, Int} -> {s, [" -wr ", gstk:to_ascii(Int)]};
+ {x, X} -> fix_placement(x, X, Gstkid, TkW, DB);
+ {y, Y} -> fix_placement(y, Y, Gstkid, TkW, DB);
+ _ -> 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,TkW,_DB,_) ->
+ case Option of
+ anchor -> tcl2erl:ret_place(anchor, TkW);
+ disabledfg -> tcl2erl:ret_color([TkW," cg -disabledfo"]);
+ height -> tcl2erl:ret_int([TkW," cg -he"]);
+ side -> tcl2erl:ret_pack(side, TkW);
+ underline -> tcl2erl:ret_int([TkW," cg -underl"]);
+ width -> tcl2erl:ret_int([TkW," cg -wi"]);
+ wraplength -> tcl2erl:ret_int([TkW," cg -wr"]);
+ x -> tcl2erl:ret_place(x, TkW);
+ y -> tcl2erl:ret_place(y, TkW);
+ _ -> {error,{invalid_option,Option, GstkId#gstkid.objtype}}
+ end.
+
+%%-----------------------------------------------------------------------------
+%% PRIMITIVES
+%%-----------------------------------------------------------------------------
+
+fix_placement(Attr, Value, Gstkid, _TkW, DB) ->
+ Pgstkid = gstk_db:lookup_gstkid(DB, Gstkid#gstkid.parent),
+ case Pgstkid#gstkid.objtype of
+ menubar -> invalid_option;
+ _ -> {p, [" -", atom_to_list(Attr), " ", gstk:to_ascii(Value)]}
+ end.
+
+
+fix_anchor(How, Gstkid, TkW, DB) ->
+ Pgstkid = gstk_db:lookup_gstkid(DB, Gstkid#gstkid.parent),
+ case Pgstkid#gstkid.objtype of
+ menubar -> {c, ["pack ", TkW, " -an ", gstk:to_ascii(How)]};
+ _ -> {p, [" -anch ", gstk:to_ascii(How)]}
+ end.
+
+
+fix_side(Side, Gstkid, TkW, DB) ->
+ Pgstkid = gstk_db:lookup_gstkid(DB, Gstkid#gstkid.parent),
+ case Pgstkid#gstkid.objtype of
+ menubar -> {c, ["pack ", TkW, " -fill y -si ", gstk:to_ascii(Side)]};
+ _ -> none
+ end.
+
+
+%% ----- Done -----
+