diff options
Diffstat (limited to 'lib/gs/src/gstk.erl')
| -rw-r--r-- | lib/gs/src/gstk.erl | 389 |
1 files changed, 0 insertions, 389 deletions
diff --git a/lib/gs/src/gstk.erl b/lib/gs/src/gstk.erl deleted file mode 100644 index 3119245db7..0000000000 --- a/lib/gs/src/gstk.erl +++ /dev/null @@ -1,389 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1996-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% - -%% - --module(gstk). --compile([{nowarn_deprecated_function,{gs,assq,2}}, - {nowarn_deprecated_function,{gs,creation_error,2}}]). - --export([start_link/4, - stop/1, - create/2, - config/2, - read/2, - destroy/2, - pid_died/2, - event/2, - request/2, - init/1, - create_impl/2, - config_impl/3, - read_impl/3, - destroy_impl/2, - worker_init/1, - worker_do/1, - make_extern_id/2, - to_color/1, - to_ascii/1, - exec/1, - call/1]). - --include("gstk.hrl"). - -start_link(GsId,FrontendNode,Owner,Options) -> - case gs:assq(node,Options) of - false -> - Gstk = spawn_link(gstk, init,[{GsId, FrontendNode, Owner, Options}]), - receive - {ok, _PortHandler} -> - {ok, Gstk}; - {error, Reason} -> - {error, Reason} - end; - {value, Node} -> - rpc:call(Node,gen_server,start_link,[gstk, {Owner,Options},[]]) - end. - -stop(BackendServ) -> - request(BackendServ,stop). - -create(BackendServ,Args) -> - request(BackendServ,{create,Args}). - -config(BackendServ,Args) -> - request(BackendServ,{config,Args}). - -read(BackendServ,Args) -> - request(BackendServ,{read,Args}). - -destroy(BackendServ,Args) -> - request(BackendServ,{destroy,Args}). - -pid_died(BackendServ,Pid) -> - request(BackendServ,{pid_died,Pid}). - -call(Cmd) -> - %%io:format("Call:~p~n",[Cmd]), - gstk_port_handler:call(get(port_handler),Cmd). - -exec(Cmd) -> - gstk_port_handler:exec(Cmd). - -make_extern_id(IntId, DB) -> - [{_,Node}] = ets:lookup(DB,frontend_node), - {IntId,Node}. - -event(BackendServ,Event) -> - BackendServ!{event,Event}. - -%% ----------------------------------------------------------------------------- - -request(Who,Msg) -> - Who ! {self(),Msg}, - receive - {gstk_reply,R} -> R; - {'EXIT',Who,Reason} -> - self() ! {'EXIT',Who,Reason}, - {error,Reason} - end. - - --record(state,{db,frontendnode,port_handler}). - -%% ------------------------------------------------------------ -%% Initialize -%% -init({GsId,FrontendNode,Owner,Opts}) -> - put(gs_frontend,Owner), - case gstk_port_handler:start_link(self()) of - {error, Reason} -> - FrontendNode ! {error, Reason}, - exit(normal); - {ok, PortHandler} -> - FrontendNode ! {ok, PortHandler}, - put(port_handler,PortHandler), - {ok,Port} = gstk_port_handler:ping(PortHandler), - put(port,Port), - exec("wm withdraw ."), - DB = gstk_db:init(Opts), - ets:insert(DB,{frontend_node,FrontendNode}), - put(worker,spawn_link(gstk,worker_init,[0])), - Gstkid = #gstkid{id=GsId,widget="",owner=Owner,objtype=gs}, - gstk_db:insert_gs(DB,Gstkid), - gstk_font:init(), - loop(#state{db=DB,frontendnode=FrontendNode}) - end. - -loop(State) -> - receive - X -> - case (doit(X,State)) of - done -> loop(State); - stop -> bye - end - end. - -reply(To,Msg) -> - To ! {gstk_reply,Msg}, - done. - -doit({From,{config, {Id, Opts}}},#state{db=DB}) -> - reply(From,config_impl(DB,Id,Opts)); -doit({From,{create, Args}}, #state{db=DB}) -> - reply(From,create_impl(DB,Args)); -doit({From,{read,{Id,Opt}}},#state{db=DB}) -> - reply(From,read_impl(DB,Id,Opt)); -doit({From,{pid_died, Pid}}, #state{db=DB}) -> - pid_died_impl(DB, Pid), - reply(From,gstk_db:get_deleted(DB)); -doit({From,{destroy, Id}}, #state{db=DB}) -> - destroy_impl(DB, gstk_db:lookup_gstkid(DB,Id)), - reply(From,gstk_db:get_deleted(DB)); - -doit({From,dump_db},State) -> - io:format("gstk_db:~p~n",[lists:sort(ets:tab2list(State#state.db))]), - io:format("events:~p~n",[lists:sort(ets:tab2list(get(events)))]), - io:format("options:~p~n",[lists:sort(ets:tab2list(get(options)))]), - io:format("defaults:~p~n",[lists:sort(ets:tab2list(get(defaults)))]), - io:format("kids:~p~n",[lists:sort(ets:tab2list(get(kids)))]), - reply(From,State); - -doit({From,stop},_State) -> - gstk_port_handler:stop(get(port_handler)), - exit(get(worker),kill), - reply(From,stopped), - stop; - -doit({event,{Id, Etag, Args}},#state{db=DB}) -> - case gstk_db:lookup_event(DB, Id, Etag) of - {Etype, Edata} -> - Gstkid = gstk_db:lookup_gstkid(DB, Id), - apply(gstk_widgets:objmod(Gstkid),event,[DB,Gstkid,Etype,Edata,Args]); - _ -> true - end, - done. - - -%%---------------------------------------------------------------------- -%% Implementation of create,config,read,destroy -%% Comment: In the gstk process there is not concept call 'name', only -%% pure oids. Names are stripped of by 'gs' and this simplifies -%% gstk a lot. -%% Comment: For performance reasons gstk.erl ans gs.erl communicats through -%% tuples. This is unfortunate but we don't want to pack the same -%% thing too many times. -%% Pre (for all functions): GS guarantees that the object (and parent if -%% necessary) exists. -%%---------------------------------------------------------------------- - - -create_impl(DB, {Owner, {Objtype, Id, Parent, Opts}}) -> - Pgstkid = gstk_db:lookup_gstkid(DB, Parent), - GstkId=#gstkid{id=Id,owner=Owner,parent=Parent,objtype=Objtype}, - gstk_db:insert_opt(DB,Id,{data,[]}), - RealOpts=apply(gstk_widgets:objmod(Pgstkid), - mk_create_opts_for_child,[DB,GstkId,Pgstkid,Opts]), - case gstk_widgets:type2mod(Objtype) of - {error,Reason} -> {error,Reason}; - ObjMod -> - case apply(ObjMod, create, [DB, GstkId, RealOpts]) of - {bad_result, BR} -> - gstk_db:delete_gstkid(DB,GstkId), - gs:creation_error(GstkId,{bad_result, BR}); - Ngstkid when is_record(Ngstkid,gstkid) -> - gstk_db:insert_widget(DB, Ngstkid), - ok; - {error,Reason} -> {error,Reason}; - ok -> ok - end - end. - -config_impl(DB,Id,Opts) -> - Gstkid = gstk_db:lookup_gstkid(DB, Id), - case apply(gstk_widgets:objmod(Gstkid), config, [DB, Gstkid, Opts]) of - ok -> ok; - {bad_result,R} -> {error,R}; - {error,Reason} -> {error,Reason}; - Q -> {error,Q} - end. - - -read_impl(DB,Id,Opt) -> - Gstkid = gstk_db:lookup_gstkid(DB, Id), - case apply(gstk_widgets:objmod(Gstkid), read, [DB, Gstkid, Opt]) of - {bad_result,R} -> {error,R}; - {error,R} -> {error,R}; - Res -> Res - end. - - - -%%----------------------------------------------------------------------------- -%% DESTROYING A WIDGET -%%----------------------------------------------------------------------------- - -destroy_impl(DB, Gstkid) -> - worker_do({delay_is,50}), - Widget = delete_only_this_widget(DB,Gstkid), - destroy_widgets([Widget], DB), - worker_do({delay_is,5}), - true. - -delete_only_this_widget(DB,Gstkid) -> - #gstkid{id=ID,objtype=OT,parent=P} = Gstkid, - delete_widgets(gstk_db:lookup_kids(DB, ID), DB), - Widget = apply(gstk_widgets:type2mod(OT), delete, [DB, Gstkid]), - gstk_db:delete_kid(DB, P, ID), - Widget. - - -pid_died_impl(DB, Pid) -> - case lists:sort(gstk_db:lookup_ids(DB, Pid)) of - [ID | IDs] -> - Gstkid = gstk_db:lookup_gstkid(DB, ID), - destroy_impl(DB, Gstkid), - Tops = get_tops(IDs, DB), - destroy_widgets(Tops, DB); - _ -> - true - end. - - -get_tops([ID | IDs], DB) -> - case gstk_db:lookup_gstkid(DB, ID) of - undefined -> - get_tops(IDs, DB); - Gstkid -> - Parent = Gstkid#gstkid.parent, - case lists:member(Parent, IDs) of - true -> - delete_widgets([ID], DB), - get_tops(IDs, DB); - false -> - Widget = delete_only_this_widget(DB,Gstkid), - [Widget | get_tops(IDs, DB)] - end - end; -get_tops([], _DB) -> []. - - -delete_widgets([ID | Rest], DB) -> - delete_widgets(gstk_db:lookup_kids(DB, ID), DB), - case gstk_db:lookup_gstkid(DB, ID) of - undefined -> - delete_widgets(Rest, DB); - Gstkid -> - apply(gstk_widgets:objmod(Gstkid), delete, [DB, Gstkid]), - delete_widgets(Rest, DB) - end; -delete_widgets([], _) -> true. - - - -destroy_widgets(Widgets, DB) -> - case destroy_wids(Widgets, DB) of - [] -> true; - Destroys -> exec(["destroy ", Destroys]) - end. - - -destroy_wids([{Parent, ID, Objmod, Args} | Rest], DB) -> - gstk_db:delete_kid(DB, Parent, ID), - apply(Objmod, destroy, [DB | Args]), - destroy_wids(Rest, DB); - -destroy_wids([W | Rest], DB) -> - [W, " "| destroy_wids(Rest, DB)]; - -destroy_wids([], _DB) -> []. - - -%% ----- The Color Model ----- - -to_color({R,G,B}) -> - [$#,dec2hex(2,R),dec2hex(2,G),dec2hex(2,B)]; -to_color(Color) when is_atom(Color) -> atom_to_list(Color). - -%% ------------------------------------------------------------ -%% Decimal to Hex converter -%% M is number of digits we want -%% N is the decimal to be converted - -dec2hex(M,N) -> dec2hex(M,N,[]). - -dec2hex(0,_N,Ack) -> Ack; -dec2hex(M,N,Ack) -> dec2hex(M-1,N bsr 4,[d2h(N band 15)|Ack]). - -d2h(N) when N<10 -> N+$0; -d2h(N) -> N+$a-10. - - -%% ----- Value to String ----- - -to_ascii(V) when is_list(V) -> [$",to_ascii(V,[],[]),$"]; %% it's a string -to_ascii(V) when is_integer(V) -> integer_to_list(V); -to_ascii(V) when is_float(V) -> float_to_list(V); -to_ascii(V) when is_atom(V) -> to_ascii( atom_to_list(V)); -to_ascii(V) when is_tuple(V) -> to_ascii(lists:flatten(io_lib:format("~w",[V]))); -to_ascii(V) when is_pid(V) -> pid_to_list(V). - - % FIXME: Currently we accept newlines in strings and handle this at - % the Tcl side. Is this the best way or should we translate to "\n" - % here? -to_ascii([$[|R], Y, X) -> to_ascii(R, Y, [$[, $\\ | X]); - to_ascii([$]|R], Y, X) -> to_ascii(R, Y, [$], $\\ | X]); -to_ascii([${|R], Y, X) -> to_ascii(R, Y, [${, $\\ | X]); - to_ascii([$}|R], Y, X) -> to_ascii(R, Y, [$}, $\\ | X]); -to_ascii([$"|R], Y, X) -> to_ascii(R, Y, [$", $\\ | X]); -to_ascii([$$|R], Y, X) -> to_ascii(R, Y, [$$, $\\ | X]); -to_ascii([$\\|R], Y, X) -> to_ascii(R, Y, [$\\, $\\ | X]); -to_ascii([C|R], Y, X) when is_list(C) -> to_ascii(C, [R|Y], X); -to_ascii([C|R], Y, X) -> to_ascii(R, Y, [C|X]); -to_ascii([], [Y1|Y], X) -> to_ascii(Y1, Y, X); -to_ascii([], [], X) -> lists:reverse(X). - -worker_do(Msg) -> - get(worker) ! Msg. - -worker_init(Delay) -> - receive - {delay_is,D} -> - worker_init(D); - {match_delete,DBExprs} -> - worker_match(DBExprs), - if Delay > 0 -> - receive - {delay_is,D} -> - worker_init(D) - after Delay -> - worker_init(Delay) - end; - true -> - worker_init(Delay) - end - end. - -worker_match([{DB,[Expr|Exprs]}|DbExprs]) -> - ets:match_delete(DB,Expr), - worker_match([{DB,Exprs}|DbExprs]); -worker_match([{_DB,[]}|DbExprs]) -> - worker_match(DbExprs); -worker_match([]) -> done. |