gstk_generic.erl

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

%% ``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$
%%

-module(gstk_generic).

-export([out_opts/8,
	 read_option/5,
	 mk_tkw_child/2,
	 merge_default_options/3,
	 merge_default_options/2,
	 opts_for_child/3,
	 mk_cmd_and_exec/4,
	 mk_cmd_and_exec/5,
	 mk_cmd_and_exec/6,
	 mk_cmd_and_exec/7,
	 make_command/5,
	 make_command/6,
	 make_command/7,
	 read_option/4,
	 handle_external_opt_call/9,
	 handle_external_read/1,
	 gen_anchor/9,
	 gen_anchor/5,
	 gen_height/9,
	 gen_height/5,
	 gen_width/9,
	 gen_width/5,
	 gen_x/9,
	 gen_x/5,
	 gen_y/9,
	 gen_y/5,
	 gen_raise/9,
	 gen_raise/5,
	 gen_lower/9,
	 gen_lower/5,
	 gen_enable/9,
	 gen_enable/5,
	 gen_align/9,
	 gen_align/5,
	 gen_justify/9,
	 gen_justify/5,
	 gen_padx/9,
	 gen_padx/5,
	 gen_pady/9,
	 gen_pady/5,
	 gen_font/9,
	 gen_font/5,
	 gen_label/9,
	 gen_label/5,
	 gen_activebg/9,
	 gen_activebg/5,
	 gen_activefg/9,
	 gen_activefg/5,
	 gen_default/9,
	 gen_relief/9,
	 gen_relief/5,
	 gen_bw/9,
	 gen_bw/5,
	 gen_font_wh/5,
	 gen_choose_font/5,
	 gen_data/9,
	 gen_data/5,
	 gen_pack_x/9,
	 gen_pack_x/5,
	 gen_pack_y/9,
	 gen_pack_y/5,
	 gen_pack_xy/9,
	 gen_flush/9,
	 gen_flush/5,
	 gen_keep_opt/9,
	 gen_children/5,
	 make_extern_id/2,
	 gen_id/5,
	 gen_parent/5,
	 gen_type/5,
	 gen_beep/9,
	 gen_setfocus/9,
	 gen_setfocus/5,
	 gen_buttonpress/9,
	 gen_buttonpress/5,
	 gen_buttonrelease/9,
	 gen_buttonrelease/5,
	 gen_configure/9,
	 gen_configure/5,
	 gen_destroy/9,
	 gen_destroy/5,
	 gen_enter/9,
	 gen_enter/5,
	 gen_focus_ev/9,
	 gen_focus_ev/5,
	 gen_keypress/9,
	 gen_keypress/5,
	 gen_keyrelease/9,
	 gen_keyrelease/5,
	 gen_leave/9,
	 gen_leave/5,
	 gen_motion/9,
	 gen_motion/5,
	 gen_highlightbw/9,
	 gen_highlightbw/5,
	 gen_highlightbg/9,
	 gen_highlightbg/5,
	 gen_highlightfg/9,
	 gen_highlightfg/5,
	 gen_selectbw/9,
	 gen_selectbw/5,
	 gen_selectfg/9,
	 gen_selectfg/5,
	 gen_selectbg/9,
	 gen_selectbg/5,
	 gen_fg/9,
	 gen_fg/5,
	 gen_bg/9,
	 gen_bg/5,
	 gen_so_activebg/9,
	 gen_so_activebg/5,
	 gen_so_bc/9,
	 gen_so_bc/5,
	 gen_so_scrollfg/9,
	 gen_so_scrollfg/5,
	 gen_so_scrollbg/9,
	 gen_so_scrollbg/5,
	 obj/1,
	 gen_so_bg/9,
	 gen_so_bg/5,
	 gen_so_selectbw/9,
	 gen_so_selectbw/5,
	 gen_so_selectfg/9,
	 gen_so_selectfg/5,
	 gen_so_selectbg/9,
	 gen_so_selectbg/5,
	 gen_so_scrolls/9,
	 gen_so_hscroll/5,
	 gen_so_vscroll/5,
	 cursors/0,
	 gen_cursor/9,
	 gen_cursor/5,
	 gen_citem_coords/9,
	 gen_citem_coords/5,
	 gen_citem_fill/9,
	 gen_citem_fill/5,
	 gen_citem_lower/9,
	 gen_citem_raise/9,
	 gen_citem_move/9,
	 move_coords/3,
	 add_to_coords/3,
	 gen_citem_setfocus/9,
	 gen_citem_setfocus/5,
	 gen_citem_buttonpress/9,
	 gen_citem_buttonrelease/9,
	 gen_citem_enter/9,
	 gen_citem_keypress/9,
	 gen_citem_keyrelease/9,
	 gen_citem_leave/9,
	 gen_citem_motion/9,
	 scrolls_vh/3,
	 parse_scrolls/1,
	 parse_scrolls/2,
	 parse_scrolls/4,
	 bind/5,
	 bind/6,
	 ebind/6,
	 eunbind/6,
	 item_bind/6,
	 item_ebind/6,
	 item_eunbind/5,
	 event/5,
	 read_option/3,
	 make_command/4,
	 mk_create_opts_for_child/4]).

