gstk_menuitem.erl

来自「OTP是开放电信平台的简称」· ERL 代码 · 共 580 行 · 第 1/2 页

%% ``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 via the world wide web 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.
%% 
%% The Initial Developer of the Original Code is Ericsson Utvecklings AB.
%% Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings
%% AB. All Rights Reserved.''
%% 
%%     $Id$
%%
%% ------------------------------------------------------------
%% Basic Menuitem Type
%% ------------------------------------------------------------

-module(gstk_menuitem).

%%-----------------------------------------------------------------------------
%% 			    MENUITEM OPTIONS
%%
%%  Attribute:
%%	accelerator		String
%%	activebg		Color
%%	activefg		Color
%%	bg			Color
%%	color			Color	(same as fg)
%%	data			Data
%%	fg			Color
%%      font                    Font
%%	group			Atom	(valid only for radio type)
%%	index			Int
%%	itemtype		normal|check|radio|separator|cascade (|tearoff)
%%	label			{text, String} | {image, BitmapFile}
%%	menu			Menu	(valid only for cascade type)
%%	selectbg		Color
%%	underline		Int
%%	value			Atom
%%
%%  Commands:
%%	activate
%%	enable			Bool
%%	invoke
%%
%%  Events:
%%	click			[Bool | {Bool, Data}]
%%
%%  Read Options:
%%	children
%%	id
%%	parent
%%	type
%%
%%  Not Implemented:
%%	font			Font
%%	read menu on cascades
%%

-export([create/3, config/3, read/3, delete/2, destroy/3, event/5,
	option/5,read_option/5,mk_create_opts_for_child/4]).
-include("gstk.hrl").

%%-----------------------------------------------------------------------------
%%			MANDATORY INTERFACE FUNCTIONS
%%-----------------------------------------------------------------------------
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Function   	: create/3
%% Purpose    	: Create a widget of the type defined in this module.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
create(DB, GstkId, Opts) ->
    #gstkid{parent=Parent,owner=Owner,id=Id}=GstkId,
    Pgstkid = gstk_db:lookup_gstkid(DB, Parent),
    TkMenu = Pgstkid#gstkid.widget,
    Widget = "",
    {Index, Type, Options} = parse_opts(Opts, TkMenu),
    PreCmd = [TkMenu, " insert ", gstk:to_ascii(Index)],
    InsertArgs = [DB, Parent,Id, Index],
    case Type of
	check ->
	    {G, GID, NOpts} = fix_group(Options, DB, Owner),
	    TypeCmd = " ch",
	    Ngstkid=GstkId#gstkid{widget=Widget,widget_data={Type, G, GID}},
	    GenArgs = [NOpts,Ngstkid,TkMenu,"","",DB,{Type,Index}],
	    CallArgs = [PreCmd,TypeCmd],
	    mk_it(GenArgs,CallArgs,InsertArgs,Ngstkid);
	radio ->
	    {G, GID, V, NOpts} = fix_group_and_value(Options, DB, Owner),
	    Ngstkid=GstkId#gstkid{widget=Widget, widget_data={Type,G,GID,V}},
	    TypeCmd = " ra",
	    GenArgs = [NOpts,Ngstkid,TkMenu,"", "",DB,{Type,Index}],
	    CallArgs = [PreCmd,TypeCmd],
	    mk_it(GenArgs,CallArgs,InsertArgs,Ngstkid);
	_ ->
	    Ngstkid=GstkId#gstkid{widget=Widget, widget_data=Type},
	    TypeCmd = case Type of
			  normal    -> " co";
			  separator -> " se";
			  cascade   -> " ca"
		      end,
	    GenArgs = [Options,Ngstkid,TkMenu,"","",DB,{Type,Index}],
	    CallArgs = [PreCmd,TypeCmd],
	    mk_it(GenArgs,CallArgs,InsertArgs,Ngstkid)
    end.

mk_it(GenArgs,CallArgs,InsertArgs,Ngstkid) ->
    case apply(gstk_generic,make_command,GenArgs) of
	{error,Reason} -> {error,Reason};
	Cmd when is_list(Cmd) ->
	    case apply(gstk,call,[[CallArgs|Cmd]]) of
		{result,_} ->
		    apply(gstk_menu,insert_menuitem,InsertArgs),
		    Ngstkid;
		Bad_Result -> {error,Bad_Result}
	    end
    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
%%		  Options - A list of options for configuring the widget
%%
%% Return 	: [true | {bad_result, Reason}]
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

% FIXME: Could we really trust Index? If we create a menu and put one
% entry in the middle of the meny, don't the entrys after that one
% renumber?

