aboutsummaryrefslogtreecommitdiffstats
path: root/lib/gs/src/gstk_db.erl
diff options
context:
space:
mode:
Diffstat (limited to 'lib/gs/src/gstk_db.erl')
-rw-r--r--lib/gs/src/gstk_db.erl412
1 files changed, 412 insertions, 0 deletions
diff --git a/lib/gs/src/gstk_db.erl b/lib/gs/src/gstk_db.erl
new file mode 100644
index 0000000000..849784574f
--- /dev/null
+++ b/lib/gs/src/gstk_db.erl
@@ -0,0 +1,412 @@
+%%
+%% %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%
+%%
+
+%%
+%% ------------------------------------------------------------
+%%
+%% Database interface for `gstk'.
+%%
+%% ------------------------------------------------------------
+
+-module(gstk_db).
+
+-export([init/1,
+ insert/3,
+ lookup/2,
+ lookup_event/3,
+ insert_bgrp/2,
+ delete_bgrp/2,
+ insert_gs/2,
+ insert_widget/2,
+ delete_kid/3,
+ insert_opts/3,
+ lookup_def/3,
+ opt_or_not/3,
+ lookup_gstkid/3,
+ lookup_ids/2,
+ lookup_item/3,
+ delete_widget/2,
+ delete_gstkid/2,
+ get_deleted/1,
+ delete_event/3,
+ insert_event/4,
+ update_widget/2,
+ is_inserted/3,
+ lookup_kids/2,
+ insert_def/3,
+ opt/4,
+ opt/3,
+ insert_opt/3,
+ default_container_opts/3,
+ default_opts/3,
+ counter/2,
+ lookup_gstkid/2]).
+
+-include("gstk.hrl").
+
+
+%% ------------------------------------------------------------
+%% INITIALIZATION
+%% ------------------------------------------------------------
+
+init(_Opts) ->
+ put(events,ets:new(gstk_db, [public, set])),
+ put(kids,ets:new(gstk_db, [public, bag])),
+ put(defaults,ets:new(gstk_db, [public, bag])),
+ put(deleted,ets:new(gstk_db, [public, bag])),
+ put(options,ets:new(gstk_db, [public, set])),
+ ets:new(gstk_db, [public, set]).
+
+%% -----------------------------------------------------------------
+%% PRIMITIVE DB INTERFACE
+%% -----------------------------------------------------------------
+
+insert(DB, Key, Value) ->
+ ets:insert(DB, {Key, Value}).
+
+
+lookup(DB, Key) ->
+ Result =
+ case ets:lookup(DB, Key) of
+ [{Key, Value}] -> Value;
+ _ -> undefined
+ end,
+ Result.
+
+
+delete(DB, Key) ->
+ ets:delete(DB, Key).
+
+
+
+%% -----------------------------------------------------------------
+%% NOT SO PRIMITIVE DB INTERFACE
+%% -----------------------------------------------------------------
+
+%% -----------------------------------------------------------------
+%% HANDLE EVENTS
+%% -----------------------------------------------------------------
+insert_event(DB, Gstkid, Etype, Edata) ->
+ ID = Gstkid#gstkid.id,
+ Rdata =
+ case Edata of
+ [] -> opt(DB,ID,data);
+ _Other1 -> Edata
+ end,
+ Events = lookup_events(DB, ID),
+ case lists:keysearch(Etype, 2, Events) of
+ {value, {Etag, _, _}} ->
+ NewEvents =
+ lists:keyreplace(Etype, 2, Events, {Etag, Etype, Rdata}),
+ ets:insert(get(events), {{events, ID}, NewEvents}),
+ [$#, gstk:to_ascii(ID), " ", Etag];
+ _Other2 ->
+ Etag = etag(Etype),
+ NewEvents = [{Etag, Etype, Rdata} | Events],
+ ets:insert(get(events), {{events, ID}, NewEvents}),
+ [$#, gstk:to_ascii(ID), " ", Etag]
+ end.
+
+etag(Etype) ->
+ case Etype of
+ click -> "c";
+ doubleclick -> "dc";
+ configure -> "co";
+ enter -> "e";
+ leave -> "l";
+ motion -> "m";
+ buttonpress -> "bp";
+ buttonrelease -> "br";
+ focus -> "f";
+ destroy -> "d";
+ keypress -> "kp";
+ keyrelease -> "kr"
+ end.
+
+lookup_events(_DB, ID) ->
+ case lookup(get(events), {events, ID}) of
+ undefined -> [];
+ Events -> Events
+ end.
+
+lookup_event(DB, ID, Etag) ->
+ case lists:keysearch(Etag, 1, lookup_events(DB, ID)) of
+ {value, {Etag, Etype, Edata}} ->
+ {Etype, Edata};
+ _Other ->
+ nonexisting_event
+ end.
+
+delete_event(DB, Gstkid, Etype) ->
+ ID = Gstkid#gstkid.id,
+ NewEvents = lists:keydelete(Etype, 2, lookup_events(DB, ID)),
+ ets:insert(get(events), {{events, ID}, NewEvents}).
+
+%% -----------------------------------------------------------------
+%% HANDLE BUTTON GROUPS
+%% -----------------------------------------------------------------
+insert_bgrp(DB, Key) ->
+ case ets:lookup(DB, Key) of
+ [] ->
+ {_Bgrp, RG, _Owner} = Key,
+ insert(DB, Key, {0, RG}),
+ RG;
+ [{_, {Counter, RG}}] ->
+ insert(DB, Key, {Counter+1, RG}),
+ RG
+ end.
+
+
+delete_bgrp(DB, Key) ->
+ case ets:lookup(DB, Key) of
+ [] ->
+ true;
+ [{_, {0, _RG}}] ->
+ delete(DB, Key),
+ true;
+ [{_, {Counter, RG}}] ->
+ insert(DB, Key, {Counter-1, RG}),
+ true
+ end.
+
+
+%% -----------------------------------------------------------------
+%% insert things
+
+update_widget(DB, Gstkid) ->
+ ID = Gstkid#gstkid.id,
+ insert(DB, ID, Gstkid),
+ Gstkid.
+
+insert_gs(DB,Gstkid) ->
+ update_widget(DB,Gstkid).
+
+insert_widget(DB, Gstkid) ->
+ ID = Gstkid#gstkid.id,
+ insert_kid(DB, Gstkid#gstkid.parent, ID),
+ insert(DB, ID, Gstkid),
+ Gstkid.
+
+insert_kid(_DB, Parent, Kid) ->
+ ets:insert(get(kids), {{kids, Parent},Kid}).
+
+delete_kid(_DB, Parent, Kid) ->
+ ets:match_delete(get(kids), {{kids, Parent},Kid}).
+
+lookup_kids(_DB, Parent) ->
+ ril(ets:match(get(kids), {{kids, Parent},'$1'})).
+
+%%----------------------------------------------------------------------
+%% Options are stored as {{Id,Opt},Val}
+%%----------------------------------------------------------------------
+insert_opt(_DB,Id,{default,ObjType,Opt}) ->
+ insert_def(Id,ObjType,Opt);
+insert_opt(_DB,#gstkid{id=Id},{Key,Val}) ->
+ ets:insert(get(options),{{Id,Key},Val});
+insert_opt(_DB,Id,{Key,Val}) ->
+ ets:insert(get(options),{{Id,Key},Val}).
+
+insert_opts(_DB,_Id,[]) -> done;
+insert_opts(DB,Id,[Opt|Opts]) ->
+ insert_opt(DB,Id,Opt),
+ insert_opts(DB,Id,Opts).
+
+insert_def(#gstkid{id=ID},ObjType,{Key,Val}) ->
+ insert_def(ID,ObjType,{Key,Val});
+insert_def(ID,ObjType,{Key,Val}) ->
+ Def = get(defaults),
+ ets:match_delete(Def,{{ID,ObjType},{Key,'_'}}),
+ ets:insert(Def,{{ID,ObjType},{Key,Val}}).
+
+lookup_def(ID,ObjType,Key) ->
+ case ets:match(get(defaults),{{ID,ObjType},{Key,'$1'}}) of
+ [] -> false;
+ [[Val]] -> {value,Val}
+ end.
+
+opt(DB,#gstkid{id=Id},Opt) -> opt(DB,Id,Opt);
+opt(_DB,Id,Opt) ->
+ [{_, Value}] = ets:lookup(get(options), {Id,Opt}),
+ Value.
+
+opt_or_not(DB,#gstkid{id=Id},Opt) -> opt_or_not(DB,Id,Opt);
+opt_or_not(_DB,Id,Opt) ->
+ case ets:lookup(get(options), {Id,Opt}) of
+ [{_, Value}] -> {value, Value};
+ _ -> false
+ end.
+
+opt(DB,#gstkid{id=Id},Opt,ElseVal) -> opt(DB,Id,Opt,ElseVal);
+opt(_DB,Id,Opt,ElseVal) ->
+ case ets:lookup(get(options), {Id,Opt}) of
+ [{_, Value}] ->
+ Value;
+ _ -> ElseVal
+ end.
+
+%%----------------------------------------------------------------------
+%% Returns: list of {Key,Val}
+%%----------------------------------------------------------------------
+default_container_opts(_DB,Id,ChildType) ->
+ L = ets:match(get(defaults),{{Id,'$1'},'$2'}),
+ lists:sort(fix_def_for_container(L,ChildType)).
+
+default_opts(_DB,Id,ChildType) ->
+ L1 = ets:lookup(get(defaults),{Id,ChildType}),
+ L2 = ets:lookup(get(defaults),{Id,all}),
+ lists:sort(fix_def(L1,L2)).
+
+fix_def([{_,Opt}|Opts],Opts2) ->
+ [Opt|fix_def(Opts,Opts2)];
+fix_def([],[]) -> [];
+fix_def([],Opts) ->
+ fix_def(Opts,[]).
+
+%%----------------------------------------------------------------------
+%% Purpose: Extracs {default,ObjType,DefsultOpt} for the ChildType
+%% and keeps default options since it is a container object.
+%% Returns: list of options
+%%----------------------------------------------------------------------
+fix_def_for_container([[all,{Key,Val}]|Opts],ChildType) ->
+ [{{default,all,Key},Val},{Key,Val}
+ |fix_def_for_container(Opts,ChildType)];
+fix_def_for_container([[ChildType,{Key,Val}]|Opts],ChildType) ->
+ [{{default,ChildType,Key},Val},{Key,Val}
+ |fix_def_for_container(Opts,ChildType)];
+fix_def_for_container([[ChildType2,{Key,Val}]|Opts],_ChildType) ->
+ [{{default,ChildType2,Key},Val}|fix_def_for_container(Opts,ChildType2)];
+fix_def_for_container([],_) -> [].
+
+%% -----------------------------------------------------------------
+%% lookup things
+
+lookup_gstkid(DB, Name, Owner) when is_atom(Name) ->
+ ID = lookup(DB, {Owner, Name}),
+ lookup(DB, ID);
+
+lookup_gstkid(DB, ID, _Owner) ->
+ lookup(DB, ID).
+
+
+lookup_gstkid(_DB, Name) when is_atom(Name) ->
+ exit({'must use owner',Name});
+
+lookup_gstkid(DB, ID) ->
+ lookup(DB, ID).
+
+
+lookup_ids(DB, Pid) ->
+ ril(ets:match(DB, {'$1', {gstkid,'_','_','_',Pid,'_','_'}})).
+
+lookup_item(DB, TkW, Item) ->
+ % [[Id]] = ets:match(DB, {'$1', {gstkid,'_',TkW, Item,'_','_','_'}}),
+ % Id.
+ %% OTP-4167 Gif images gstkids are stored differently from other objects
+ case ets:match(DB, {'$1', {gstkid,'_',TkW, Item,'_','_','_'}}) of
+ [[Id]] ->
+ Id;
+ [] ->
+ Pattern = {'$1', {gstkid,'_',TkW, {'_',Item},'_','_',image}},
+ [[Id]] = ets:match(DB, Pattern),
+ Id
+ end.
+
+
+%% -----------------------------------------------------------------
+%% counters
+
+counter(DB, Key) ->
+ Result =
+ case ets:lookup(DB, Key) of
+ [{Key, Value}] -> Value+1;
+ _ -> 0
+ end,
+ ets:insert(DB, {Key, Result}),
+ Result.
+
+
+%% -----------------------------------------------------------------
+%% delete things
+
+delete_widgets(DB, [ID | Rest]) ->
+ delete_widget(DB, ID),
+ delete_widgets(DB, Rest);
+delete_widgets(_, []) ->
+ true.
+
+
+delete_widget(DB, #gstkid{id = ID}) ->
+ delete_widget(DB, ID);
+delete_widget(DB, ID) ->
+ delete_widgets(DB, lookup_kids(DB, ID)),
+ delete_id(DB, ID).
+
+delete_gstkid(DB,Gstkid) ->
+ delete_id(DB,Gstkid).
+
+delete_id(DB, ID) ->
+ case lookup_gstkid(DB, ID) of
+ undefined ->
+ true;
+ _Gstkid ->
+ gstk:worker_do({match_delete,[{get(options),[{{ID,'_'},'_'}]},
+ {get(defaults),[{{ID,'_'},'_'}]}]}),
+ ets:insert(get(deleted),{deleted,ID}),
+ delete(DB, ID)
+ end,
+ ets:delete(get(kids), {kids, ID}),
+ delete(get(events), {events, ID}),
+ true.
+
+get_deleted(_DB) ->
+ Dd = get(deleted),
+ R=fix_deleted(ets:lookup(Dd,deleted)),
+ ets:delete(Dd,deleted),
+ R.
+
+fix_deleted([{_,Id}|Dd]) ->
+ [Id | fix_deleted(Dd)];
+fix_deleted([]) -> [].
+
+%% -----------------------------------------------------------------
+%% odd stuff
+
+%% check if an event is in the database, used by read_option
+is_inserted(DB, #gstkid{id = ID}, What) ->
+ is_inserted(DB, ID, What);
+is_inserted(_DB, ID, What) ->
+ case lookup(get(events), {events, ID}) of
+ undefined -> false;
+ Events ->
+ case lists:keysearch(What, 2, Events) of
+ {value, _} -> true;
+ _Other -> false
+ end
+ end.
+
+%% -----------------------------------------------------------------
+%% PRIMITIVES
+%% -----------------------------------------------------------------
+
+%% remove irritating lists
+ril([[Foo] | Rest]) -> [Foo | ril(Rest)];
+ril([]) -> [].
+
+
+