-include("gstk.hrl").
-include("gstk_generic.hrl").

%%----------------------------------------------------------------------
%% Returns: a new unique TkWidget (string())
%%----------------------------------------------------------------------
mk_tkw_child(DB,#gstkid{parent=P,objtype=Ot}) ->
    Pgstkid = gstk_db:lookup_gstkid(DB, P),
    PW = Pgstkid#gstkid.widget,
    Oref = gstk_db:counter(DB, Ot),
    PF = gstk_widgets:suffix(Ot),
    _TkW = lists:concat([PW, PF, Oref]).

%%----------------------------------------------------------------------
%% Purpose: Merges options. Opts have higher priority than BuiltIn
%%          (and ParentOpts have higher than BuiltIn)
%% Returns: A list of new options.
%%----------------------------------------------------------------------
merge_default_options(ParOpts, BuildInOpts, Opts) ->
    %% parents options first
    Tmp=merge_default_options(ParOpts, lists:sort(Opts)), 
    merge_default_options(BuildInOpts,Tmp).

merge_default_options([Def|Ds],[Opt|Os]) 
  when element(1,Def) < element(1,Opt) ->
    [Def | merge_default_options(Ds,[Opt|Os])];

merge_default_options([Def|Ds],[Opt|Os]) 
  when element(1,Def) > element(1,Opt) ->
    [Opt | merge_default_options([Def|Ds],Os)];

merge_default_options([Def|Ds],[Opt|Os]) 
  when element(1,Def) == element(1,Opt) ->
    [Opt | merge_default_options(Ds,Os)];

merge_default_options(Defs,[Opt|Os]) ->
    [Opt | merge_default_options(Defs,Os)];

merge_default_options([],Opts) -> Opts;
merge_default_options(Defs,[]) -> Defs.

opts_for_child(DB,Childtype,ParId) ->
    case gs_widgets:container(Childtype) of
	true -> 
	    gstk_db:default_container_opts(DB,ParId,Childtype);
	false ->
	    gstk_db:default_opts(DB,ParId,Childtype)
    end.

mk_create_opts_for_child(DB,#gstkid{objtype=ChildType}, Pgstkid, Opts) ->
    merge_default_options(
      opts_for_child(DB,ChildType,Pgstkid#gstkid.id),
      gs_widgets:default_options(ChildType),
      Opts).

mk_cmd_and_exec(Opts,Gstkid,Scmd,DB) ->
    TkW = Gstkid#gstkid.widget,
    mk_cmd_and_exec(Opts,Gstkid,TkW,Scmd,[";place ", TkW],DB,dummy).
mk_cmd_and_exec(Opts,Gstkid,Scmd,Pcmd,DB) ->
    mk_cmd_and_exec(Opts,Gstkid,Gstkid#gstkid.widget,Scmd,Pcmd,DB,dummy).
mk_cmd_and_exec(Options, Gstkid, TkW, SCmd, PCmd, DB) ->
    mk_cmd_and_exec(Options, Gstkid, TkW, SCmd, PCmd, DB,dummy).
mk_cmd_and_exec(Options, Gstkid, TkW, SCmd, PCmd, DB,ExtraArg) ->
    case gstk_generic:make_command(Options,Gstkid,TkW,SCmd,PCmd,DB,ExtraArg) of
	{error,Reason} -> {error,Reason};
	Cmd when is_list(Cmd) ->
	    gstk:exec(Cmd)
    end.

%%----------------------------------------------------------------------
%% SCmd: SimplePreCommand - prepended to simple (s) options
%% PCmd: PlacePreCommand - prepended to placer (p) options
%%       (should start with ';' (at least if preceeded with simple cmds))
%% Comment: If some function changes the gstkid,
%%          it's responsible for storing it in the DB.
%%----------------------------------------------------------------------
make_command(Opts,Gstkid,Scmd,DB) ->
    TkW = Gstkid#gstkid.widget,
    make_command(Opts,Gstkid,TkW,Scmd,[";place ", TkW],DB,dummy).
make_command(Opts,Gstkid,Scmd,Pcmd,DB) ->
    make_command(Opts,Gstkid,Gstkid#gstkid.widget,Scmd,Pcmd,DB,dummy).
make_command(Options, Gstkid, TkW, SCmd, PCmd, DB) ->
    make_command(Options, Gstkid, TkW, SCmd, PCmd, DB,dummy).
make_command(Options, Gstkid, TkW, SCmd, PCmd, DB,ExtraArg) ->
    case out_opts(Options, Gstkid, TkW, DB, ExtraArg, [], [], []) of
	{[], [], []} -> [];
	{Si, [], []} -> [SCmd, Si,$;];
	{[], Pl, []} -> [PCmd, Pl,$;];
	{[], [], Co} -> [$;,Co];
	{[], Pl, Co} -> [PCmd, Pl, $;, Co];
	{Si, [], Co} -> [SCmd, Si, $;, Co];
	{Si, Pl, []} -> [SCmd, Si, PCmd, Pl, $;];
	{Si, Pl, Co} -> [SCmd, Si, PCmd, Pl, $;, Co];
	{error,Reason} -> {error,Reason}
    end.

read_option(DB,Gstkid,Opt) ->
    read_option(DB,Gstkid,Gstkid#gstkid.widget,Opt,dummy).
read_option(DB,Gstkid,Opt,ExtraArg) ->
    read_option(DB,Gstkid,Gstkid#gstkid.widget,Opt,ExtraArg).

%%----------------------------------------------------------------------
%% Args: Args is [Gstkid, TkW, DB, ExtraArg]
%% Comment: An optimization:don't reconstruct the arg list for apply each time.
%%          This is the option-engine so we should optimize.
%%----------------------------------------------------------------------
handle_external_opt_call([Opt|Options],Gstkid,TkW,DB,ExtraArg,ExtRes,S,P,C) ->
    case ExtRes of
	{s, Cmd} ->
	    out_opts(Options,Gstkid, TkW,DB, ExtraArg, [Cmd|S], P, C);
	{p, Cmd} ->
	    out_opts(Options, Gstkid,TkW,DB, ExtraArg, S, [Cmd|P], C);
	{c, Cmd} ->
	    out_opts(Options, Gstkid,TkW,DB, ExtraArg,S, P, [Cmd,$;|C]);
	none ->
	    out_opts(Options, Gstkid,TkW,DB,ExtraArg, S, P, C);
						%	{s, NGstkid, Cmd} ->
						%	    out_opts(Options,NGstkid,TkW,DB,ExtraArg, [Cmd|S], P, C);
						%	{p, NGstkid, Cmd} ->
						%	    out_opts(Options,NGstkid,TkW,DB,ExtraArg, S, [Cmd|P], C);
	{c, NGstkid, Cmd} ->
	    out_opts(Options,NGstkid,TkW,DB, ExtraArg,S,P,[Cmd,$;|C]);
	{none, NGstkid} ->
	    out_opts(Options,NGstkid,TkW,DB, ExtraArg, S, P, C);
	{sp,{Scmd,Pcmd}} ->
	    out_opts(Options,Gstkid,TkW,DB,ExtraArg,[Scmd|S],[Pcmd|P],C);
	invalid_option ->
	    {error,{invalid_option,Gstkid#gstkid.objtype,Opt}};
	break -> % a hack. it is possible to abort generic option handling at
	    %% any time (without even inserting the gstkid inte to DB (for
	    %% performance reasons)).
	    {S, P, C}
    end.

handle_external_read(Res) ->
    case Res of 
	{bad_result,{Objtype,Reason,Option}} ->
	    {error,{Objtype,Reason,Option}};
	_ -> ok
    end,
    Res.

%%----------------------------------------------------------------------
%% Generic options
%%----------------------------------------------------------------------

gen_anchor(How,Opts,Gstkid,TkW,DB,ExtraArg,S,P,C) ->
    out_opts(Opts,Gstkid,TkW,DB,ExtraArg,S,[" -anc ", gstk:to_ascii(How)|P],C).
gen_anchor(_Opt,_Gstkid,TkW,_DB,_ExtraArg) ->
    tcl2erl:ret_place(anchor, TkW).

gen_height(Height,Opts,Gstkid,TkW,DB,ExtraArg,S,P,C) ->
    gstk_db:insert_opt(DB,Gstkid,{height,Height}),
    out_opts(Opts,Gstkid,TkW,DB,ExtraArg,S,
	     [" -he ", gstk:to_ascii(Height)|P],C).
gen_height(_Opt,Gstkid,_TkW,DB,_ExtraArg) ->
    gstk_db:opt(DB,Gstkid,height).

gen_width(Width,Opts,Gstkid,TkW,DB,ExtraArg,S,P,C) ->
    gstk_db:insert_opt(DB,Gstkid,{width,Width}),
    out_opts(Opts,Gstkid,TkW,DB,ExtraArg,S,
	     [" -wi ", gstk:to_ascii(Width)|P],C).
gen_width(_Opt,Gstkid,_TkW,DB,_ExtraArg) ->
    gstk_db:opt(DB,Gstkid,width).

gen_x(X,Opts,Gstkid,TkW,DB,ExtraArg,S,P,C) ->
    gstk_db:insert_opt(DB,Gstkid,{x,X}),
    out_opts(Opts,Gstkid,TkW,DB,ExtraArg,S,
	     [" -x ", gstk:to_ascii(X)|P],C).
gen_x(_Opt,Gstkid,_TkW,DB,_ExtraArg) ->
    gstk_db:opt(DB,Gstkid,x).

gen_y(Y,Opts,Gstkid,TkW,DB,ExtraArg,S,P,C) ->
    gstk_db:insert_opt(DB,Gstkid,{y,Y}),
    out_opts(Opts,Gstkid,TkW,DB,ExtraArg,S,
	     [" -y ", gstk:to_ascii(Y)|P],C).