config(DB, Gstkid, Options) ->
    Parent = Gstkid#gstkid.parent,
    Pgstkid = gstk_db:lookup_gstkid(DB, Parent),
    TkMenu = Pgstkid#gstkid.widget,
    case Gstkid#gstkid.widget_data of
	{Type, _, _, _} ->
	    Owner = Gstkid#gstkid.owner,
	    {NOpts, NGstkid} = fix_group_and_value(Options, DB, Owner, Gstkid),
	    Index = gstk_menu:lookup_menuitem_pos(DB, Pgstkid, NGstkid#gstkid.id),
	    PreCmd = [TkMenu, " entryco ", gstk:to_ascii(Index)],
	    gstk_generic:mk_cmd_and_exec(NOpts,NGstkid,TkMenu,PreCmd,"",DB,
					{Type,Index});
	{Type, _, _} ->
	    Owner = Gstkid#gstkid.owner,
	    {NOpts, NGstkid} = fix_group(Options, DB, Owner, Gstkid),
	    Index = gstk_menu:lookup_menuitem_pos(DB, Pgstkid, NGstkid#gstkid.id),
	    PreCmd = [TkMenu, " entryco ", gstk:to_ascii(Index)],
	    gstk_generic:mk_cmd_and_exec(NOpts,NGstkid,TkMenu,PreCmd,"",DB,
					{Type,Index});
	Type ->
	    Index = gstk_menu:lookup_menuitem_pos(DB, Pgstkid, Gstkid#gstkid.id),
	    PreCmd = [TkMenu, " entryco ", gstk:to_ascii(Index)],
	    gstk_generic:mk_cmd_and_exec(Options,Gstkid,TkMenu,PreCmd,"",
					DB, {Type,Index})
    end.

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% 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) ->
    Parent = Gstkid#gstkid.parent,
    Id = Gstkid#gstkid.id,
    gstk_db:delete_widget(DB, Gstkid),
    case Gstkid#gstkid.widget_data of
	{radio, _, Gid, _} -> gstk_db:delete_bgrp(DB, Gid);
	{check, _, Gid}    -> gstk_db:delete_bgrp(DB, Gid);
	_Other              -> true
    end,
   {Parent, Id, gstk_menuitem, [Id, Parent]}.

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Function   	: destroy/3
%% Purpose    	: Destroy a widget
%% Args        	: Menu    - The menu tk widget
%%		  Item    - The index of the menuitem to destroy
%% Return 	: [true | {bad_result, Reason}]
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
destroy(DB, Id, Parent) ->
    Pgstkid = gstk_db:lookup_gstkid(DB, Parent),
    PW = Pgstkid#gstkid.widget,    
    Idx = gstk_menu:lookup_menuitem_pos(DB, Pgstkid, Id),
    gstk_menu:delete_menuitem(DB, Parent, Id),
    gstk:exec([PW, " delete ", gstk:to_ascii(Idx)]).


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Function   	: event/5
%% Purpose    	: Construct the event and send it to the owner of the widget
%% Args        	: 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 Gstkid#gstkid.widget_data of
	    {radio, G, _GID, V} ->
		[_Grp, Text, Idx | Args1] = Args,
		[Text, Idx, G, V | Args1];
	    {check, G, _Gid} ->
		[Bool, Text, Idx | Args1] = Args,
		RBool = case Bool of
			    0 -> false;
			    1 -> true
			end,
		[Text, Idx, G, RBool | Args1];
	    _Other2 ->
		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
%%		  TkW     - The  tk-widget
%% Return 	: A tuple {OptionType, OptionCmd}
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
option({click,true}, _Gstkid, _TkW, _DB, {separator,_Index}) ->
    none;  % workaround to be able to have {click,true} as default.
option(_Option, _Gstkid, _TkW, _DB, {separator,_Index}) ->
    invalid_option;

option({menu,{Menu,_RestOfExternalId}}, _Gstkid, _TkW, DB, {cascade,_Index}) ->
    Mgstkid = gstk_db:lookup_gstkid(DB, Menu),
    MenuW = Mgstkid#gstkid.widget,
    {s, [" -menu ", MenuW]};

option({select,false}, _Gstkid, TkW, _DB, {check,Index}) ->
    {c, ["set x [", TkW, " entrycg ", gstk:to_ascii(Index),
	 " -var];global $x;set $x 0"]};
option({select,true}, _Gstkid, TkW, _DB, {check,Index}) ->
    {c, ["set x [", TkW, " entrycg ", gstk:to_ascii(Index),
	 " -var];global $x;set $x 1"]};

option({value,Val}, _Gstkid, _TkW, _DB, {radio,_Index}) ->
    {s, [" -val ", gstk:to_ascii(Val)]};
option({select,false}, _Gstkid, TkW, _DB, {radio,Index}) ->
    {c, ["set x [", TkW, " entrycg ", gstk:to_ascii(Index),
	 " -var];global $x;set $x {}"]};
option({select,true}, _Gstkid, TkW, _DB, {radio,Index}) ->
    {c, ["set x [", TkW, " entrycg ", gstk:to_ascii(Index),
	 " -var]; set y [", TkW, " entrycg ", gstk:to_ascii(Index),
	 " -val]; global $x; set $x $y"]};

option(Option, Gstkid, TkW, DB, {Kind,Index}) ->
    case Option of
	activate  -> {c, [TkW, " act ", gstk:to_ascii(Index)]};
	invoke    -> {c, [TkW, " inv ", gstk:to_ascii(Index)]};
	{accelerator,   Acc} -> {s, [" -acc ", gstk:to_ascii(Acc)]};
	{click,          On} -> cbind(On, Gstkid, TkW, Index, Kind, DB);
	{font, Font} when is_tuple(Font) ->
	    gstk_db:insert_opt(DB,Gstkid,Option),
	    {s, [" -font ", gstk_font:choose_ascii(DB,Font)]};
	{label, {image,Img}} -> {s, [" -bitm @", Img, " -lab {}"]};
	% FIXME: insert -command here.....
	% FIXME: how to get value from image entry???
	{label, {text,Text}} -> {s, [" -lab ",gstk:to_ascii(Text)," -bitm {}"]};