%% %% %CopyrightBegin% %% %% Copyright Ericsson AB 1996-2009. 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% %% %% %% ------------------------------------------------------------ %% %% 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([]) -> [].