From 84adefa331c4159d432d22840663c38f155cd4c1 Mon Sep 17 00:00:00 2001 From: Erlang/OTP Date: Fri, 20 Nov 2009 14:54:40 +0000 Subject: The R13B03 release. --- lib/tv/src/Makefile | 135 +++ lib/tv/src/tv.app.src | 56 ++ lib/tv/src/tv.appup.src | 18 + lib/tv/src/tv.erl | 38 + lib/tv/src/tv_comm_func.erl | 77 ++ lib/tv/src/tv_db.erl | 1267 +++++++++++++++++++++++ lib/tv/src/tv_db_int_def.hrl | 80 ++ lib/tv/src/tv_db_search.erl | 485 +++++++++ lib/tv/src/tv_db_sort.erl | 141 +++ lib/tv/src/tv_ets_rpc.erl | 140 +++ lib/tv/src/tv_etsread.erl | 767 ++++++++++++++ lib/tv/src/tv_info.erl | 876 ++++++++++++++++ lib/tv/src/tv_int_def.hrl | 56 ++ lib/tv/src/tv_int_msg.hrl | 504 ++++++++++ lib/tv/src/tv_io_lib.erl | 222 +++++ lib/tv/src/tv_io_lib_format.erl | 389 ++++++++ lib/tv/src/tv_io_lib_pretty.erl | 171 ++++ lib/tv/src/tv_ip.erl | 236 +++++ lib/tv/src/tv_main.erl | 1807 +++++++++++++++++++++++++++++++++ lib/tv/src/tv_main.hrl | 286 ++++++ lib/tv/src/tv_mnesia_rpc.erl | 104 ++ lib/tv/src/tv_new_table.erl | 656 ++++++++++++ lib/tv/src/tv_nodewin.erl | 403 ++++++++ lib/tv/src/tv_pb.erl | 685 +++++++++++++ lib/tv/src/tv_pb_funcs.erl | 1050 +++++++++++++++++++ lib/tv/src/tv_pb_int_def.hrl | 99 ++ lib/tv/src/tv_pc.erl | 794 +++++++++++++++ lib/tv/src/tv_pc_graph_ctrl.erl | 120 +++ lib/tv/src/tv_pc_int_def.hrl | 62 ++ lib/tv/src/tv_pc_menu_handling.erl | 485 +++++++++ lib/tv/src/tv_pd.erl | 1122 +++++++++++++++++++++ lib/tv/src/tv_pd_display.erl | 1059 ++++++++++++++++++++ lib/tv/src/tv_pd_frames.erl | 480 +++++++++ lib/tv/src/tv_pd_int_def.hrl | 139 +++ lib/tv/src/tv_pd_int_msg.hrl | 433 ++++++++ lib/tv/src/tv_pd_scale.erl | 303 ++++++ lib/tv/src/tv_pg.erl | 429 ++++++++ lib/tv/src/tv_pg_gridfcns.erl | 1939 ++++++++++++++++++++++++++++++++++++ lib/tv/src/tv_pg_int_def.hrl | 92 ++ lib/tv/src/tv_poll_dialog.erl | 357 +++++++ lib/tv/src/tv_pw.erl | 327 ++++++ lib/tv/src/tv_pw_int_def.hrl | 55 + lib/tv/src/tv_pw_window.erl | 273 +++++ lib/tv/src/tv_rec_edit.erl | 744 ++++++++++++++ lib/tv/src/tv_table_owner.erl | 122 +++ lib/tv/src/tv_utils.erl | 176 ++++ 46 files changed, 20259 insertions(+) create mode 100644 lib/tv/src/Makefile create mode 100644 lib/tv/src/tv.app.src create mode 100644 lib/tv/src/tv.appup.src create mode 100644 lib/tv/src/tv.erl create mode 100644 lib/tv/src/tv_comm_func.erl create mode 100644 lib/tv/src/tv_db.erl create mode 100644 lib/tv/src/tv_db_int_def.hrl create mode 100644 lib/tv/src/tv_db_search.erl create mode 100644 lib/tv/src/tv_db_sort.erl create mode 100644 lib/tv/src/tv_ets_rpc.erl create mode 100644 lib/tv/src/tv_etsread.erl create mode 100644 lib/tv/src/tv_info.erl create mode 100644 lib/tv/src/tv_int_def.hrl create mode 100644 lib/tv/src/tv_int_msg.hrl create mode 100644 lib/tv/src/tv_io_lib.erl create mode 100644 lib/tv/src/tv_io_lib_format.erl create mode 100644 lib/tv/src/tv_io_lib_pretty.erl create mode 100644 lib/tv/src/tv_ip.erl create mode 100644 lib/tv/src/tv_main.erl create mode 100644 lib/tv/src/tv_main.hrl create mode 100644 lib/tv/src/tv_mnesia_rpc.erl create mode 100644 lib/tv/src/tv_new_table.erl create mode 100644 lib/tv/src/tv_nodewin.erl create mode 100644 lib/tv/src/tv_pb.erl create mode 100644 lib/tv/src/tv_pb_funcs.erl create mode 100644 lib/tv/src/tv_pb_int_def.hrl create mode 100644 lib/tv/src/tv_pc.erl create mode 100644 lib/tv/src/tv_pc_graph_ctrl.erl create mode 100644 lib/tv/src/tv_pc_int_def.hrl create mode 100644 lib/tv/src/tv_pc_menu_handling.erl create mode 100644 lib/tv/src/tv_pd.erl create mode 100644 lib/tv/src/tv_pd_display.erl create mode 100644 lib/tv/src/tv_pd_frames.erl create mode 100644 lib/tv/src/tv_pd_int_def.hrl create mode 100644 lib/tv/src/tv_pd_int_msg.hrl create mode 100644 lib/tv/src/tv_pd_scale.erl create mode 100644 lib/tv/src/tv_pg.erl create mode 100644 lib/tv/src/tv_pg_gridfcns.erl create mode 100644 lib/tv/src/tv_pg_int_def.hrl create mode 100644 lib/tv/src/tv_poll_dialog.erl create mode 100644 lib/tv/src/tv_pw.erl create mode 100644 lib/tv/src/tv_pw_int_def.hrl create mode 100644 lib/tv/src/tv_pw_window.erl create mode 100644 lib/tv/src/tv_rec_edit.erl create mode 100644 lib/tv/src/tv_table_owner.erl create mode 100644 lib/tv/src/tv_utils.erl (limited to 'lib/tv/src') diff --git a/lib/tv/src/Makefile b/lib/tv/src/Makefile new file mode 100644 index 0000000000..457b9d38c4 --- /dev/null +++ b/lib/tv/src/Makefile @@ -0,0 +1,135 @@ +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 1997-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% +include $(ERL_TOP)/make/target.mk +include $(ERL_TOP)/make/$(TARGET)/otp.mk + +# ---------------------------------------------------- +# Application version +# ---------------------------------------------------- +include ../vsn.mk +VSN=$(TV_VSN) + +# ---------------------------------------------------- +# Release directory specification +# ---------------------------------------------------- +RELSYSDIR = $(RELEASE_PATH)/lib/tv-$(VSN) + +# ---------------------------------------------------- +# Common Macros +# ---------------------------------------------------- + +MODULES= \ + tv \ + tv_comm_func \ + tv_db \ + tv_db_search \ + tv_db_sort \ + tv_ets_rpc \ + tv_etsread \ + tv_info \ + tv_io_lib \ + tv_io_lib_format \ + tv_io_lib_pretty \ + tv_ip \ + tv_main \ + tv_mnesia_rpc \ + tv_new_table \ + tv_nodewin \ + tv_pb \ + tv_pb_funcs \ + tv_pc \ + tv_pc_graph_ctrl \ + tv_pc_menu_handling \ + tv_pd \ + tv_pd_display \ + tv_pd_frames \ + tv_pd_scale \ + tv_pg \ + tv_pg_gridfcns \ + tv_poll_dialog \ + tv_pw \ + tv_pw_window \ + tv_rec_edit \ + tv_table_owner \ + tv_utils + + + +HRL_FILES= \ + tv_db_int_def.hrl \ + tv_int_def.hrl \ + tv_int_msg.hrl \ + tv_main.hrl \ + tv_pb_int_def.hrl \ + tv_pc_int_def.hrl \ + tv_pd_int_def.hrl \ + tv_pd_int_msg.hrl \ + tv_pg_int_def.hrl \ + tv_pw_int_def.hrl + +ERL_FILES= $(MODULES:%=%.erl) + +TARGET_FILES = $(MODULES:%=$(EBIN)/%.$(EMULATOR)) $(APP_TARGET) $(APPUP_TARGET) + +APP_FILE = tv.app +APP_SRC = $(APP_FILE).src +APP_TARGET = $(EBIN)/$(APP_FILE) + +APPUP_FILE = tv.appup +APPUP_SRC = $(APPUP_FILE).src +APPUP_TARGET = $(EBIN)/$(APPUP_FILE) +# ---------------------------------------------------- +# FLAGS +# ---------------------------------------------------- +ERL_COMPILE_FLAGS += +warn_obsolete_guard + +# ---------------------------------------------------- +# Targets +# ---------------------------------------------------- + +debug opt: $(TARGET_FILES) + +clean: + rm -f $(TARGET_FILES) + rm -f errs core *~ + +$(APP_TARGET): $(APP_SRC) ../vsn.mk + sed -e 's;%VSN%;$(VSN);' $< > $@ + +$(APPUP_TARGET): $(APPUP_SRC) ../vsn.mk + sed -e 's;%VSN%;$(VSN);' $< > $@ + +docs: + +# ---------------------------------------------------- +# Special Targets +# ---------------------------------------------------- + +# ---------------------------------------------------- +# Release Target +# ---------------------------------------------------- +include $(ERL_TOP)/make/otp_release_targets.mk + +release_spec: opt + $(INSTALL_DIR) $(RELSYSDIR)/src + $(INSTALL_DATA) $(HRL_FILES) $(ERL_FILES) $(RELSYSDIR)/src + $(INSTALL_DIR) $(RELSYSDIR)/ebin + $(INSTALL_DATA) $(TARGET_FILES) $(RELSYSDIR)/ebin + +release_docs_spec: + diff --git a/lib/tv/src/tv.app.src b/lib/tv/src/tv.app.src new file mode 100644 index 0000000000..e76c587868 --- /dev/null +++ b/lib/tv/src/tv.app.src @@ -0,0 +1,56 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1997-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% +{application, tv, + [{description, "tv Table Visualizer"}, + {vsn, "%VSN%"}, + {modules, [tv, + tv_comm_func, + tv_db, + tv_db_search, + tv_db_sort, + tv_ets_rpc, + tv_etsread, + tv_info, + tv_io_lib, + tv_io_lib_format, + tv_io_lib_pretty, + tv_ip, + tv_main, + tv_mnesia_rpc, + tv_new_table, + tv_nodewin, + tv_pb, + tv_pb_funcs, + tv_pc, + tv_pc_graph_ctrl, + tv_pc_menu_handling, + tv_pd, + tv_pd_display, + tv_pd_frames, + tv_pd_scale, + tv_pg, + tv_pg_gridfcns, + tv_poll_dialog, + tv_pw, + tv_pw_window, + tv_rec_edit, + tv_table_owner, + tv_utils + ]}, + {registered,[tv_table_owner]}, + {applications, [kernel, stdlib, gs]}]}. diff --git a/lib/tv/src/tv.appup.src b/lib/tv/src/tv.appup.src new file mode 100644 index 0000000000..0d918b6081 --- /dev/null +++ b/lib/tv/src/tv.appup.src @@ -0,0 +1,18 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2001-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% +{"%VSN%",[],[]}. diff --git a/lib/tv/src/tv.erl b/lib/tv/src/tv.erl new file mode 100644 index 0000000000..70bc945c63 --- /dev/null +++ b/lib/tv/src/tv.erl @@ -0,0 +1,38 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1997-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% +-module(tv). + +-export([start/0, + start_browser/6]). + + +%%%********************************************************************* +%%% EXTERNAL FUNCTIONS +%%%********************************************************************* + +start() -> + tv_main:start(). + + +start_browser(Node, LocalNode, TableId, KindOfTable, TableName, ErrMsgMode) -> + spawn_link(tv_pc, pc, [self(), Node, LocalNode, TableId, KindOfTable, TableName, ErrMsgMode]). + + + + + diff --git a/lib/tv/src/tv_comm_func.erl b/lib/tv/src/tv_comm_func.erl new file mode 100644 index 0000000000..d57960e303 --- /dev/null +++ b/lib/tv/src/tv_comm_func.erl @@ -0,0 +1,77 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1997-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% +-module(tv_comm_func). + + + + +-export([max/2, + min/2 + ]). + + + + + + + +%%%********************************************************************* +%%% EXTERNAL FUNCTIONS +%%%********************************************************************* + + + +%%====================================================================== +%% Function: +%% +%% Return Value: +%% +%% Description: +%% +%% Parameters: +%%====================================================================== + + +max(X, Y) when X > Y -> + X; +max(_X, Y) -> + Y. + + + + + + +%%====================================================================== +%% Function: +%% +%% Return Value: +%% +%% Description: +%% +%% Parameters: +%%====================================================================== + + +min(X, Y) when X < Y -> + X; +min(_X, Y) -> + Y. + + + diff --git a/lib/tv/src/tv_db.erl b/lib/tv/src/tv_db.erl new file mode 100644 index 0000000000..201b4c0e6b --- /dev/null +++ b/lib/tv/src/tv_db.erl @@ -0,0 +1,1267 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1997-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% +%%%********************************************************************* +%%% +%%% Description: Module handling the internal database in the table tool. +%%% +%%%********************************************************************* + +-module(tv_db). + + + +-export([dbs/2]). + + + +-include("tv_int_def.hrl"). +-include("tv_int_msg.hrl"). +-include("tv_db_int_def.hrl"). + + + + + + + +%%%********************************************************************* +%%% EXTERNAL FUNCTIONS +%%%********************************************************************* + + + + +dbs(Master, ErrMsgMode) -> + process_flag(trap_exit, true), + put(error_msg_mode, ErrMsgMode), + ProcVars = #process_variables{master_pid = Master}, + blocked(ProcVars). + + + + + + +%%%******************************************************************** +%%% INTERNAL FUNCTIONS +%%%******************************************************************** + + + +blocked(ProcVars) -> + receive + Msg -> + case Msg of + + #dbs_deblock{} -> + deblock(Msg, ProcVars, false); + + {error_msg_mode, Mode} -> + put(error_msg_mode, Mode), + blocked(ProcVars); + + {'EXIT', Pid, Reason} -> + MasterPid = ProcVars#process_variables.master_pid, + exit_signals({Pid, Reason}, MasterPid), + blocked(ProcVars); + + _Other -> + blocked(ProcVars) + end + end. + + + + + + + +deblock(Msg, ProcVars, SearchWinCreated) -> + #dbs_deblock{sender = Sender, + etsread_pid = EtsreadPid, + type = Type, + keypos = KeyPos, + sublist_length = SublistLength} = Msg, + + NewDbData = #db_data{subset_size = SublistLength, + subset_pos = 1, + key_no = KeyPos, + ets_type = Type + }, + NewProcVars = ProcVars#process_variables{db_data = NewDbData, + etsread_pid = EtsreadPid}, + Sender ! #dbs_deblock_cfm{sender = self()}, + deblocked_loop(NewProcVars, SearchWinCreated, [], undefined). + + + + + + + + +deblocked_loop(ProcVars, SearchWinCreated, SearchData, RegExp) -> + receive + Msg -> + case Msg of + + {gs,entry,keypress,_Data,['Return' | _T]} -> + NewSearchData = search_object(ProcVars, RegExp), + deblocked_loop(ProcVars, SearchWinCreated, NewSearchData, RegExp); + + {gs,entry,keypress,_Data,['Tab' | _T]} -> + gs:config(entry, [{select, {0,1000}}]), + deblocked_loop(ProcVars, SearchWinCreated, SearchData, RegExp); + + {gs,entry,keypress,_Data,_Args} -> + deblocked_loop(ProcVars, SearchWinCreated, SearchData, RegExp); + + {gs,expr_term,click,_Data,_Args} -> + deblocked_loop(ProcVars, SearchWinCreated, SearchData, false); + + {gs,expr_regexp,click,_Data,_Args} -> + deblocked_loop(ProcVars, SearchWinCreated, SearchData, true); + + {gs,search,click,_Data,_Args} -> + NewSearchData = search_object(ProcVars, RegExp), + deblocked_loop(ProcVars, SearchWinCreated, NewSearchData, RegExp); + + {gs,cancel,click,cancel,_Args} -> + tv_db_search:destroy_window(SearchWinCreated), + deblocked_loop(ProcVars, false, [], RegExp); + + {gs,listbox,click,_LbData,[Idx | _T]} when SearchData =/= [] -> + tv_db_search:mark_busy(SearchWinCreated), + {Row,_Obj} = lists:nth(Idx+1, SearchData), + DbData = ProcVars#process_variables.db_data, + %% Never allow 'subset_pos' to have zero as value! + %% No list can begin with the 0:th element!!! + %% Has to be at least 1! + NewDbData = DbData#db_data{subset_pos=?COMM_FUNC_FILE:max(1, + Row), + subset_size=?ITEMS_TO_DISPLAY}, + NewProcVars = ProcVars#process_variables{db_data=NewDbData}, + send_subset(NewProcVars, undefined, undefined), + tv_db_search:mark_nonbusy(SearchWinCreated), + deblocked_loop(NewProcVars, SearchWinCreated, SearchData, RegExp); + + {gs,win,configure,_Data,_Args} -> + tv_db_search:resize_window(SearchWinCreated), + deblocked_loop(ProcVars, SearchWinCreated, SearchData, RegExp); + + {gs,win,destroy,_Data,_Args} -> + deblocked_loop(ProcVars, false, [], RegExp); + + + #dbs_new_data{data = NewData, keys = ListOfKeys, + time_to_read_table = ElapsedTimeEtsread} -> + tv_db_search:reset_window(SearchWinCreated), + T1 = time(), + NewProcVars = update_db(NewData, ListOfKeys, ProcVars), + T2 = time(), + ElapsedTimeDbs = compute_elapsed_seconds(T1, T2), + send_subset(NewProcVars, ElapsedTimeEtsread, ElapsedTimeDbs), + deblocked_loop(NewProcVars, SearchWinCreated, [], RegExp); + + #dbs_subset_req{subset_pos = Pos,subset_length = Length} -> + DbData = ProcVars#process_variables.db_data, + %% Never allow 'subset_pos' to have zero as value! + %% No list can begin with the 0:th element!!! + %% Has to be at least 1! + NewDbData = DbData#db_data{subset_pos=?COMM_FUNC_FILE:max(1, + Pos), + subset_size=Length}, + NewProcVars = ProcVars#process_variables{db_data = NewDbData}, + send_subset(NewProcVars, undefined, undefined), + deblocked_loop(NewProcVars, SearchWinCreated, SearchData, RegExp); + + #dbs_marked_row{row_no = RowNo} -> + DbData = ProcVars#process_variables.db_data, + NewDbData = DbData#db_data{requested_row = RowNo}, + NewProcVars = ProcVars#process_variables{db_data = NewDbData}, + deblocked_loop(NewProcVars, SearchWinCreated, SearchData, RegExp); + + #dbs_search_req{} -> + tv_db_search:create_window(SearchWinCreated), + deblocked_loop(ProcVars, true, SearchData, false); + + #dbs_sorting_mode{} -> + {NewProcVars, NewSearchData} = + update_sorting_mode(Msg, ProcVars, + SearchWinCreated, SearchData, RegExp), + deblocked_loop(NewProcVars, SearchWinCreated, NewSearchData, RegExp); + + #dbs_deblock{} -> + tv_db_search:reset_window(SearchWinCreated), + deblock(Msg, ProcVars, SearchWinCreated); + + #dbs_updated_object{object=Obj,old_object=OldObj,old_color=Color,obj_no=ObjNo} -> + {Success, NewProcVars} = update_object(Obj, OldObj, Color, ObjNo, ProcVars), + case Success of + true -> + tv_db_search:reset_window(SearchWinCreated), + send_subset(NewProcVars, undefined, undefined); + false -> + done + end, + deblocked_loop(NewProcVars, SearchWinCreated, SearchData, RegExp); + + #dbs_new_object{object=Obj} -> + {Success, NewProcVars} = new_object(Obj, ProcVars), + case Success of + true -> + tv_db_search:reset_window(SearchWinCreated), + send_subset(NewProcVars, undefined, undefined); + false -> + done + end, + deblocked_loop(NewProcVars, SearchWinCreated, SearchData, RegExp); + + #dbs_delete_object{object=Obj, color=Color, obj_no=ObjNo} -> + {Success, NewProcVars} = delete_object(Obj, Color, ObjNo, ProcVars), + case Success of + true -> + tv_db_search:reset_window(SearchWinCreated), + send_subset(NewProcVars, undefined, undefined); + false -> + done + end, + deblocked_loop(NewProcVars, SearchWinCreated, SearchData, RegExp); + + #pc_list_info{lists_as_strings=ListAsStr} -> + NewProcVars = ProcVars#process_variables{lists_as_strings=ListAsStr}, + deblocked_loop(NewProcVars, SearchWinCreated, SearchData, RegExp); + + {error_msg_mode, Mode} -> + put(error_msg_mode, Mode), + deblocked_loop(ProcVars, SearchWinCreated, SearchData, RegExp); + + {'EXIT', Pid, Reason} -> + MasterPid = ProcVars#process_variables.master_pid, + exit_signals({Pid, Reason}, MasterPid), + deblocked_loop(ProcVars, SearchWinCreated, SearchData, RegExp); + + _Other -> + %% io:format("Received message: ~w ~n", [_Other]), + deblocked_loop(ProcVars, SearchWinCreated, SearchData, RegExp) + end + end. + + + + + + + +search_object(ProcVars, RegExp) -> + DbData = ProcVars#process_variables.db_data, + DbList = dblist2list(DbData#db_data.db), + ListAsStr = ProcVars#process_variables.lists_as_strings, + case catch tv_db_search:get_input_and_search(DbList, RegExp, ListAsStr) of + {'EXIT', _Reason} -> + tv_db_search:reset_window(true), + []; + List -> + List + end. + + + + + + +update_sorting_mode(Msg, ProcVars, SearchWinCreated, OldSearchData, RegExp) -> + #dbs_sorting_mode{sorting = Sorting, + reverse = Reverse, + sort_key_no = SortKeyNo} = Msg, + + DbData = ProcVars#process_variables.db_data, + + #db_data{db = DbList, + sorting = OldSorting, + rev_sorting = OldReverse, + sort_key_no = OldSortKeyNo} = DbData, + + + NewDbList = sort_db_list(DbList, Sorting, OldSorting, Reverse, OldReverse, + SortKeyNo, OldSortKeyNo), + + NewDbData = DbData#db_data{db = NewDbList, + sorting = Sorting, + rev_sorting = Reverse, + sort_key_no = SortKeyNo + }, + + NewProcVars = ProcVars#process_variables{db_data = NewDbData}, + send_subset(NewProcVars, undefined, undefined), + + SearchData = + case Sorting of + false -> + OldSearchData; + OldSorting when Reverse =:= OldReverse, + SortKeyNo =:= OldSortKeyNo -> + []; + OldSorting when Reverse =:= OldReverse, + OldSortKeyNo =:= undefined-> + []; + _Other -> + ListAsStr = ProcVars#process_variables.lists_as_strings, + case catch tv_db_search:update_search(SearchWinCreated, + NewDbList, RegExp, + ListAsStr) of + {'EXIT', _Reason} -> + tv_db_search:reset_window(true), + []; + List -> + List + end + end, + + {NewProcVars, SearchData}. + + + + + + + + +sort_db_list(DbList, Sort, Sort, Rev, Rev, KeyNo, KeyNo) -> + % Already sorted! + DbList; +sort_db_list(DbList, false, _OldSort, _Rev, _OldRev, _KeyNo, _OldKeyNo) -> + % No sorting, i.e., the old list order suffices! + DbList; +sort_db_list(DbList, _Sort, _OldSort, Rev, _OldRev, KeyNo, _OldKeyNo) -> + tv_db_sort:mergesort(KeyNo, DbList, Rev). + + + + + + + +send_subset(ProcVars, EtsreadTime, DbsTime) -> + #process_variables{master_pid = MasterPid, + db_data = DbData, + list_of_keys = ListOfKeys} = ProcVars, + + #db_data{subset_size = SubsetSize, + subset_pos = SubsetPos, + requested_row = RowNo, + db_size = DbSize, + db = DbList, + max_elem_size = MaxElemSize} = DbData, + + + RowData = get_requested_row_data(RowNo, DbList), + + if + DbSize > 0 -> + Pos = ?COMM_FUNC_FILE:min(SubsetPos, DbSize), + % Requested_data may be shorter than requested, but that's OK, + % pd handles that correctly! + Subset = lists:sublist(DbList, Pos, SubsetSize), + MasterPid ! #dbs_subset{sender = self(), + data = Subset, + subset_pos = Pos, + db_length = DbSize, + list_of_keys = ListOfKeys, + max_elem_size = MaxElemSize, + requested_row = RowData, + required_time_etsread = EtsreadTime, + required_time_dbs = DbsTime + }; + true -> + MasterPid ! #dbs_subset{sender = self(), + data = [], + subset_pos = 1, + db_length = 0, + list_of_keys = ListOfKeys, + max_elem_size = MaxElemSize, + requested_row = RowData, + required_time_etsread = EtsreadTime, + required_time_dbs = DbsTime + } + end. + + + + + +get_requested_row_data(undefined, _DbList) -> + []; +get_requested_row_data(_RowNo, []) -> + []; +get_requested_row_data(RowNo, DbList) -> + case catch lists:nth(RowNo, DbList) of + {'EXIT', _Reason} -> + []; + RowData -> + [RowData] + end. + + + + +exit_signals(ExitInfo, MasterPid) -> + case ExitInfo of + {MasterPid, _Reason} -> + % When from master, just quit! + exit(normal); + _Other -> + done + end. + + + + +update_db(NewList, ListOfKeys, ProcVars) -> + DbData = ProcVars#process_variables.db_data, + #db_data{db = OldDbList, + max_elem_size = MaxElemSize, + deleted = DelList, + ets_type = EtsType, + sorting = Sorting, + rev_sorting = RevSorting, + sort_key_no = SortKeyNo, + key_no = KeyNo} = DbData, + + DbList = update_colors(OldDbList -- DelList), + OldList = dblist2list(DbList), + InsOrUpd = (NewList -- OldList), + DelOrUpd = (OldList -- NewList), + + {Inserted, Deleted, Updated} = group_difflists(basetype(EtsType), KeyNo, + InsOrUpd, + DelOrUpd), + DelMarked = mark_deleted(KeyNo, Deleted, DbList), + Replaced = replace_elements(KeyNo, Updated, DelMarked), + NewDbList = add_elements(KeyNo, Inserted, Replaced, Sorting, RevSorting, + SortKeyNo), + + NewMaxSize = ?COMM_FUNC_FILE:max(MaxElemSize, + ?COMM_FUNC_FILE:max(max_size(Replaced), + max_size(Inserted))), + + NewDbData = DbData#db_data{db = NewDbList, + db_size = length(NewDbList), + max_elem_size = NewMaxSize, + deleted = list2dblist(Deleted, ?BLACK) + }, + + ProcVars#process_variables{db_data = NewDbData, + list_of_keys = ListOfKeys + }. + + + + + + +update_object(Obj, OldObj, OldColor, ObjNo, ProcVars) -> + #process_variables{db_data = DbData, + etsread_pid = EtsreadPid} = ProcVars, + + #db_data{key_no = KeyNo} = DbData, + + %% Don't update if there are no changes! + case OldObj of + Obj when OldColor =/= ?BLACK -> %% Allow deleted objects to be inserted! + gs:window(dbwin, gs:start(), []), + case get(error_msg_mode) of + normal -> + tv_utils:notify(dbwin, "TV Notification", ["The object is unchanged!"]); + haiku -> + tv_utils:notify(dbwin, "TV Notification", + ["Stay the patient course,", + "Of little worth is your ire:", + "The object's unchanged." ]) + end, + gs:destroy(dbwin), + {false, ProcVars}; + _Other -> + %% Before we try to update the internal database, we have to check to see + %% whether the ETS/Mnesia update is allowed! + Result = + case OldColor of + ?BLACK -> + EtsreadPid ! #etsread_new_object{sender = self(), + object = Obj}, + receive + #etsread_new_object_cfm{success = Success} -> + Success + after + 60000 -> + exit(etsread_not_responding) + end; + _OtherColor -> + EtsreadPid ! #etsread_update_object{sender = self(), + key_no = KeyNo, + object = Obj, + old_object = OldObj}, + receive + #etsread_update_object_cfm{success = Success} -> + Success + after + 60000 -> + exit(etsread_not_responding) + end + end, + case Result of + false -> + gs:window(dbwin, gs:start(), [beep]), + case get(error_msg_mode) of + normal -> + tv_utils:notify(dbwin, "TV Notification", + ["Couldn't update table!"]); + haiku -> + tv_utils:notify(dbwin, "TV Notification", + ["Three things are certain:", + "Death, taxes, and lost updates.", + "Guess which has occurred."]) + end, + gs:destroy(dbwin), + {false, ProcVars}; + true -> + {true, update_object2(Obj, OldObj, OldColor, ObjNo, ProcVars)} + end + end. + + + + + +update_object2(Obj, OldObj, OldColor, ObjNo, ProcVars) -> + #process_variables{db_data = DbData} = ProcVars, + + #db_data{db = DbList, + ets_type = EtsType, %% 'bag', 'set', 'ordered_set' or + %% 'duplicate_bag' + max_elem_size = MaxElemSize, + sorting = Sorting, + rev_sorting = RevSorting, + sort_key_no = SortKeyNo, + key_no = KeyNo} = DbData, + + %% Replace the old element... + Key = element(KeyNo, Obj), + OldKey = element(KeyNo, OldObj), + %% If Key == OldKey, the old object shall only be replaced! + %% Otherwise the updated object shall be treated as a new + %% object when inserting it in the list! + %% In that latter case, we also have to check for duplicates! + + Fun = + case basetype(EtsType) of + set -> + case Key of + OldKey -> + fun({Data,Color}, {Replaced,AccDb}) when element(KeyNo,Data) =/= Key -> + {Replaced, [{Data,Color} | AccDb]}; + ({_Data,Color}, {Replaced,AccDb}) when not Replaced, + OldColor =:= ?BLACK, + Color =:= ?BLACK -> + {true, [{Obj,?RED1} | AccDb]}; + ({_Data,Color}, {Replaced,AccDb}) when not Replaced, + OldColor =/= ?BLACK, + Color =/= ?BLACK -> + {true, [{Obj,?GREEN1} | AccDb]}; + ({_Data,_Color}, {Replaced,AccDb}) -> + {Replaced, AccDb} + end; + _NewKey -> + fun({Data,Color}, {Replaced,AccDb}) -> + ElemKey = element(KeyNo,Data), + case ElemKey of + OldKey when not Replaced, + OldColor =:= ?BLACK, + Color =:= ?BLACK -> + {true, [{Obj,?RED1} | AccDb]}; + OldKey when not Replaced, + OldColor =/= ?BLACK, + Color =/= ?BLACK -> + {true, [{Obj,?GREEN1} | AccDb]}; + OldKey -> + {Replaced, AccDb}; + Key -> + {Replaced, AccDb}; + _OtherKey -> + {Replaced, [{Data,Color} | AccDb]} + end + end + end; + + bag -> + case Key of + OldKey -> + fun({Data,_Color}, {Replaced,AccDb}) when Data =:= Obj -> + {Replaced, AccDb}; + ({Data,Color}, {Replaced,AccDb}) when Data =/= OldObj -> + {Replaced, [{Data,Color} | AccDb]}; + %% Clauses when Data =:= OldObj. + ({_Data,Color}, {Replaced,AccDb}) when not Replaced, + OldColor =:= ?BLACK, + Color =:= ?BLACK -> + {true, [{Obj,?RED1} | AccDb]}; + ({_Data,Color}, {Replaced,AccDb}) when not Replaced, + OldColor =/= ?BLACK, + Color =/= ?BLACK -> + {true, [{Obj,Color} | AccDb]}; + ({_Data,_Color}, {Replaced,AccDb}) -> + {Replaced, AccDb} + end; + _NewKey -> + fun({Data,Color}, {Replaced,AccDb}) when Data =:= OldObj, + not Replaced, + OldColor =:= ?BLACK, + Color =:= ?BLACK -> + {true, [{Obj,?RED1} | AccDb]}; + ({Data,Color}, {Replaced,AccDb}) when Data =:= OldObj, + not Replaced, + OldColor =/= ?BLACK, + Color =/= ?BLACK -> + {true, [{Obj,?GREEN1} | AccDb]}; + ({Data,_Color}, {Replaced,AccDb}) when Data =:= OldObj -> + {Replaced, AccDb}; + ({Data,_Color}, {Replaced,AccDb}) when Data =:= Obj -> + {Replaced, AccDb}; + ({Data,Color}, {Replaced,AccDb}) -> + {Replaced, [{Data,Color} | AccDb]} + end + end; + + duplicate_bag -> + %% Multiple identical objects allowed, meaning that we shall not + %% remove anything, just replace one element. + case Key of + OldKey -> + fun({Data,Color}, {Replaced,AccDb}) when Data =:= Obj -> + {Replaced, [{Data,Color} | AccDb]}; + ({Data,Color}, {Replaced,AccDb}) when Data =/= OldObj -> + {Replaced, [{Data,Color} | AccDb]}; + ({_Data,Color}, {Replaced,AccDb}) when not Replaced, + OldColor =:= ?BLACK, + Color =:= ?BLACK -> + {true, [{Obj,?RED1} | AccDb]}; + ({_Data,Color}, {Replaced,AccDb}) when not Replaced, + OldColor =/= ?BLACK, + Color =/= ?BLACK -> + {true, [{Obj,Color} | AccDb]}; + ({Data,Color}, {Replaced,AccDb}) -> + {Replaced, [{Data,Color} | AccDb]} + end; + _NewKey -> + fun({Data,Color}, {Replaced,AccDb}) when Data =:= OldObj, + not Replaced, + OldColor =:= ?BLACK, + Color =:= ?BLACK -> + {true, [{Obj,?RED1} | AccDb]}; + ({Data,Color}, {Replaced,AccDb}) when Data =:= OldObj, + not Replaced, + OldColor =/= ?BLACK, + Color =/= ?BLACK -> + {true, [{Obj,?GREEN1} | AccDb]}; + ({Data,Color}, {Replaced,AccDb}) when Data =:= OldObj -> + {Replaced, [{Data,Color} | AccDb]}; + ({Data,Color}, {Replaced,AccDb}) when Data =:= Obj -> + {Replaced, [{Data,Color} | AccDb]}; + ({Data,Color}, {Replaced,AccDb}) -> + {Replaced, [{Data,Color} | AccDb]} + end + end + end, + + FilterFun = fun(Acc0, L) -> + lists:foldl(Fun, Acc0, L) + end, + + + {Repl, TmpList} = + case split(ObjNo, DbList) of + {L1, [{OldObj,OldColor} | T]} when OldColor =/= ?BLACK -> + {true, + lists:reverse(element(2, FilterFun({true,[]}, L1))) ++ + [{Obj,?GREEN1} | lists:reverse(element(2, FilterFun({true,[]},T)))]}; + {L1, [{OldObj,OldColor} | T]} -> + {true, + lists:reverse(element(2, FilterFun({true,[]}, L1))) ++ + [{Obj,?RED1} | lists:reverse(element(2, FilterFun({true,[]}, T)))]}; + {L1, L2} -> + {R1, NewL1} = FilterFun({false,[]}, L1), + {R2, NewL2} = FilterFun({false,[]}, L2), + {R1 or R2, lists:reverse(NewL1) ++ lists:reverse(NewL2)} + end, + + NewDbList = + case Repl of + true when not Sorting -> + TmpList; + true -> + tv_db_sort:mergesort(SortKeyNo, TmpList, RevSorting); + false -> + TmpList2 = + case Key of + OldKey -> + lists:reverse(element(2, FilterFun({false,[]}, TmpList))); + _OtherKey -> + lists:reverse(element(2, FilterFun({true,[]}, TmpList))) ++ + [{Obj,?RED1}] + end, + case Sorting of + false -> + TmpList2; + true -> + tv_db_sort:mergesort(SortKeyNo, TmpList2, RevSorting) + end + end, + NewMaxSize = ?COMM_FUNC_FILE:max(MaxElemSize, max_size([Obj])), + NewDbData = DbData#db_data{db = NewDbList, + db_size = length(NewDbList), + max_elem_size = NewMaxSize + }, + ProcVars#process_variables{db_data = NewDbData}. + + + + + +delete_object(_Obj, ?BLACK, _ObjNo, ProcVars) -> + %% Don't delete already deleted objects!!! + {false, ProcVars}; +delete_object(undefined, undefined, _ObjNo, ProcVars) -> + {false, ProcVars}; +delete_object(Obj, _ObjColor, ObjNo, ProcVars) -> + #process_variables{db_data = DbData, + etsread_pid = EtsreadPid} = ProcVars, + + #db_data{db = DbList, + deleted = OldDeleted} = DbData, + + %% Before we try to update the internal database, we have to check to see + %% whether the ETS/Mnesia update is allowed! + EtsreadPid ! #etsread_delete_object{sender = self(), + object = Obj}, + Result = + receive + #etsread_delete_object_cfm{success = Success} -> + Success + after + 60000 -> + exit(etsread_not_responding) + end, + + case Result of + false -> + gs:window(dbwin, gs:start(), [beep]), + case get(error_msg_mode) of + normal -> + tv_utils:notify(dbwin, "TV Notification", + ["Couldn't update table!"]); + haiku -> + tv_utils:notify(dbwin, "TV Notification", + ["Three things are certain:", + "Death, taxes, and lost updates.", + "Guess which has occurred."]) + end, + gs:destroy(dbwin), + {false, ProcVars}; + true -> + %% Replace the old element... + %% Have to beware of duplicate_bag tables, + %% i.e., the same object may occur more than + %% once, but we only want to remove it once! + {Repl, TmpList} = + case split(ObjNo, DbList) of + {L1, [{Obj,_Color} | T]} -> + {true, L1 ++ [{Obj,?BLACK} | T]}; + {L1, L2} -> + {false, L1 ++ L2} + end, + NewDbList = + case Repl of + true -> + TmpList; + false -> + Fun = fun({Data,TmpColor}, + {Removed,AccDb}) when Data =/= Obj -> + {Removed, [{Data,TmpColor} | AccDb]}; + ({_Data,TmpColor}, + {Removed,AccDb}) when not Removed, TmpColor =/= ?BLACK -> + {true, [{Obj,?BLACK} | AccDb]}; + ({Data,TmpColor}, + {Removed,AccDb}) -> + {Removed, [{Data,TmpColor} | AccDb]} + end, + lists:reverse(element(2, lists:foldl(Fun, {false,[]}, DbList))) + end, + NewDbData = DbData#db_data{db = NewDbList, + db_size = length(NewDbList), + deleted = [{Obj,?BLACK} | OldDeleted]}, + {true, ProcVars#process_variables{db_data = NewDbData}} + end. + + + + + +new_object(Obj, ProcVars) -> + #process_variables{db_data = DbData, + etsread_pid = EtsreadPid} = ProcVars, + + #db_data{db = DbList, + max_elem_size = MaxElemSize, + ets_type = EtsType, %% 'bag', 'set' or 'duplicate_bag' + sorting = Sorting, + rev_sorting = RevSorting, + sort_key_no = SortKeyNo, + key_no = KeyNo} = DbData, + + %% Before we try to update the internal database, we have to check to see + %% whether the ETS/Mnesia update is allowed! + EtsreadPid ! #etsread_new_object{sender = self(), + object = Obj}, + Result = + receive + #etsread_new_object_cfm{success = Success} -> + Success + after + 60000 -> + exit(etsread_not_responding) + end, + + case Result of + false -> + gs:window(dbwin, gs:start(), [beep]), + case get(error_msg_mode) of + normal -> + tv_utils:notify(dbwin, "TV Notification", + ["Couldn't update table!"]); + haiku -> + tv_utils:notify(dbwin, "TV Notification", + ["Three things are certain:", + "Death, taxes, and lost updates.", + "Guess which has occurred."]) + end, + gs:destroy(dbwin), + {false, ProcVars}; + true -> + Key = element(KeyNo, Obj), + NewDbList = insert_new_object(EtsType, Key, KeyNo, Obj, DbList, Sorting, + RevSorting, SortKeyNo), + NewMaxSize = ?COMM_FUNC_FILE:max(MaxElemSize, max_size([Obj])), + NewDbData = DbData#db_data{db = NewDbList, + db_size = length(NewDbList), + max_elem_size = NewMaxSize + }, + {true, ProcVars#process_variables{db_data = NewDbData}} + end. + + + + + +insert_new_object(EtsType,Key,KeyNo,Obj,DbList,Sorting,RevSorting,SortKeyNo) -> + %% Remove elements from the list that ought not to be there, + %% according to the table type! + + Fun = + case basetype(EtsType) of + set -> + fun({Data,Color}, {Replaced,AccDb}) when element(KeyNo,Data) =/= Key -> + {Replaced, [{Data,Color} | AccDb]}; + ({Data,Color}, {Replaced,AccDb}) when not Replaced, + Color =/= ?BLACK, + Data =/= Obj-> + {true, [{Obj,?GREEN1} | AccDb]}; + ({_Data,Color}, {Replaced,AccDb}) when not Replaced, + Color =/= ?BLACK -> + {true, [{Obj,Color} | AccDb]}; + ({_Data,Color}, {Replaced,AccDb}) when not Replaced, + Color =:= ?BLACK -> + {true, [{Obj, ?RED1} | AccDb]}; + ({_Data,Color}, {Replaced,AccDb}) when Replaced, + Color =:= ?BLACK -> + {false, AccDb}; + ({_Data,_Color}, {Replaced,AccDb}) -> + {Replaced, AccDb} + end; + bag -> + fun({Data,Color}, {Replaced,AccDb}) when Data =/= Obj -> + {Replaced, [{Data,Color} | AccDb]}; + ({_Data,Color}, {Replaced,AccDb}) when not Replaced, + Color =/= ?BLACK -> + {true, [{Obj,Color} | AccDb]}; + ({_Data,Color}, {Replaced,AccDb}) when Replaced, + Color =/= ?BLACK -> + {true, AccDb}; + ({_Data,Color}, {Replaced,AccDb}) when Replaced, + Color =:= ?BLACK -> + {true, AccDb}; + ({_Data,Color}, {Replaced,AccDb}) when not Replaced, + Color =:= ?BLACK -> + {true, [{Obj, ?RED1} | AccDb]}; + ({_Data,_Color}, {Replaced,AccDb}) -> + {Replaced, AccDb} + end; + duplicate_bag -> + %% The fun is never called if the type is duplicate_bag, + %% because all we have to do with new elements is to insert + %% them (multiple identical objects allowed). + not_used + end, + + FilterFun = fun(Acc0, L) -> + lists:foldl(Fun, Acc0, L) + end, + + {_Replaced, TmpDbList} = + case EtsType of + duplicate_bag -> + {false, DbList}; + _OtherType -> + {R,L} = FilterFun({false,[]}, DbList), + {R, lists:reverse(L)} + end, + + case Sorting of + false -> + TmpDbList ++ [{Obj,?RED1}]; + true -> + %% The original list is already sorted! + %% Just merge the two lists together! + tv_db_sort:merge(SortKeyNo, TmpDbList, [{Obj,?RED1}], RevSorting) + end. + + + + + + +max_size([]) -> + 0; +max_size(L) -> + max_size(L, 0). + + + +max_size([], CurrMax) -> + CurrMax; +max_size([H | T], CurrMax) when is_tuple(H) -> + Size = size(H), + if + Size >= CurrMax -> + max_size(T, Size); + true -> + max_size(T, CurrMax) + end; +max_size([_H | T], CurrMax) -> + Size = 1, + if + Size >= CurrMax -> + max_size(T, Size); + true -> + max_size(T, CurrMax) + end. + + + + + +add_elements(_KeyNo, Inserted, List, false, _RevSorting, _SortKeyNo) -> + % Remember that the order of the original list has to be preserved! + List ++ list2dblist(Inserted, ?RED1); +add_elements(_KeyNo, Inserted, List, _Sorting, RevSorting, SortKeyNo) -> + % The original list is already sorted - sort the new elements, and + % just merge the two lists together! + SortedInsertedList = tv_db_sort:mergesort(SortKeyNo, + list2dblist(Inserted, ?RED1), + RevSorting), + tv_db_sort:merge(SortKeyNo, List, SortedInsertedList, RevSorting). + + + + + + %% We assume the list already has been sorted, i.e., since the order won't + %% be changed by marking an element deleted, we DON'T have to sort the list + %% once again! + +mark_deleted(_KeyNo, [], List) -> + List; +mark_deleted(KeyNo, [Data | T], List) -> + KeyValue = tv_db_sort:get_compare_value(KeyNo, Data), + NewList = mark_one_element_deleted(KeyNo, KeyValue, Data, List, []), + mark_deleted(KeyNo, T, NewList). + + + + + + + + +mark_one_element_deleted(_KeyNo, _KeyValue, _Data, [], Acc) -> + Acc; +mark_one_element_deleted(KeyNo, {tuple, KeyValue}, + Data, [{DataTuple, Color} | Tail], Acc) -> + OldKeyValue = tv_db_sort:get_compare_value(KeyNo, DataTuple), + % Remember that the order of the original list has to be preserved! + if + OldKeyValue =:= {tuple, KeyValue} -> + Acc ++ [{Data, ?BLACK}] ++ Tail; + true -> + mark_one_element_deleted(KeyNo, {tuple, KeyValue}, Data, Tail, + Acc ++ [{DataTuple, Color}]) + end; +mark_one_element_deleted(KeyNo, _KeyValue, Data, [{DataTuple, Color} | Tail], Acc) -> + if + Data =:= DataTuple -> + Acc ++ [{Data, ?BLACK}] ++ Tail; + true -> + mark_one_element_deleted(KeyNo, _KeyValue, Data, Tail, + Acc ++ [{DataTuple, Color}]) + end. + + + + + + + + %% We assume the list already has been sorted, i.e., since the order won't + %% be changed by marking an element updated, we DON'T have to sort the list + %% once again! + +replace_elements(_KeyNo, [], List) -> + List; +replace_elements(KeyNo, [Data | T], List) -> + KeyValue = tv_db_sort:get_compare_value(KeyNo, Data), + NewList = replace_one_element(KeyNo, KeyValue, Data, List, []), + replace_elements(KeyNo, T, NewList). + + + + + + + +replace_one_element(_KeyNo, _Key, _Data, [], Acc) -> + Acc; +replace_one_element(KeyNo, {tuple, Key1}, Data, [{DataTuple, Color} | Tail], Acc) -> + Key2 = tv_db_sort:get_compare_value(KeyNo, DataTuple), + % Remember that the order of the original list has to be preserved! + if + Key2 =:= {tuple, Key1} -> + Acc ++ [{Data, ?GREEN1}] ++ Tail; + true -> + replace_one_element(KeyNo, {tuple, Key1}, Data, Tail, + Acc ++ [{DataTuple, Color}]) + end; +replace_one_element(_KeyNo, _KeyValue, _Data, [{DataTuple, Color} | Tail], Acc) -> + % Can't replace an element with no key! + Acc ++ [{DataTuple, Color} | Tail]. + + + + + + + + +group_difflists(bag, _KeyNo, Inserted, Deleted) -> + %% Since the ETS table is of bag type, no element can be updated, i.e., + %% it can only be deleted and re-inserted, otherwise a new element will be added. + {Inserted, Deleted, []}; +group_difflists(duplicate_bag, _KeyNo, Inserted, Deleted) -> + %% Since the ETS table is of duplicate_bag type, no element can be updated, i.e., + %% it can only be deleted and re-inserted, otherwise a new element will be added. + {Inserted, Deleted, []}; +group_difflists(set, _KeyNo, [], Deleted) -> + %% Updated elements have to be present in both lists, i.e., if one list is empty, + %% the other contains no updated elements - they are either inserted or deleted! + {[], Deleted, []}; +group_difflists(set, _KeyNo, Inserted, []) -> + {Inserted, [], []}; +group_difflists(set, KeyNo, InsOrUpd, DelOrUpd) -> + match_difflists(KeyNo, InsOrUpd, DelOrUpd, [], []). + + + + + + +match_difflists(_KeyNo, [], Deleted, Inserted, Updated) -> + {Inserted, Deleted, Updated}; +match_difflists(KeyNo, [Data | T], DelOrUpd, InsAcc, UpdAcc) -> + % This function is only called in case of a 'set' ETS table. + % 'Set' type of ETS table means there are unique keys. If two elements in + % InsOrUpd and DelOrUpd have the same key, that element has been updated, + % and is added to the Updated list, and removed from the original two lists. + % After the two lists have been traversed in this way, the remaining elements + % in DelOrUpd forms the new Deleted list (analogous for InsOrUpd). + % If we want to improve the performance, we could check which list is the + % shortest, since the traversing time depends on this. + Key = element(KeyNo, Data), + case searchdelete(Key, KeyNo, DelOrUpd) of + {true, NewDelOrUpd} -> + match_difflists(KeyNo, T, NewDelOrUpd, InsAcc, [Data | UpdAcc]); + {false, SameDelOrUpd} -> + match_difflists(KeyNo, T, SameDelOrUpd, [Data | InsAcc], UpdAcc) + end. + + + + +searchdelete(_Key, _ElemNo, []) -> + {false, []}; +searchdelete(Key, ElemNo, List) -> + searchdelete(Key, ElemNo, List, []). + + + + + +searchdelete(_Key, _ElemNo, [], Acc) -> + {false, Acc}; +searchdelete(Key, ElemNo, [Tuple | Tail], Acc) -> + % We don't use standard libraries, 'cause we want to make an 'atomic' + % operation, i.e., we will not search the list two times... + case (element(ElemNo, Tuple) =:= Key) of + true -> + {true, Acc ++ Tail}; % Return the list without the matching element + _Other -> + searchdelete(Key, ElemNo, Tail, [Tuple | Acc]) + end. + + + + + + + +dblist2list([]) -> + []; +dblist2list([{Data, _Color} | T]) -> + [Data | dblist2list(T)]. + + + + + + + +list2dblist([], _Color) -> + []; +list2dblist([Data | T], Color) -> + [{Data, Color} | list2dblist(T, Color)]. + + + + + + + + +update_colors([]) -> + []; +update_colors([{Data, Color} | T]) -> + [{Data, new_color(Color)} | update_colors(T)]. + + + + + + + + +new_color(?GREEN1) -> + ?GREEN2; +new_color(?GREEN2) -> + ?GREEN3; +new_color(?GREEN3) -> + ?GREEN4; +new_color(?GREEN4) -> + ?GREEN5; +new_color(?GREEN5) -> + ?DEFAULT_BTN_COLOR; +new_color(?RED1) -> + ?RED2; +new_color(?RED2) -> + ?RED3; +new_color(?RED3) -> + ?RED4; +new_color(?RED4) -> + ?RED5; +new_color(?RED5) -> + ?DEFAULT_BTN_COLOR; +new_color(_Other) -> + ?DEFAULT_BTN_COLOR. % Default shall be gray. + + + + + + + + +compute_elapsed_seconds({H1, M1, S1}, {H2, M2, S2}) -> + ElapsedHours = get_time_diff(hours, H1, H2), + ElapsedMinutes = get_time_diff(minutes, M1, M2), + ElapsedSeconds = get_time_diff(seconds, S1, S2), + (ElapsedHours * 3600) + (ElapsedMinutes * 60) + ElapsedSeconds + 1. + + + + + + + +get_time_diff(_Type, T1, T2) when T1 =< T2 -> + T2 - T1; +get_time_diff(hours, T1, T2) -> + T2 + 24 - T1; +get_time_diff(minutes, T1, T2) -> + T2 + 60 - T1; +get_time_diff(seconds, T1, T2) -> + T2 + 60 - T1. + + + + +split(_N, []) -> + {[], []}; +split(0, List) -> + {[], List}; +split(N, List) -> + split2(0, N - 1, [], List). + + + +split2(Ctr, N, Acc, [H | T]) when Ctr < N -> + split2(Ctr + 1, N, [H | Acc], T); +split2(_Ctr, _N, Acc, []) -> + {lists:reverse(Acc), []}; +split2(_Ctr, _N, Acc, List) -> + {lists:reverse(Acc), List}. + +basetype(ordered_set) -> + set; +basetype(Any) -> + Any. diff --git a/lib/tv/src/tv_db_int_def.hrl b/lib/tv/src/tv_db_int_def.hrl new file mode 100644 index 0000000000..d2cb8adee5 --- /dev/null +++ b/lib/tv/src/tv_db_int_def.hrl @@ -0,0 +1,80 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1997-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% +%%%********************************************************************* +%%% +%%% Description: Internal definitions for the database part of the table +%%% tool. +%%% +%%%********************************************************************* + +-define(WHITE, {255, 255, 255}). +-define(MEDIUM_GRAY, {170, 170, 170}). + + +-define(LIGHT_GREEN, { 0, 255, 0}). +-define(GREEN, { 50, 215, 50}). +-define(DARK_GREEN, { 50, 170, 50}). +-define(FOREST_GREEN, { 34, 139, 34}). +-define(DARK_FOREST_GREEN, { 15, 100, 15}). + + + +-define(RED, {255, 0, 0}). +-define(PINK, {255, 130, 170}). +-define(LIGHT_VIOLET, {220, 150, 225}). +-define(VIOLET, {160, 70, 180}). +-define(DARK_VIOLET, {100, 10, 130}). + + + + + + +-record(db_data, {db = [], % List containing all elements + db_size = 0, % Number of elements in 'db' + max_elem_size = 0, % Size of largest element in db. + hidden = [], % Elements (i.e., keys) not to be shown + deleted = [], % Elements just deleted + subset_size, % Size of the subset to be extracted and + % shown + subset_pos, % Position in list where subset starts + sorting = false, % Tells whether sorting is used ('true' + % or 'false') + requested_row = 0, + rev_sorting = false, % Tells whether the sorting (if any) is + % in reversed order or not ('true' or + % 'false') + sort_key_no, % Element in each tuple to use as sorting + % element + key_no, % Element in each tuple to use as key + % (this element is used when updating the + % dblist, i.e., inserting, deleting a.s.o) + ets_type % 'bag' or 'set' + }). + + +-record(process_variables, {master_pid, + etsread_pid, + db_data = #db_data{}, + list_of_keys = [], + lists_as_strings = true + }). + + + + diff --git a/lib/tv/src/tv_db_search.erl b/lib/tv/src/tv_db_search.erl new file mode 100644 index 0000000000..edd3c188e2 --- /dev/null +++ b/lib/tv/src/tv_db_search.erl @@ -0,0 +1,485 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1998-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% +%%%********************************************************************* +%%% +%%% Description: Code for the search window. +%%% +%%%********************************************************************* +-module(tv_db_search). + + + +-export([create_window/1, + resize_window/1, + reset_window/1, + destroy_window/1, + mark_busy/1, + mark_nonbusy/1, + get_input_and_search/3, + update_search/4, + string_to_term/1 + ]). + + + + +-include("tv_int_def.hrl"). +-include("tv_int_msg.hrl"). +-include("tv_db_int_def.hrl"). + + + + +-define(WIN_WIDTH, 445). +-define(SMALL_WIN_HEIGHT, 117). +-define(BIG_WIN_HEIGHT, 335). +-define(FRAME_WIDTH, 429). % 334 +-define(OLD_FRAME_WIDTH, 334). +-define(FRAME_HEIGHT, 105). +-define(FRAME_XPOS, (10-2)). +-define(FRAME_YPOS, 10). +-define(ENTRY_XPOS, 9). +-define(ENTRY_YPOS, 31). +-define(ENTRY_WIDTH, (?OLD_FRAME_WIDTH-10-2*?ENTRY_XPOS-5)). +-define(LISTBOX_WIDTH, ?WIN_WIDTH-2*?FRAME_XPOS+1). +-define(LISTBOX_HEIGHT, 162). +-define(LISTBOX_XPOS, ?FRAME_XPOS-2). +-define(LISTBOX_YPOS, ?SMALL_WIN_HEIGHT+8). +-define(BTN_WIDTH, 80). +-define(BTN_HEIGHT, 30). +-define(BTN_XPOS, ?OLD_FRAME_WIDTH-6). +-define(BG_COLOUR, {217,217,217}). + + + + + + +create_window(true) -> + gs:config(win, [raise]); +create_window(false) -> + gs:window(win, gs:start(), [{width,?WIN_WIDTH}, + {height,?SMALL_WIN_HEIGHT}, + {data,small}, + {bg,?BG_COLOUR}, + {title,"[TV] Search Object"}, + {destroy,true}, + {configure,true}, + {cursor,arrow} + ]), + + F = gs:frame(win, [{width,?FRAME_WIDTH}, + {height,?FRAME_HEIGHT}, + {x,?FRAME_XPOS}, + {y,?FRAME_YPOS}, + {bw,2}, + {bg,?BG_COLOUR} + ]), + + gs:label(F, [{width,80}, + {height,25}, + {x,?ENTRY_XPOS+2}, + {y,8}, + {align,w}, + {bg,?BG_COLOUR}, + {fg, {0,0,0}}, + {label, {text,"Search for:"}} + ]), + + gs:entry(entry, F, [{width,?ENTRY_WIDTH}, + {height,30}, + {x,?ENTRY_XPOS}, + {y,?ENTRY_YPOS}, + {insert, {0,""}}, + {bg, {255,255,255}}, + {fg, {0,0,0}}, + {cursor,text}, + {justify,left}, + {keypress,true}, + {setfocus,true} + ]), + + Group = list_to_atom("expr" ++ pid_to_list(self())), + RadioWidth = round(?ENTRY_WIDTH / 2), + gs:radiobutton(expr_term, F, [{width,RadioWidth - 45}, + {height,25}, + {x,?ENTRY_XPOS}, + {y,?ENTRY_YPOS+40}, + {group,Group}, + {align, c}, + {label,{text,"as term"}}, + {select,true} + ]), + gs:radiobutton(expr_regexp, F, [{width,RadioWidth + 45}, + {height,25}, + {x,?ENTRY_XPOS+RadioWidth-20-26}, + {y,?ENTRY_YPOS+40}, + {group,Group}, + {align,c}, + {label,{text,"as regular expression"}} + ]), + + gs:button(search, F, [{width,?BTN_WIDTH}, + {height,?BTN_HEIGHT}, + {x,?BTN_XPOS}, + {y,11}, + {label, {text,"Search"}}, + {bg,?BG_COLOUR}, + {fg, {0,0,0}} + ]), + gs:button(cancel, F, [{width,?BTN_WIDTH}, + {height,?BTN_HEIGHT}, + {x,?BTN_XPOS}, + {y,?BTN_HEIGHT+11+10}, + {label, {text,"Cancel"}}, + {data,cancel}, + {bg,?BG_COLOUR}, + {fg, {0,0,0}} + ]), + expand_window(), + gs:config(entry, [{select, {0,1000}}]), + gs:config(win, [{map,true}]). + + + + +resize_window(false) -> + done; +resize_window(true) -> + gs:config(win, [{width,?WIN_WIDTH}, + {height,?BIG_WIN_HEIGHT} + ]). + + + + +reset_window(false) -> + done; +reset_window(true) -> + gs:config(listbox, [clear]), + gs:config(objects_found, [{label, {text,""}}]). + + + + +destroy_window(false) -> + done; +destroy_window(true) -> + gs:destroy(win). + + + +mark_busy(false) -> + done; +mark_busy(true) -> + gs:config(win, [{cursor,busy}]), + gs:config(entry, [{cursor,busy}]). + + + + +mark_nonbusy(false) -> + done; +mark_nonbusy(true) -> + gs:config(win, [{cursor,arrow}]), + gs:config(entry, [{cursor,text}]). + + + + +get_input_and_search(DbList, IsRegExp, ListAsStr) -> + get_input_and_search(DbList, IsRegExp, true, ListAsStr). + + + + +get_input_and_search(DbList, IsRegExp, Notify, ListAsStr) -> + Str = get_entry_text(), + StrConvRes = case IsRegExp of + true -> + string_to_regexp(Str); + false -> + string_to_term(Str) + end, + + case StrConvRes of + {ok, TermOrRE} -> + search(IsRegExp, TermOrRE, DbList, ListAsStr); + {error, {_Reason, Msg}} when Notify -> + gs:config(win, [beep]), + tv_utils:notify(win, "TV Notification", Msg); + {error, {_Reason, _Msg}} -> + done + end. + + + +update_search(false, _DbList, _IsRegExp, _ListAsStr) -> + done; +update_search(true, DbList, true, ListAsStr) -> + get_input_and_search(DbList, false, false, ListAsStr); +update_search(true, DbList, false, ListAsStr) -> + get_input_and_search(DbList, true, false, ListAsStr). + + + +get_entry_text() -> + gs:read(entry,text). + + + +string_to_regexp(Str) -> + case regexp:parse(Str) of + {ok, RegExp} -> + {ok, RegExp}; + _Error -> + case get(error_msg_mode) of + normal -> + {error, {not_a_regexp, "Please enter a regular expression!"}}; + haiku -> + {error, {not_a_regexp, ["Being incorrect", + "The regular expression", + "Must now be retyped."]}} + end + end. + + + +string_to_term(Str) -> + case catch erl_scan:string(Str ++ ". ") of + {ok, ScannedStr, _No} -> + case erl_parse:parse_term(ScannedStr) of + {ok, Term} -> + {ok, Term}; + _Other -> + %% May be a PID, have to check this, since erl_scan + %% currently cannot handle this case... :-( + case catch list_to_pid(Str) of + Pid when is_pid(Pid) -> + {ok, Pid}; + _Error -> + case get(error_msg_mode) of + normal -> + {error, {not_a_term, "Please enter a valid term!"}}; + haiku -> + {error, {not_a_term, ["Aborted effort.", + "Reflect, repent and retype:", + "Enter valid term."]}} + end + end + end; + _Error -> + case get(error_msg_mode) of + normal -> + {error, {not_a_term, "Please enter a valid term!"}}; + haiku -> + {error, {not_a_term, ["Aborted effort.", + "Reflect, repent and retype:", + "Enter valid term."]}} + end + end. + + + +search(IsRegExp, SearchValue, DbList, ListAsStr) -> + gs:config(cancel, [{label, {text,"Stop"}}]), + mark_busy(true), + reset_window(true), + SearchRes = traverse(SearchValue, DbList, 1, length(DbList), [], IsRegExp, ListAsStr), + gs:config(cancel, [{label, {text,"Cancel"}}]), + mark_nonbusy(true), + SearchRes. + + + + + +expand_window() -> + gs:listbox(listbox, win, [{width,?LISTBOX_WIDTH}, + {height,?LISTBOX_HEIGHT}, + {x,?LISTBOX_XPOS}, + {y,?LISTBOX_YPOS}, + {bg, {255,255,255}}, + {fg, {0,0,0}}, + {scrollbg,?BG_COLOUR}, + {scrollfg,?BG_COLOUR}, + {hscroll,bottom}, + {vscroll,right}, + {click,true}, + {doubleclick,false}, + {selectmode,single} + ]), + gs:label(objects_found, win, [{width,?LISTBOX_WIDTH}, + {height,25}, + {x,?LISTBOX_XPOS}, + {y,?LISTBOX_YPOS+?LISTBOX_HEIGHT+13}, + {align,w}, + {bg,?BG_COLOUR}, + {fg, {0,0,0}} + ]), + gs:config(win, [{width,?WIN_WIDTH}, + {height,?BIG_WIN_HEIGHT} + ]). + + + + + + + +traverse(Pattern, [Object | T], Row, Length, Acc, IsRegExp, ListAsStr) -> + SearchRes = + case IsRegExp of + true -> + search_for_regexp(Pattern, Object, ListAsStr); + false -> + compare_terms(Pattern, Object) + end, + + NewAcc + = case SearchRes of + found -> + RowStr = integer_to_list(Row), + LengthStr = integer_to_list(Length), + ObjectStr = case ListAsStr of + true -> + lists:flatten(tv_io_lib:format("~p", [Object])); + false -> + lists:flatten(tv_io_lib:write(Object)) + end, + + gs:config(listbox, + [{add, + " Row " ++ RowStr ++ ":" ++ + lists:duplicate(length(LengthStr)-length(RowStr), " ") ++ + " " ++ ObjectStr} + ]), + gs:config(objects_found, + [{label, + {text,integer_to_list(length(Acc)+1) ++ + " object(s) found"}} + ]), + [{Row,Object} | Acc]; + not_found -> + Acc + end, + receive + {gs,cancel,click,_Data,_Args} -> + gs:config(objects_found, + [{label, + {text,integer_to_list(gs:read(listbox,size)) ++ + " object(s) found"}} + ]), + lists:reverse(NewAcc) + after + 0 -> + traverse(Pattern, T, Row+1, Length, NewAcc, IsRegExp, ListAsStr) + end; +traverse(_Pattern, [], _N, _Length, Acc, _IsRegExp, _ListAsStr) -> + gs:config(objects_found, + [{label, + {text,integer_to_list(gs:read(listbox,size)) ++ + " object(s) found"}} + ]), + lists:reverse(Acc). + + + + +search_for_regexp(Pattern, Elem, ListAsStr) -> + ListToSearch = + case ListAsStr of + true -> + lists:flatten(tv_io_lib:format("~p", [Elem])); + false -> + lists:flatten(tv_io_lib:write(Elem)) + end, + + case regexp:first_match(ListToSearch, Pattern) of + {match, _, _} -> + found; + _Other -> + not_found + %% The code below shall be used instead if it is desired to + %% compare each *element* in the tuples to the regular expression, + %% i.e., treat each element as a new line/string. + %% The difference is most easily explained through an example: + %% If we treat each tuple as a new line/string, the regular expression + %% "^{win" will match the string "{win, 1, 2, 3}", but not the string + %% "{1, {win,2}}". + %% If we treat each element as a new line/string, the RE "^{win" will match + %% both strings above. + + %% SearchList = tuple_to_list(Elem), + %% case lists:dropwhile( + %% fun(H) -> + %% nomatch == regexp:first_match(lists:flatten(io_lib:write(H)), + %% Pattern) + %% end, + %% SearchList) of + %% [] -> + %% not_found; + %% _AnyList -> + %% found + %% end + end. + + + + + +compare_terms(Term, Elem) when not is_tuple(Elem), not is_list(Elem), Term =/= Elem -> + not_found; +compare_terms(Term, Term) -> + %% Even the case Term = "{}" or "[]"!!! + found; +compare_terms(Term, Elem) when is_list(Elem) -> + traverse_list(Term, Elem); +compare_terms(Term, Elem) when is_tuple(Elem) -> + traverse_tuple(Term, Elem, 1, size(Elem)). + + + + + +traverse_tuple(Pattern, Tuple, N, Stop) when N =< Stop -> + Elem = element(N,Tuple), + case compare_terms(Pattern, Elem) of + found -> + found; + not_found -> + traverse_tuple(Pattern, Tuple, N+1, Stop) + end; +traverse_tuple(_Pattern, _Tuple, N, Stop) when N > Stop -> + not_found. + + + + + + +traverse_list(Pattern, [H | T]) -> + case compare_terms(Pattern, H) of + found -> + found; + not_found -> + traverse_list(Pattern, T) + end; +traverse_list(_Pattern, []) -> + not_found. + diff --git a/lib/tv/src/tv_db_sort.erl b/lib/tv/src/tv_db_sort.erl new file mode 100644 index 0000000000..3675c7b413 --- /dev/null +++ b/lib/tv/src/tv_db_sort.erl @@ -0,0 +1,141 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1997-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% +-module(tv_db_sort). + + + +-export([mergesort/3, merge/4, get_compare_value/2]). + + + + + +%%%********************************************************************* +%%% EXTERNAL FUNCTIONS +%%%********************************************************************* + + + + + +mergesort(_KeyNo, [X], _ReverseOrder) -> + [X]; +mergesort(_KeyNo, [], _ReverseOrder) -> + []; +mergesort(KeyNo, X, ReverseOrder) -> + split(KeyNo, X, [], [], ReverseOrder). + + + + + + + + + %% If we want reverse order when just merging two lists, + %% each of them has to be in reverse order first! + +merge(KeyNo, [{E1, C1} | T1], [{E2, C2} | T2], Reverse) when not Reverse -> + K1 = get_compare_value(KeyNo, E1), + K2 = get_compare_value(KeyNo, E2), + case get_correct_order(K1, E1, K2, E2) of + {1, 2} -> + [{E1, C1} | merge(KeyNo, T1, [{E2, C2} | T2], Reverse)]; + {2, 1} -> + [{E2, C2} | merge(KeyNo, [{E1, C1} | T1], T2, Reverse)] + end; +merge(KeyNo, [{E1, C1} | T1], [{E2, C2} | T2], Reverse) -> + K1 = get_compare_value(KeyNo, E1), + K2 = get_compare_value(KeyNo, E2), + case get_correct_order(K1, E1, K2, E2) of + {1, 2} -> + [{E2, C2} | merge(KeyNo, [{E1, C1} | T1], T2, Reverse)]; + {2, 1} -> + [{E1, C1} | merge(KeyNo, T1, [{E2, C2} | T2], Reverse)] + end; +merge(_KeyNo, [], L2, _Reverse) -> % L2 may be the empty list also! + L2; +merge(_KeyNo, L1, [], _Reverse) -> % L1 may be the empty list also! + L1. + + + + + + +get_compare_value(KeyNo, E) when is_tuple(E) -> + case catch element(KeyNo, E) of + {'EXIT', {badarg, {?MODULE, get_compare_value, [KeyNo, E]}}} -> + short_tuple; + V -> + {tuple, V} + end; +get_compare_value(_KeyNo, _E) -> + no_tuple. + + + + + + + + + + +%%%******************************************************************** +%%% INTERNAL FUNCTIONS +%%%******************************************************************** + + + + +split(KeyNo, [A,B|T], X, Y, Reverse) -> + split(KeyNo, T, [A|X], [B|Y], Reverse); +split(KeyNo, [H], X, Y, Reverse) -> + split(KeyNo, [], [H|X], Y, Reverse); +split(KeyNo, [], X, Y, Reverse) -> + merge(KeyNo, + mergesort(KeyNo, X, Reverse), + mergesort(KeyNo, Y, Reverse), + Reverse). + + + + + + +get_correct_order({tuple, V1}, _E1, {tuple, V2}, _E2) when V1 < V2 -> + {1, 2}; +get_correct_order({tuple, _V1}, _E1, {tuple, _V2}, _E2) -> + {2, 1}; +get_correct_order(short_tuple, _E1, {tuple, _V2}, _E2) -> + {1, 2}; +get_correct_order({tuple, _V1}, _E1, short_tuple, _E2) -> + {2, 1}; +get_correct_order(short_tuple, E1, short_tuple, E2) when E1 < E2 -> + {1, 2}; +get_correct_order(short_tuple, _E1, short_tuple, _E2) -> + {2, 1}; +get_correct_order(no_tuple, E1, no_tuple, E2) when E1 < E2 -> + {1, 2}; +get_correct_order(no_tuple, _E1, no_tuple, _E2) -> + {2, 1}; +get_correct_order(_Anything, _E1, no_tuple, _E2) -> % Tuples first, then other + {1, 2}; % terms in correct order! +get_correct_order(no_tuple, _E1, _Anything, _E2) -> + {2, 1}. diff --git a/lib/tv/src/tv_ets_rpc.erl b/lib/tv/src/tv_ets_rpc.erl new file mode 100644 index 0000000000..ec2fde30ac --- /dev/null +++ b/lib/tv/src/tv_ets_rpc.erl @@ -0,0 +1,140 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1998-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% +-module(tv_ets_rpc). + + + +-export([all/2, + info/4, + new/4, + tab2list/3, + insert/4, + lookup/4, + delete/4 + ]). + + + + +all(_Node, true) -> + chk(catch ets:all()); +all(Node, false) -> + chk(catch rpc:block_call(Node, ets, all, [])). + + + + +info(_Node, true, TabId, What) -> + chk(catch ets:info(TabId, What)); +info(Node, false, TabId, What) -> + chk(catch rpc:block_call(Node, ets, info, [TabId, What])). + + + + +new(_Node, true, TabName, Options) -> + case catch ets:new(TabName, Options) of + {TabName, Pid} when is_pid(Pid) -> + {TabName,Pid}; + {TabNo, Pid} when is_pid(Pid) -> + {TabNo,Pid}; + OtherResult -> + chk(OtherResult) + end; +new(Node, false, TabName, Options) -> + case catch rpc:block_call(Node, ets, new, [TabName, Options]) of + {TabName, Pid} when is_pid(Pid) -> + {TabName,Pid}; + {TabNo, Pid} when is_pid(Pid) -> + {TabNo, Pid}; + OtherResult -> + chk(OtherResult) + end. + + + + +tab2list(_Node, true, TabId) -> + chk(catch ets:tab2list(TabId)); +tab2list(Node, false, TabId) -> + chk(catch rpc:call(Node, ets, tab2list, [TabId])). + + + + +insert(_Node, true, TabId, Object) -> + chk(catch ets:insert(TabId, Object)); +insert(Node, false, TabId, Object) -> + chk(catch rpc:call(Node, ets, insert, [TabId, Object])). + + + + +lookup(_Node, true, TabId, Key) -> + chk(catch ets:lookup(TabId, Key)); +lookup(Node, false, TabId, Key) -> + chk(catch rpc:call(Node, ets, lookup, [TabId, Key])). + + + + +delete(_Node, true, TabId, Key) -> + chk(catch ets:delete(TabId, Key)); +delete(Node, false, TabId, Key) -> + chk(catch rpc:call(Node, ets, delete, [TabId, Key])). + + + + +chk(Result) -> + case Result of + undefined -> + throw(no_table); + _Anything when is_list(Result) -> + Result; + _Anything when is_atom(Result) -> + Result; + _Anything when is_integer(Result) -> + Result; + _Anything when is_pid(Result) -> + Result; + + %% Messages received when node is down. + {badrpc, nodedown} -> + throw(nodedown); + {'EXIT', nodedown} -> + throw(nodedown); + {'EXIT', {{badarg, {gen, set_monitor_node, _Args}}, _Reason}} -> + throw(nodedown); + + %% Messages received when table doesn't exist. + {'EXIT', {badarg, {ets,local_info,_Args}}} -> + %% Due to inconsistencies in R2D and earlier versions: + %% ets:info/1 returned 'undefined' when table didn't + %% exist, while ets:info/2 returned the exit-signal + %% above. This was corrected in R3A - now both functions + %% return 'undefined' :-) + throw(no_table); + {badrpc, {'EXIT', {badarg,_Reason}}} -> + throw(no_table); + {'EXIT', {badarg,_Reason}} -> + throw(no_table); + Error when is_tuple(Error) -> + throw({unexpected_error,Error}) + end. + diff --git a/lib/tv/src/tv_etsread.erl b/lib/tv/src/tv_etsread.erl new file mode 100644 index 0000000000..d3240ef513 --- /dev/null +++ b/lib/tv/src/tv_etsread.erl @@ -0,0 +1,767 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1997-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% +%%%********************************************************************* +%%% +%%% Description: Module containing the interface towards ETS tables, +%%% i.e., handling the polling and thereafter sending the +%%% result to the database part of the table tool. +%%% +%%%********************************************************************* + + +-module(tv_etsread). + + + +-export([etsread/2]). + + + +-include("tv_int_def.hrl"). +-include("tv_int_msg.hrl"). + + + + + + +%%%********************************************************************* +%%% EXTERNAL FUNCTIONS +%%%********************************************************************* + + + + +etsread(MasterPid, ErrorMsgMode) -> + process_flag(trap_exit, true), + put(error_msg_mode, ErrorMsgMode), + blocked(MasterPid). + + + + + +%%%********************************************************************* +%%% INTERNAL FUNCTIONS +%%%********************************************************************* + + + +blocked(MasterPid) -> + receive + Msg -> + case Msg of + + #etsread_deblock{} -> + deblock(Msg, MasterPid); + + {'EXIT', Pid, Reason} -> + exit_signals({Pid, Reason}, MasterPid), + blocked(MasterPid); + + {error_msg_mode, Mode} -> + put(error_msg_mode, Mode), + blocked(MasterPid); + + _Other -> + %% io:format("Received signal ~p~n", [_Other]), + blocked(MasterPid) + end + end. + + + + + + + +deblock(Msg, MasterPid) -> + #etsread_deblock{dbs_pid = DbsPid, + table_type = KindOfTable, + node = Node, + local_node = LocalNode, + table_id = TableId, + poll_interval = PollInt} = Msg, + PollInterval = case PollInt of + infinity -> + PollInt; + _Other -> + PollInt * 1000 + end, + %% Get table info! + case catch get_table_info(Node, LocalNode, TableId, KindOfTable) of + nodedown -> + MasterPid ! #pc_nodedown{sender = self(), + automatic_polling = false}, + blocked(MasterPid); + no_table -> + MasterPid ! #pc_dead_table{sender = self(), + automatic_polling = false}, + blocked(MasterPid); + mnesia_not_started -> + MasterPid ! #pc_dead_table{sender = self(), + automatic_polling = false}, + blocked(MasterPid); + {unexpected_error,_Reason} -> + MasterPid ! #pc_dead_table{sender = self(), + automatic_polling = false}, + blocked(MasterPid); + {Type, Pos, Protection} -> + MasterPid ! #etsread_deblock_cfm{sender = self(), + type = Type, + keypos = Pos, + protection = Protection + }, + + timer:sleep(500), + case catch read_table(Node, LocalNode, TableId, KindOfTable, DbsPid) of + nodedown -> + MasterPid ! #pc_nodedown{sender = self(), + automatic_polling = false}, + blocked(MasterPid); + no_table -> + MasterPid ! #pc_dead_table{sender = self(), + automatic_polling = false}, + blocked(MasterPid); + mnesia_not_started -> + MasterPid ! #pc_dead_table{sender = self(), + automatic_polling = false}, + blocked(MasterPid); + {unexpected_error,_Reason} -> + MasterPid ! #pc_dead_table{sender = self(), + automatic_polling = false}, + blocked(MasterPid); + _ElapsedTime -> + deblocked_loop(MasterPid, DbsPid, Node, LocalNode, TableId, + KindOfTable, PollInterval) + end + end. + + + + + + +get_table_info(Node, LocalNode, TableId, KindOfTable) -> + case KindOfTable of + ets -> + % Check whether table is 'bag' or 'set' type. + Type = tv_ets_rpc:info(Node, LocalNode, TableId, type), + % Get position for the key. + Pos = tv_ets_rpc:info(Node, LocalNode, TableId, keypos), + Protection = tv_ets_rpc:info(Node, LocalNode, TableId, protection), + {Type, Pos, Protection}; + mnesia -> + Type = tv_mnesia_rpc:table_info(Node, LocalNode, TableId, type), + Pos = 2, + %% All Mnesia tables are regarded as being public! + {Type, Pos, public} + end. + + + + + + +deblocked_loop(MasterPid,DbsPid,Node,LocalNode,TableId,KindOfTable,PollInterval) -> + receive + Msg -> + + case Msg of + + #etsread_poll_table{} -> + case catch read_table(Node, LocalNode, TableId, KindOfTable, DbsPid) of + %% No automatic polling here! + nodedown -> + MasterPid ! #pc_nodedown{sender = self(), + automatic_polling = false}; + no_table -> + MasterPid ! #pc_dead_table{sender = self(), + automatic_polling = false}; + mnesia_not_started -> + MasterPid ! #pc_dead_table{sender = self(), + automatic_polling = false}; + {unexpected_error,_Reason} -> + MasterPid ! #pc_dead_table{sender = self(), + automatic_polling = false}; + _ElapsedTime -> + done + end, + deblocked_loop(MasterPid, DbsPid, Node, LocalNode, + TableId, KindOfTable, PollInterval); + + + #etsread_set_poll_interval{interval = PollInt} -> + NewPollInterval = case PollInt of + infinity -> + PollInt; + _Other -> + PollInt * 1000 + end, + deblocked_loop(MasterPid, DbsPid, Node, LocalNode, + TableId, KindOfTable, NewPollInterval); + + + #etsread_deblock{} -> + deblock(Msg, MasterPid); + + + #etsread_update_object{key_no=KeyNo, object=Obj, old_object=OldObj} -> + update_object(KindOfTable, Node, LocalNode, TableId, DbsPid, + KeyNo, Obj, OldObj, MasterPid, PollInterval), + deblocked_loop(MasterPid, DbsPid, Node, LocalNode, TableId, KindOfTable, + PollInterval); + + + #etsread_new_object{object=Obj} -> + new_object(KindOfTable, Node, LocalNode, TableId, DbsPid, + Obj, MasterPid, PollInterval), + deblocked_loop(MasterPid, DbsPid, Node, LocalNode, TableId, KindOfTable, + PollInterval); + + + #etsread_delete_object{object=Obj} -> + delete_object(KindOfTable, Node, LocalNode, TableId, DbsPid, + Obj, MasterPid, PollInterval), + deblocked_loop(MasterPid, DbsPid, Node, LocalNode, TableId, KindOfTable, + PollInterval); + + + #ip_dead_table{} -> + AutoPoll = case PollInterval of + infinity -> + false; + _Other -> + true + end, + MasterPid ! #pc_dead_table{sender = self(), + automatic_polling = AutoPoll}, + deblocked_loop(MasterPid, DbsPid, Node, LocalNode, TableId, + KindOfTable, infinity); + + + #etsread_nodedown{} -> + AutoPoll = case PollInterval of + infinity -> + false; + _Other -> + true + end, + MasterPid ! #pc_nodedown{sender = self(), + automatic_polling = AutoPoll}, + deblocked_loop(MasterPid, DbsPid, Node, LocalNode, TableId, + KindOfTable, infinity); + + + {error_msg_mode, Mode} -> + put(error_msg_mode, Mode), + deblocked_loop(MasterPid, DbsPid, Node, LocalNode, TableId, KindOfTable, + PollInterval); + + + {'EXIT', Pid, Reason} -> + exit_signals({Pid, Reason}, MasterPid), + deblocked_loop(MasterPid, DbsPid, Node, LocalNode, + TableId, KindOfTable, PollInterval) + end + + after PollInterval -> + %% Automatic polling must be on, otherwise these + %% lines would never be executed! + NewPollInterval = + case catch read_table(Node,LocalNode,TableId,KindOfTable,DbsPid) of + nodedown -> + MasterPid ! #pc_nodedown{sender = self(), + automatic_polling = true}, + infinity; + no_table -> + MasterPid ! #pc_dead_table{sender = self(), + automatic_polling = true}, + infinity; + mnesia_not_started -> + MasterPid ! #pc_dead_table{sender = self(), + automatic_polling = true}, + infinity; + {unexpected_error,_Reason} -> + MasterPid ! #pc_dead_table{sender = self(), + automatic_polling = true}, + infinity; + ElapsedMilliseconds -> + if + (ElapsedMilliseconds * 1000) >= PollInterval -> + infinity; + true -> + PollInterval + end + end, + deblocked_loop(MasterPid, DbsPid, Node, LocalNode, + TableId, KindOfTable, NewPollInterval) + end. + + + + + +exit_signals(ExitInfo, MasterPid) -> + case ExitInfo of + {MasterPid, _Reason} -> + exit(normal); + _Other -> + done + end. + + + + +update_object(KindOfTable, Node, LocalNode, TableId, DbsPid, KeyNo, Obj, OldObj, MasterPid, PollInterval) -> + AutoPoll = + case PollInterval of + infinity -> + false; + _Other -> + true + end, + case check_record_format(KindOfTable, Node, LocalNode, TableId, Obj) of + bad_format -> + DbsPid ! #etsread_update_object_cfm{sender = self(), + success = false}; + ok -> + %% Check that we are allowed to edit the table! + case catch update_object2(KindOfTable, Node, LocalNode, TableId, DbsPid, KeyNo, + Obj, OldObj) of + + nodedown -> + DbsPid ! #etsread_update_object_cfm{sender = self(), + success = false}, + MasterPid ! #pc_nodedown{sender = self(), + automatic_polling = AutoPoll}; + + no_table -> + DbsPid ! #etsread_update_object_cfm{sender = self(), + success = false}, + MasterPid ! #pc_dead_table{sender = self(), + automatic_polling = AutoPoll}; + + mnesia_not_started -> + DbsPid ! #etsread_update_object_cfm{sender = self(), + success = false}, + MasterPid ! #pc_dead_table{sender = self(), + automatic_polling = AutoPoll}; + + + {unexpected_error,_Reason} -> + DbsPid ! #etsread_update_object_cfm{sender = self(), + success = false}, + MasterPid ! #pc_dead_table{sender = self(), + automatic_polling = AutoPoll}; + + ok -> + DbsPid ! #etsread_update_object_cfm{sender = self(), + success = true} + end + end. + + + + + +update_object2(ets, Node, LocalNode, Tab, _DbsPid, KeyNo, Obj, OldObj) -> + %% We shall update a specific object! If the table is a 'set' table, + %% it is just to insert the altered object. However, if the table + %% is a 'bag', or a 'duplicate_bag', we first have to remove the + %% old object, and then insert the altered one. + %% But, we aren't finished with that... we also want to preserve + %% the time order, meaning we have to delete *ALL* objects having the + %% very same key, and then insert them again! (Actually we would have + %% to do this anyhow, due to limitations in the interface functions, + %% but this remark has to be noted!) + OldKey = element(KeyNo, OldObj), + InsertList = + case tv_ets_rpc:info(Node, LocalNode, Tab, type) of + set -> + %% Have to remove old object, because the key may be what's changed. + tv_ets_rpc:delete(Node, LocalNode, Tab, OldKey), + [Obj]; + ordered_set -> + %% Have to remove old object, because the key may be what's changed. + tv_ets_rpc:delete(Node, LocalNode, Tab, OldKey), + [Obj]; + _Other -> %% 'bag' or 'duplicate_bag' + OldList = tv_ets_rpc:lookup(Node, LocalNode, Tab, OldKey), + tv_ets_rpc:delete(Node, LocalNode, Tab, OldKey), + %% Have to beware of duplicate_bag tables, + %% i.e., the same object may occur more than + %% once, but we only want to replace it once! + {_Replaced, TmpList} = + lists:foldl( + fun(Data, {Replaced,Acc}) when Data =/= OldObj -> + {Replaced, [Data | Acc]}; + (_Data, {Replaced,Acc}) when not Replaced -> + {true, [Obj | Acc]}; + (Data, {Replaced,Acc}) -> + {Replaced, [Data | Acc]} + end, + {false, []}, + OldList), + lists:reverse(TmpList) + end, + lists:foreach(fun(H) -> + tv_ets_rpc:insert(Node, LocalNode, Tab, H) + end, + InsertList), + ok; +update_object2(mnesia, Node, LocalNode, Tab, _DbsPid, KeyNo, Obj, OldObj) -> + OldKey = element(KeyNo, OldObj), + InsertList = + case tv_mnesia_rpc:table_info(Node, LocalNode, Tab, type) of + set -> + tv_mnesia_rpc:transaction( + Node, + LocalNode, + fun() -> + mnesia:delete(Tab,OldKey,write) + end), + [Obj]; + ordered_set -> + tv_mnesia_rpc:transaction( + Node, + LocalNode, + fun() -> + mnesia:delete(Tab,OldKey,write) + end), + [Obj]; + _Other -> %% 'bag' or 'duplicate_bag' + {atomic, OldList} = + tv_mnesia_rpc:transaction( + Node, + LocalNode, + fun() -> + mnesia:read(Tab,OldKey,read) + end), + %% We can't use mnesia:delete_object here, because + %% time order wouldn't be preserved then!!! + tv_mnesia_rpc:transaction( + Node, + LocalNode, + fun() -> + mnesia:delete(Tab,OldKey,write) + end), + ChangeFun = + fun(H) when H =:= OldObj -> + Obj; + (H) -> + H + end, + [ChangeFun(X) || X <- OldList] + end, + lists:foreach(fun(H) -> + tv_mnesia_rpc:transaction( + Node, + LocalNode, + fun() -> + %% This mnesia call shall not be distributed, + %% since the transaction sees to that it is + %% executed on the right node!!! + mnesia:write(Tab,H,write) + end) + end, + InsertList), + ok. + + + + + + +delete_object(KindOfTable, Node, LocalNode, TableId, DbsPid, Obj, MasterPid, PollInterval) -> + AutoPoll = + case PollInterval of + infinity -> + false; + _Other -> + true + end, + case catch delete_object2(KindOfTable, Node, LocalNode, TableId, DbsPid, Obj) of + + nodedown -> + DbsPid ! #etsread_delete_object_cfm{sender = self(), + success = false}, + MasterPid ! #pc_nodedown{sender = self(), + automatic_polling = AutoPoll}; + + no_table -> + DbsPid ! #etsread_delete_object_cfm{sender = self(), + success = false}, + MasterPid ! #pc_dead_table{sender = self(), + automatic_polling = AutoPoll}; + + mnesia_not_started -> + DbsPid ! #etsread_delete_object_cfm{sender = self(), + success = false}, + MasterPid ! #pc_dead_table{sender = self(), + automatic_polling = AutoPoll}; + + {unexpected_error,_Reason} -> + DbsPid ! #etsread_delete_object_cfm{sender = self(), + success = false}, + MasterPid ! #pc_dead_table{sender = self(), + automatic_polling = AutoPoll}; + + ok -> + DbsPid ! #etsread_delete_object_cfm{sender = self(), + success = true} + end. + + + + +delete_object2(ets, Node, LocalNode, Tab, _DbsPid, Obj) -> + KeyNo = tv_ets_rpc:info(Node, LocalNode, Tab, keypos), + Key = element(KeyNo, Obj), + InsertList = + case tv_ets_rpc:info(Node, LocalNode, Tab, type) of + set -> + %% Have to remove old object, because the key may be what's changed. + tv_ets_rpc:delete(Node, LocalNode, Tab, Key), + []; + ordered_set -> + %% Have to remove old object, because the key may be what's changed. + tv_ets_rpc:delete(Node, LocalNode, Tab, Key), + []; + _Other -> %% 'bag' or 'duplicate_bag' + OldList = tv_ets_rpc:lookup(Node, LocalNode, Tab, Key), + tv_ets_rpc:delete(Node, LocalNode, Tab, Key), + OldList -- [Obj] + end, + + lists:foreach(fun(H) -> + tv_ets_rpc:insert(Node, LocalNode, Tab, H) + end, + InsertList), + ok; +delete_object2(mnesia, Node, LocalNode, Tab, _DbsPid, Obj) -> + tv_mnesia_rpc:transaction( + Node, + LocalNode, + fun() -> + %% This mnesia call shall not be distributed, + %% since the transaction sees to that it is + %% executed on the right node!!! + mnesia:delete_object(Tab,Obj,write) + end), + ok. + + + + + +new_object(KindOfTable, Node, LocalNode, TableId, DbsPid, Obj, MasterPid, PollInterval) -> + AutoPoll = + case PollInterval of + infinity -> + false; + _Other -> + true + end, + case check_record_format(KindOfTable, Node, LocalNode, TableId, Obj) of + bad_format -> + DbsPid ! #etsread_new_object_cfm{sender = self(), + success = false}; + ok -> + %% Check that we are allowed to edit the table! + case catch new_object2(KindOfTable, Node, LocalNode, TableId, DbsPid, Obj) of + + nodedown -> + DbsPid ! #etsread_new_object_cfm{sender = self(), + success = false}, + MasterPid ! #pc_nodedown{sender = self(), + automatic_polling = AutoPoll}; + + no_table -> + DbsPid ! #etsread_new_object_cfm{sender = self(), + success = false}, + MasterPid ! #pc_dead_table{sender = self(), + automatic_polling = AutoPoll}; + + mnesia_not_started -> + DbsPid ! #etsread_new_object_cfm{sender = self(), + success = false}, + MasterPid ! #pc_dead_table{sender = self(), + automatic_polling = AutoPoll}; + + {unexpected_error,_Reason} -> + DbsPid ! #etsread_new_object_cfm{sender = self(), + success = false}, + MasterPid ! #pc_dead_table{sender = self(), + automatic_polling = AutoPoll}; + + ok -> + DbsPid ! #etsread_new_object_cfm{sender = self(), + success = true} + end + end. + + + + + +new_object2(ets, Node, LocalNode, Tab, _DbsPid, Obj) -> + tv_ets_rpc:insert(Node, LocalNode, Tab, Obj), + ok; +new_object2(mnesia, Node, LocalNode, Tab, _DbsPid, Obj) -> + tv_mnesia_rpc:transaction( + Node, + LocalNode, + fun() -> + %% This mnesia call shall not be distributed, + %% since the transaction sees to that it is + %% executed on the right node!!! + mnesia:write(Tab,Obj,write) + end), + ok. + + + + + +check_record_format(mnesia, Node, LocalNode, Tab, Obj) -> + Arity = tv_mnesia_rpc:table_info(Node, LocalNode, Tab, arity), + case size(Obj) of + Arity -> + ok; + _Other -> + gs:window(etsreadwin, gs:start(), []), + case get(error_msg_mode) of + normal -> + tv_utils:notify(etsreadwin, "TV Notification", + ["The record is not complete,", + "too few fields are specified!"]); + haiku -> + tv_utils:notify(etsreadwin, "TV Notification", + ["The attempt to change", + "The specified record size", + "Is simply ignored."]) + end, + gs:destroy(etsreadwin), + bad_format + end; +check_record_format(ets, _Node, _LocalNode, _Tab, _Obj) -> + ok. + + + + + + + +read_table(Node, LocalNode, Tab, KindOfTable, DbsPid) -> + T1 = time(), + + {TableContent, ListOfKeys} = + case KindOfTable of + ets -> + {tv_ets_rpc:tab2list(Node, LocalNode, Tab), + [tv_ets_rpc:info(Node, LocalNode, Tab, keypos)] + }; + mnesia -> + %% It may be tempting to use Mnesia event subscription, + %% but will this really save the day? The main drawback + %% is that we will then have to update the table copy we + %% store internally in two different ways: one for the + %% Mnesia tables, and one for the ETS tables. Also, if + %% the Mnesia tables are frequently updated, this will + %% cause TV to work all the time too (either updating the + %% table copy for each inserted/deleted object, or storing + %% these objects until polling is ordered). To make this + %% work smoothly requires a bit of work... + %% The second drawback is that it doesn't seem clear in all + %% circumstances how the subscription actually works - i.e., + %% if we only use subscriptions, can we actually be sure that + %% the *real* state of the table is the same as the one kept + %% in TV? For example, imagine the scenario that Mnesia is + %% stopped, all Mnesia directories are removed (from the UNIX + %% shell), and then Mnesia once again is started. The first + %% problem is that we have to check for start/stop of Mnesia, + %% the second is that we then have to rescan the actual table. + %% The logic for this may require som effort to write! + %% Also, what will happen if the table is killed/dies? + %% Will we get messages for each element in the table? + %% (I havent't checked this last issue, this is just som thoughts.) + %% And generally, there is always a risk that a message is lost, + %% which will result in TV showing an erroneous table content. + %% + %% All in all, using Mnesia subscriptions *may* be a sub-optimization. + %% The current solution works fine, is also easy to control, and is + %% mainly the same for both ETS and Mnesia tables. + %% My suggestion is that it is used until someone actually complains + %% about the polling time being too long for huge tables! :-) + %% (However, it shall be emphasized that it is this module that + %% actually polls the Mnesia/ETS tables, meaning that it is + %% mainly this module that has to be modified, should the usage of + %% subscriptions be desired. The other module that has to be modified + %% is the one maintaining the internal copy of the table.) + WildPattern = tv_mnesia_rpc:table_info(Node,LocalNode,Tab,wild_pattern), + {atomic, Content} = + tv_mnesia_rpc:transaction( + Node, + LocalNode, + fun() -> + %% This mnesia call shall not be distributed, + %% since the transaction sees to that it is + %% executed on the right node!!! + mnesia:match_object(Tab, WildPattern, read) + end), + {Content, [2 | tv_mnesia_rpc:table_info(Node, LocalNode,Tab, index)]} + end, + + T2 = time(), + + ElapsedTime = compute_elapsed_seconds(T1, T2), + + DbsPid ! #dbs_new_data{sender = self(), + data = TableContent, + keys = ListOfKeys, + time_to_read_table = ElapsedTime + }, + + ElapsedTime. + + + + + + + +compute_elapsed_seconds({H1, M1, S1}, {H2, M2, S2}) -> + ElapsedHours = get_time_diff(hours, H1, H2), + ElapsedMinutes = get_time_diff(minutes, M1, M2), + ElapsedSeconds = get_time_diff(seconds, S1, S2), + (ElapsedHours * 3600) + (ElapsedMinutes * 60) + ElapsedSeconds + 1. + + + + + +get_time_diff(_Type, T1, T2) when T1 =< T2 -> + T2 - T1; +get_time_diff(hours, T1, T2) -> + T2 + 24 - T1; +get_time_diff(minutes, T1, T2) -> + T2 + 60 - T1; +get_time_diff(seconds, T1, T2) -> + T2 + 60 - T1. diff --git a/lib/tv/src/tv_info.erl b/lib/tv/src/tv_info.erl new file mode 100644 index 0000000000..7bc31e35cd --- /dev/null +++ b/lib/tv/src/tv_info.erl @@ -0,0 +1,876 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1997-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% +-module(tv_info). + + + +-export([info/6 + ]). + + +-include("tv_int_def.hrl"). +-include("tv_int_msg.hrl"). + + + + +-define(DEFAULT_BG_COLOR, {217, 217, 217}). + + +-record(card_field_ids, {parent_pid, + window_id, + window_frame, + table_id, + table_type, + table_name, + named_table, + owner_pid, + owner_name, + bag_or_set, + arity, + attributes, + wild_pattern, + keypos, + index, + snmp, + protection, + size, + memory, + storage_type, + disc_copies, + where_to_read, + ram_copies, + disc_only_copies, + where_to_write, + checkpoints, + node + }). + + + +-define(WINDOW_WIDTH, 580). +-define(WINDOW_HEIGHT, 430). + + + +-define(MNESIA_INFO_ITEMS, [type, + arity, + attributes, + index, + size, + memory, + storage_type, + where_to_read, + disc_copies, + disc_only_copies, + ram_copies, + where_to_write, + checkpoints + ]). + + + + +info(Master, Node, LocalNode, TabId, TabType, ErrMsgMode) -> + process_flag(trap_exit,true), + WinId = create_window(), + {CardIds, MaskLabel} = init(Master, Node, LocalNode, TabId, TabType, WinId), + put(error_msg_mode, ErrMsgMode), + gs:config(WinId, [{map, true}]), + loop(CardIds, MaskLabel, Node, LocalNode, TabId, TabType). + + + + + + +create_window() -> + WinWidth = ?WINDOW_WIDTH, + WinHeight = ?WINDOW_HEIGHT, + Win = gs:window(win, gs:start(), [{width, WinWidth}, + {height, WinHeight}, + {bg, ?DEFAULT_BG_COLOR}, + {destroy, true}, + {configure, true}, + {keypress, true} + ]), + + MenubarId = gs:create(menubar, Win, [{bg, ?DEFAULT_BG_COLOR} + ]), + Mbutt = gs:create(menubutton, MenubarId, [{bg, ?DEFAULT_BG_COLOR}, + {fg, {178, 34, 34}}, % firebrick + {label, {text, " File "}}, + {underline, 1} + ]), + Obutt = gs:create(menubutton, MenubarId, [{bg, ?DEFAULT_BG_COLOR}, + {fg, {178, 34, 34}}, % firebrick + {label, {text, " Options "}}, + {underline, 1} + ]), + + % Create the actual menu! + FMenu = gs:create(menu, Mbutt, [{bg, ?DEFAULT_BG_COLOR}, + {fg, {178, 34, 34}}]), + OMenu = gs:create(menu, Obutt, [{bg, ?DEFAULT_BG_COLOR}, + {fg, {178, 34, 34}}]), + gs:create(menuitem, FMenu, [{bg, ?DEFAULT_BG_COLOR}, + {fg, {178, 34, 34}}, + {label, {text, " Close Ctrl-C "}}, + {data, close_menu}, + {underline, 1} + ]), + gs:create(menuitem, OMenu, [{bg, ?DEFAULT_BG_COLOR}, + {fg, {178, 34, 34}}, + {label, {text, " Refresh Ctrl-R "}}, + {data, update}, + {underline, 1} + ]), + Win. + + + + + + + + +init(Master, Node, LocalNode, TabId, TabType, WinId) -> + WinWidth = ?WINDOW_WIDTH, + WinHeight = ?WINDOW_HEIGHT, + + WinFrame = gs:frame(WinId, [{width, WinWidth}, + {height, WinHeight}, + {x, 0}, + {y, 30}, + {bg, ?DEFAULT_BG_COLOR}, + {bw, 0} + ]), + + TableIdFlap = create_flap(1, "Table Id", WinFrame), + BasicSettingsFlap = create_flap(2, "Basic Settings", WinFrame), + SizeFlap = create_flap(3, "Size", WinFrame), + StorageFlap = create_flap(4, "Storage", WinFrame), + + TableIdCard = create_card(WinFrame, TableIdFlap), + BasicSettingsCard = create_card(WinFrame, BasicSettingsFlap), + SizeCard = create_card(WinFrame, SizeFlap), + StorageCard = create_card(WinFrame, StorageFlap), + + + set_flap_label(TableIdFlap, "Table Id"), + set_flap_label(BasicSettingsFlap, "Basic Settings"), + set_flap_label(SizeFlap, "Size"), + set_flap_label(StorageFlap, "Storage"), + + + gs:config(TableIdCard, [raise]), + + CardIds = print_cards(TabType, TableIdCard, BasicSettingsCard, SizeCard, StorageCard), + + {_CardId, FirstMaskXpos} = gs:read(TableIdFlap, data), + Mask = gs:label(WinFrame, [{width, gs:read(TableIdFlap, width) - 2 * gs:read(TableIdFlap, bw) + 1}, + {height, gs:read(TableIdCard, bw)}, + {x, FirstMaskXpos}, + {y, gs:read(TableIdCard, y)}, + {bg, ?DEFAULT_BG_COLOR} + ]), + + update_info_flaps(TabType, Node, LocalNode, TabId, CardIds, Master), + {CardIds#card_field_ids{parent_pid = Master, + window_id = WinId, + window_frame = WinFrame}, Mask}. + + + + + +check_node(OldNode, LocalNode) -> + HomeNode = node(), + case net_adm:ping(OldNode) of + pong -> + OldNode; + pang when LocalNode -> + %% The system has gone either distributed or undistributed. + %% No matter which, HomeNode tells the current correct node. + HomeNode; + pang -> + OldNode + end. + + + + + + +update_data_field(notext, {label, Id}) -> + gs:config(Id, [{label, {text, "" }}]); +update_data_field(notext, {listbox, Id}) -> + gs:config(Id, [{items, []}]); +update_data_field({Data}, {label, Id}) -> + gs:config(Id, [{label, {text, " " ++ lists:flatten(io_lib:write(Data))}}]); +update_data_field({Data}, {listbox, Id}) -> + gs:config(Id, [{items, lists:map(fun(E) -> " " ++ lists:flatten(io_lib:write(E)) + end, Data)}]). + + + + +print_info(mnesia, Node, LocalNode, TabId, CardIds) -> + update_data_field({mnesia}, + CardIds#card_field_ids.table_type), + update_data_field({TabId}, + CardIds#card_field_ids.table_name), + update_data_field({tv_mnesia_rpc:table_info(Node, LocalNode, TabId, type)}, + CardIds#card_field_ids.bag_or_set), + update_data_field({tv_mnesia_rpc:table_info(Node, LocalNode, TabId, arity) - 1}, + CardIds#card_field_ids.arity), + + AttributesList = tv_mnesia_rpc:table_info(Node, LocalNode, TabId, attributes), + update_data_field({AttributesList}, + CardIds#card_field_ids.attributes), + update_data_field({lists:map(fun(N) -> + lists:nth(N - 1, AttributesList) + end, + [2] ++ tv_mnesia_rpc:table_info(Node, + LocalNode, + TabId, + index) + ) + }, + CardIds#card_field_ids.index), + + update_data_field({tv_mnesia_rpc:table_info(Node, LocalNode, TabId, size)}, + CardIds#card_field_ids.size), + update_data_field({tv_mnesia_rpc:table_info(Node, LocalNode, TabId, memory)}, + CardIds#card_field_ids.memory), + update_data_field({tv_mnesia_rpc:table_info(Node, LocalNode, TabId, storage_type)}, + CardIds#card_field_ids.storage_type), + update_data_field({tv_mnesia_rpc:table_info(Node, LocalNode, TabId, where_to_read)}, + CardIds#card_field_ids.where_to_read), + update_data_field({tv_mnesia_rpc:table_info(Node, LocalNode, TabId, disc_copies)}, + CardIds#card_field_ids.disc_copies), + update_data_field({tv_mnesia_rpc:table_info(Node, LocalNode, TabId, disc_only_copies)}, + CardIds#card_field_ids.disc_only_copies), + update_data_field({tv_mnesia_rpc:table_info(Node, LocalNode, TabId, ram_copies)}, + CardIds#card_field_ids.ram_copies), + update_data_field({tv_mnesia_rpc:table_info(Node, LocalNode, TabId, where_to_write)}, + CardIds#card_field_ids.where_to_write), + update_data_field({tv_mnesia_rpc:table_info(Node, LocalNode, TabId, checkpoints)}, + CardIds#card_field_ids.checkpoints), + {ok, TabId}; +print_info(ets, Node, LocalNode, TabId, CardIds) -> + update_data_field({ets}, + CardIds#card_field_ids.table_type), + update_data_field({TabId}, + CardIds#card_field_ids.table_id), + TabName = tv_ets_rpc:info(Node, LocalNode, TabId, name), + update_data_field({TabName}, + CardIds#card_field_ids.table_name), + update_data_field({tv_ets_rpc:info(Node, LocalNode, TabId, named_table)}, + CardIds#card_field_ids.named_table), + + OwnerPid = tv_ets_rpc:info(Node, LocalNode, TabId, owner), + OwnerNameSearchResult = lists:keysearch(registered_name, + 1, + rpc:block_call(Node, + erlang, + process_info, + [OwnerPid])), + OwnerName = case OwnerNameSearchResult of + false -> + notext; + {value, {registered_name, WantedName}} -> + {WantedName} + end, + update_data_field({OwnerPid}, + CardIds#card_field_ids.owner_pid), + update_data_field(OwnerName, + CardIds#card_field_ids.owner_name), + + update_data_field({tv_ets_rpc:info(Node, LocalNode, TabId, keypos)}, + CardIds#card_field_ids.keypos), + update_data_field({tv_ets_rpc:info(Node, LocalNode, TabId, type)}, + CardIds#card_field_ids.bag_or_set), + update_data_field({tv_ets_rpc:info(Node, LocalNode, TabId, protection)}, + CardIds#card_field_ids.protection), + update_data_field({tv_ets_rpc:info(Node, LocalNode, TabId, size)}, + CardIds#card_field_ids.size), + update_data_field({tv_ets_rpc:info(Node, LocalNode, TabId, memory)}, + CardIds#card_field_ids.memory), + update_data_field({tv_ets_rpc:info(Node, LocalNode, TabId, node)}, + CardIds#card_field_ids.node), + {ok, TabName}. + + + + + + +print_cards(mnesia, Card1, Card2, Card3, Card4) -> + create_card_text(1, "Table Type:", Card1), + create_card_text(2, "Table Name:", Card1), + + create_card_text(1, "Table Type:", Card2), + create_card_text(2, "Number of Attributes:", Card2), +% create_card_text(3, "Attribute Names:", Card2), +% create_card_text(4, "Index Positions:", Card2), + + create_card_text(1, "Number of Elements Stored:", Card3), + create_card_text(2, "Number of Words Allocated:", Card3), + + create_card_text(1, "Local Storage Type:", Card4), + create_card_text(2, "Table Readable at Node:", Card4), +% create_card_text(3, "Disc Copy Nodes:", Card4), +% create_card_text(4, "Disc Copy Only Nodes:", Card4), +% create_card_text(5, "RAM Copy Nodes:", Card4), +% create_card_text(6, "Active Table Replica Nodes:", Card4), +% create_card_text(7, "Active Checkpoints:", Card4), + + {AttributesId, IndexId} = create_special_fields(mnesia, size_card, Card2), + + + {DiscCopiesId, DiscOnlyCopiesId, RamCopiesId, WhereToWriteId, CheckpointsId} = + create_special_fields(mnesia, storage_card, Card4), + + #card_field_ids{table_name = {label, create_card_data_field(2, Card1)}, + table_type = {label, create_card_data_field(1, Card1)}, + bag_or_set = {label, create_card_data_field(1, Card2)}, + arity = {label, create_card_data_field(2, Card2)}, + attributes = AttributesId, + index = IndexId, + size = {label, create_card_data_field(1, Card3)}, + memory = {label, create_card_data_field(2, Card3)}, + storage_type = {label, create_card_data_field(1, Card4)}, + where_to_read = {label, create_card_data_field(2, Card4)}, + disc_copies = DiscCopiesId, + disc_only_copies = DiscOnlyCopiesId, + ram_copies = RamCopiesId, + where_to_write = WhereToWriteId, + checkpoints = CheckpointsId + }; +print_cards(ets, Card1, Card2, Card3, Card4) -> + create_card_text(1, "Table Type:", Card1), + create_card_text(2, "Table Id:", Card1), + create_card_text(3, "Table Name:", Card1), + create_card_text(4, "Table Name Registered:", Card1), + create_card_text(5, "Process Owning the Table:", Card1), + create_card_text(6, "Name of Owning Process:", Card1), + + create_card_text(1, "Index Position:", Card2), + create_card_text(2, "Table Type:", Card2), + create_card_text(3, "Protection Mode:", Card2), + + create_card_text(1, "Number of Elements Stored:", Card3), + create_card_text(2, "Number of Words Allocated:", Card3), + + create_card_text(1, "Table Stored at Node:", Card4), + + #card_field_ids{table_id = {label, create_card_data_field(2, Card1)}, + table_type = {label, create_card_data_field(1, Card1)}, + table_name = {label, create_card_data_field(3, Card1)}, + named_table = {label, create_card_data_field(4, Card1)}, + owner_pid = {label, create_card_data_field(5, Card1)}, + owner_name = {label, create_card_data_field(6, Card1)}, + + keypos = {label, create_card_data_field(1, Card2)}, + bag_or_set = {label, create_card_data_field(2, Card2)}, + protection = {label, create_card_data_field(3, Card2)}, + + size = {label, create_card_data_field(1, Card3)}, + memory = {label, create_card_data_field(2, Card3)}, + + node = {label, create_card_data_field(1, Card4)} + }. + + + + + + +create_special_fields(mnesia, size_card, CardId) -> + LabelWidth = 195, + LabelHeight = 24, + ListboxWidth = 210, + ListboxHeight = 160, + VerticalSpacing = 20, + LXpos = 30, + RXpos = 330, + Ypos = 40 + (LabelHeight + VerticalSpacing) * 2 + 25, + gs:label(CardId, [{width, LabelWidth}, + {height, LabelHeight}, + {x, LXpos}, + {y, Ypos}, + {bg, ?DEFAULT_BG_COLOR}, + {fg, {0, 0, 0}}, + {align, center}, + {label, {text, "Attribute Names:"}} + ]), + + gs:label(CardId, [{width, LabelWidth}, + {height, LabelHeight}, + {x, RXpos}, + {y, Ypos}, + {bg, ?DEFAULT_BG_COLOR}, + {fg, {0, 0, 0}}, + {align, center}, + {label, {text, "Attributes Used as Indices:"}} + ]), + + AttributesId = gs:listbox(CardId, [{width, ListboxWidth}, + {height, ListboxHeight}, + {x, LXpos}, + {y, Ypos + LabelHeight - 3}, + {bg, {255, 255, 255}}, + {fg, {0, 0, 0}}, + {hscroll, bottom}, + {vscroll, right}, + {selectmode, single}, + {click, true}, + {doubleclick, true}, + {data, listbox} + ]), + + IndexId = gs:listbox(CardId, [{width, ListboxWidth}, + {height, ListboxHeight}, + {x, RXpos}, + {y, Ypos + LabelHeight - 3}, + {bg, {255, 255, 255}}, + {fg, {0, 0, 0}}, + {hscroll, bottom}, + {vscroll, right}, + {selectmode, single}, + {click, true}, + {doubleclick, true}, + {data, listbox} + ]), + + {{listbox, AttributesId}, + {listbox, IndexId} + }; +create_special_fields(mnesia, storage_card, CardId) -> + LabelWidth = 155, + LabelHeight = 24, + ListboxHeight = 80, + ListboxWidth = 170, + VerticalSpacing = 20, + LXpos = 10, + MXpos = 197, + RXpos = 385, + % Y-positions for upper and lower row. + UYpos = 40 + (LabelHeight + VerticalSpacing) * 2, + LYpos = UYpos + ListboxHeight + 37, + gs:label(CardId, [{width, LabelWidth}, + {height, LabelHeight}, + {x, LXpos}, + {y, UYpos}, + {bg, ?DEFAULT_BG_COLOR}, + {fg, {0, 0, 0}}, + {align, center}, + {label, {text, "Disc Copy Nodes:"}} + ]), + + gs:label(CardId, [{width, LabelWidth}, + {height, LabelHeight}, + {x, MXpos}, + {y, UYpos}, + {bg, ?DEFAULT_BG_COLOR}, + {fg, {0, 0, 0}}, + {align, center}, + {label, {text, "Disc Only Copy Nodes:"}} + ]), + + gs:label(CardId, [{width, LabelWidth}, + {height, LabelHeight}, + {x, RXpos}, + {y, UYpos}, + {bg, ?DEFAULT_BG_COLOR}, + {fg, {0, 0, 0}}, + {align, center}, + {label, {text, "RAM Copy Nodes:"}} + ]), + + + gs:label(CardId, [{width, LabelWidth}, + {height, LabelHeight}, + {x, LXpos}, + {y, LYpos}, + {bg, ?DEFAULT_BG_COLOR}, + {fg, {0, 0, 0}}, + {align, center}, + {label, {text, "Table Replica Nodes:"}} + ]), + + gs:label(CardId, [{width, LabelWidth}, + {height, LabelHeight}, + {x, MXpos}, + {y, LYpos}, + {bg, ?DEFAULT_BG_COLOR}, + {fg, {0, 0, 0}}, + {align, center}, + {label, {text, "Active Checkpoints:"}} + ]), + + + DiscCopiesId = gs:listbox(CardId, [{width, ListboxWidth}, + {height, ListboxHeight}, + {x, LXpos}, + {y, UYpos + LabelHeight - 3}, + {bg, {255, 255, 255}}, + {fg, {0, 0, 0}}, + {hscroll, bottom}, + {vscroll, right}, + {selectmode, single}, + {click, true}, + {doubleclick, true}, + {data, listbox} + ]), + + DiscCopiesOnlyId = gs:listbox(CardId, [{width, ListboxWidth}, + {height, ListboxHeight}, + {x, MXpos}, + {y, UYpos + LabelHeight - 3}, + {bg, {255, 255, 255}}, + {fg, {0, 0, 0}}, + {hscroll, bottom}, + {vscroll, right}, + {selectmode, single}, + {click, true}, + {doubleclick, true}, + {data, listbox} + ]), + + RamCopiesId = gs:listbox(CardId, [{width, ListboxWidth}, + {height, ListboxHeight}, + {x, RXpos}, + {y, UYpos + LabelHeight - 3}, + {bg, {255, 255, 255}}, + {fg, {0, 0, 0}}, + {hscroll, bottom}, + {vscroll, right}, + {selectmode, single}, + {click, true}, + {doubleclick, true}, + {data, listbox} + ]), + + + + WhereToWriteId = gs:listbox(CardId, [{width, ListboxWidth}, + {height, ListboxHeight}, + {x, LXpos}, + {y, LYpos + LabelHeight - 3}, + {bg, {255, 255, 255}}, + {fg, {0, 0, 0}}, + {hscroll, bottom}, + {vscroll, right}, + {selectmode, single}, + {click, true}, + {doubleclick, true}, + {data, listbox} + ]), + + CheckpointsId = gs:listbox(CardId, [{width, ListboxWidth}, + {height, ListboxHeight}, + {x, MXpos}, + {y, LYpos + LabelHeight - 3}, + {bg, {255, 255, 255}}, + {fg, {0, 0, 0}}, + {hscroll, bottom}, + {vscroll, right}, + {selectmode, single}, + {click, true}, + {doubleclick, true}, + {data, listbox} + ]), + + {{listbox, DiscCopiesId}, + {listbox, DiscCopiesOnlyId}, + {listbox, RamCopiesId}, + {listbox, WhereToWriteId}, + {listbox, CheckpointsId} + }. + + + + + + + +create_card_data_field(N, ParentId) -> + Width = 345, + Height = 24, + VerticalSpacing = 20, + Xpos = 210, + Ypos = 40 + (Height + VerticalSpacing) * (N - 1), + + BgFrame = gs:frame(ParentId, [{width, Width}, + {height, Height}, + {x, Xpos}, + {y, Ypos}, + {bg, {0, 0, 0}}, + {bw, 0} + ]), + gs:label(BgFrame, [{width, Width - 2}, + {height, Height - 2}, + {x, 1}, + {y, 1}, + {bg, {255, 255, 255}}, + {fg, {0, 0, 0}}, + {align, w} + ]). + + + + + + +create_card_text(N, Text, ParentId) -> + LabelWidth = 205, + LabelHeight = 24, + VerticalSpacing = 20, + Xpos = 10, + Ypos = 40 + (LabelHeight + VerticalSpacing) * (N - 1), + gs:label(ParentId, [{width, LabelWidth}, + {height, LabelHeight}, + {x, Xpos}, + {y, Ypos}, + {bg, ?DEFAULT_BG_COLOR}, + {fg, {0, 0, 0}}, + {align, w}, + {label, {text, Text}} + ]). + + + + +create_card(ParentId, FlapId) -> + CardId = gs:frame(ParentId, [{width, 570}, + {height, 360}, + {x, 5}, + {y, 35}, + {bg, ?DEFAULT_BG_COLOR}, + {bw, 2} + ]), + FlapXpos = gs:read(FlapId, data), + gs:config(FlapId, [{data, {CardId, FlapXpos}} + ]), + CardId. + + + + + +set_flap_label(ParentId, Text) -> + Bw = gs:read(ParentId, bw), % It is assumed that the parent is a frame! :-) + Width = gs:read(ParentId, width) - 2 * Bw - 2, + Height = gs:read(ParentId, height) - 2 * Bw - 6, + Xpos = 0, + Ypos = 0, + Data = gs:read(ParentId, data), + + gs:label(ParentId, [{width, Width}, + {height, Height}, + {x, Xpos}, + {y, Ypos}, + % {fg, {178, 34, 34}}, + {bg, ?DEFAULT_BG_COLOR}, + {fg, {0, 0, 0}}, + {label, {text, Text}}, + {align, center}, + {buttonpress, true}, + {data, Data} + ]). + + + +create_flap(N, _Text, ParentId) -> + Width = 120, + Height = 40, + Spacing = 2, + FirstXpos = 5, + Xpos = FirstXpos + ((Width + Spacing) * (N - 1)), + Ypos = 5, + BorderWidth = 2, + + gs:frame(ParentId, [{width, Width}, + {height, Height}, + {x, Xpos}, + {y, Ypos}, + {bg, ?DEFAULT_BG_COLOR}, + {bw, BorderWidth}, + {cursor, hand}, + {buttonpress, true}, + {data, Xpos + BorderWidth} + ]). + + + +update_info_flaps(TabType, Node, LocalNode, TabId, CardIds, MasterPid) -> + case catch print_info(TabType, Node, LocalNode, TabId, CardIds) of + {ok, TabName} -> + WinTitle = tv_pc_menu_handling:get_window_title(TabType,Node,TabId,TabName), + gs:config(win, [{title, "[TV] " ++ WinTitle}]), + done; + nodedown -> + nodedown; + no_table -> + gs:config(win, [beep]), + case get(error_msg_mode) of + normal -> + Msg = ["The table " ++ lists:flatten(io_lib:write(TabId)) ++ " on node", + lists:flatten(io_lib:write(Node)) ++ " no longer exists!"], + tv_utils:notify(win, "TV Notification", Msg); + haiku -> + Msg = ["Three things are certain:", + "Death, taxes, and lost tables.", + "Guess which has occurred."], + tv_utils:notify(win, "TV Notification", Msg) + end, + MasterPid ! #ip_dead_table{sender = self()}; + mnesia_not_started -> + gs:config(win, [beep]), + case get(error_msg_mode) of + normal -> + Msg = ["The table " ++ lists:flatten(io_lib:write(TabId)) ++ " on node", + lists:flatten(io_lib:write(Node)) ++ " no longer exists!"], + tv_utils:notify(win, "TV Notification", Msg); + haiku -> + Msg = ["A table that big?", + "It might be very useful.", + "But now it is gone."], + tv_utils:notify(win, "TV Notification", Msg) + end, + MasterPid ! #ip_dead_table{sender = self()}; + {unexpected_error,Reason} -> + io:format("Unexpected error: ~p~n", [Reason]); + _Other -> + io:format("Unexpected return value: ~p~n", [_Other]), + done + end. + + + + +loop(CardIds, MaskLabel, Node, LocalNode, TabId, TabType) -> + receive + #info_update_table_info{sender = Sender} -> + NewNode = check_node(Node, LocalNode), + update_info_flaps(TabType, NewNode, LocalNode, TabId, CardIds, Sender), + loop(CardIds, MaskLabel, NewNode, LocalNode, TabId, TabType); + + + #info_raise_window{sender = Sender} -> + gs:config(CardIds#card_field_ids.window_id, [raise]), + NewNode = check_node(Node, LocalNode), + chk(update_info_flaps(TabType, NewNode, LocalNode, TabId, CardIds, Sender)), + loop(CardIds, MaskLabel, NewNode, LocalNode, TabId, TabType); + + + #info_quit{} -> + exit(normal); + + {gs, _FlapId, buttonpress, {CardId, Xpos}, [1 | _]} -> + gs:config(CardId, [raise + ]), + gs:config(MaskLabel, [raise, + {x, Xpos} + ]), + loop(CardIds, MaskLabel, Node, LocalNode, TabId, TabType); + + {gs, _Id, buttonpress, {_CardId, _Xpos}, _Args} -> + loop(CardIds, MaskLabel, Node, LocalNode, TabId, TabType); + + {gs, _LblId, enter, _Data, _Args} -> + loop(CardIds, MaskLabel, Node, LocalNode, TabId, TabType); + + {gs, WinId, configure, _Data, _Args} -> + gs:config(WinId, [{width, ?WINDOW_WIDTH}, + {height, ?WINDOW_HEIGHT} + ]), + loop(CardIds, MaskLabel, Node, LocalNode, TabId, TabType); + + {gs, ListboxId, click, listbox, _Args} -> + gs:config(ListboxId, [{selection, clear}]), + loop(CardIds, MaskLabel, Node, LocalNode, TabId, TabType); + + {gs, ListboxId, doubleclick, listbox, _Args} -> + gs:config(ListboxId, [{selection, clear}]), + loop(CardIds, MaskLabel, Node, LocalNode, TabId, TabType); + + {gs, _Id, click, update, _Args} -> + NewNode = check_node(Node, LocalNode), + chk(update_info_flaps(TabType,NewNode,LocalNode,TabId,CardIds, + CardIds#card_field_ids.parent_pid)), + loop(CardIds, MaskLabel, NewNode, LocalNode, TabId, TabType); + + {gs, _Id, keypress, _, [r, _, 0, 1 | _]} -> + NewNode = check_node(Node, LocalNode), + chk(update_info_flaps(TabType,NewNode,LocalNode,TabId,CardIds, + CardIds#card_field_ids.parent_pid)), + loop(CardIds, MaskLabel, NewNode, LocalNode, TabId, TabType); + + {gs, _Id, keypress, _, ['R', _, 1, 1 | _]} -> + NewNode = check_node(Node, LocalNode), + chk(update_info_flaps(TabType,NewNode,LocalNode,TabId,CardIds, + CardIds#card_field_ids.parent_pid)), + loop(CardIds, MaskLabel, NewNode, LocalNode, TabId, TabType); + + {gs, _Id, click, close_menu, _Args} -> + exit(normal); + + {gs, _Id, keypress, _, [c, _, 0, 1 | _]} -> + exit(normal); + + {gs, _Id, keypress, _, ['C', _, 1, 1 | _]} -> + exit(normal); + + {gs, _Id, destroy, _Data, _Args} -> + exit(normal); + + {'EXIT', _Pid, _Reason} -> + exit(normal); + + {error_msg_mode, Mode} -> + put(error_msg_mode, Mode), + loop(CardIds, MaskLabel, Node, LocalNode, TabId, TabType); + + _Other -> + loop(CardIds, MaskLabel, Node, LocalNode, TabId, TabType) + end. + + + + + + +chk(nodedown) -> + gs:config(win, [beep]), + case get(error_msg_mode) of + normal -> + tv_utils:notify(win, "TV Notification", + ["The node is down, and the", + "table cannot be reached."]); + haiku -> + ErrMsg1 = ["With searching comes loss", + "And the presence of absence:", + "Node is down."], + tv_utils:notify(win, "TV Notification", ErrMsg1) + end; +chk(_Other) -> + done. + diff --git a/lib/tv/src/tv_int_def.hrl b/lib/tv/src/tv_int_def.hrl new file mode 100644 index 0000000000..6d4263c51b --- /dev/null +++ b/lib/tv/src/tv_int_def.hrl @@ -0,0 +1,56 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1997-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% +%%%********************************************************************* +%%% +%%% Description: Internal definitions for the table tool as a whole. +%%% +%%%********************************************************************* + +-define(COMM_FUNC_FILE, tv_comm_func). + +-define(ITEMS_TO_DISPLAY, 35). + + +-define(DEFAULT_BACKGROUND_COLOR, {255, 255, 255}). % white + + +% Colors used for marking updates. + +-define(BLACK, { 0, 0, 0}). + +-define(RED1, {255, 0, 0}). +-define(RED2, {255, 100, 100}). +-define(RED3, {255, 150, 150}). +-define(RED4, {255, 200, 200}). +-define(RED5, {235, 217, 217}). + + +-define(GREEN1, { 0, 255, 0}). +-define(GREEN2, {115, 255, 135}). +-define(GREEN3, {125, 225, 150}). +-define(GREEN4, {170, 225, 185}). +-define(GREEN5, {195, 219, 202}). + +-define(DEFAULT_BTN_COLOR, {217, 217, 217}). + + + + + + + diff --git a/lib/tv/src/tv_int_msg.hrl b/lib/tv/src/tv_int_msg.hrl new file mode 100644 index 0000000000..75ce8eca3b --- /dev/null +++ b/lib/tv/src/tv_int_msg.hrl @@ -0,0 +1,504 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1997-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% +%%%********************************************************************* +%%% +%%% Description: File containing all messages used internally +%%% between the various table tool components. +%%% +%%%********************************************************************* + + +%%%********************************************************************* +%%% MESSAGES OWNED BY PC +%%%********************************************************************* + + + +-record(pc_raise_window, {sender}). + + + +-record(pc_menu_msg, {sender, + data}). + + + +-record(pc_win_conf, {sender, + width, + height}). + + + +-record(pc_show_table_info, {sender}). + + + +-record(pc_poll_table, {sender}). + + + +-record(pc_select, {sender}). + + + +-record(pc_help, {sender}). + + + +-record(pc_set_sorting_mode, {sender, + sorting, % 'true' or 'false' + reverse, % 'true' or 'false', + sort_key_no = 1 + }). + + + +-record(pc_set_sorting_mode_cfm, {sender, + sort_key_no + }). + + + +-record(pc_marked_row, {sender, + row_no, + object, + color + }). + + + +-record(pc_data_req, {sender, + element, + nof_elements + }). + + + +-record(pc_resend_data, {sender}). + + + + +-record(pc_data, {sender, + scale_pos, % vertical scale + scale_range, % vertical scale + max_elem_size, + list_range, + elementlist, + marked_row, + list_of_keys, + color}). + + + + +-record(pc_list_info, {sender, + lists_as_strings}). + + + +-record(pc_dead_table, {sender, + automatic_polling}). + + + +-record(pc_nodedown, {sender, + automatic_polling}). + + + +-record(pc_search_req, {sender + }). + + + + +%%%********************************************************************* +%%% MESSAGES OWNED BY PD +%%%********************************************************************* + + + +-record(pd_win_conf, {sender, + width, + height}). + + + +%%====================================================================== +%% Message: +%% +%% Function: +%% +%% Data: sender: Pid of the sender of the message. +%% win: Id of window to create canvas and scale in. +%% win_width: width of the window to create the canvas in. +%% win_height: height of the window to create the canvas in. +%% scale: whether a scale shall be shown or not. +%% Possible values: true -- scale is shown. +%% false -- scale is not shown. +%%====================================================================== + +-record(pd_deblock, {sender, + win, + win_width, + win_height, + scale = false, + range}). + + + + +-record(pd_deblock_cfm, {sender}). + + + +-record(pd_new_table, {sender, + table_type, + table_name, + record_name, %% Only valid for Mnesia tables. + writable + }). + + + +-record(pd_get_sort_settings, {sender, + sorting, + reverse + }). + + + +-record(pd_no_sorting, {sender + }). + + + + +-record(pd_ignore, {sender + }). + + + + +-record(pd_updated_object, {sender, + object, + old_object, + old_color, %% Tells status of the object, if deleted or present. + obj_no + }). + + + +-record(pd_new_object, {sender, %% Used when no row is marked. + object %% Note: may still be an updated object! + }). + + + +-record(pd_delete_object, {sender, + object, + color + }). + + + +-record(pd_rec_edit, {sender, + attributes + }). + + + +%%%********************************************************************* +%%% MESSAGES OWNED BY PW +%%%********************************************************************* + + + + +-record(pw_deblock, {sender, + win_title, + win_width, + win_height, + min_win_width, + min_win_height}). + + + +-record(pw_set_window_title, {sender, + win_title}). + + + +-record(pw_deblock_cfm, {sender, + win_id}). + + + + +%%====================================================================== +%% Message: pw_create_menu. +%% +%% Function: Order to pw to create a menu according to the content of the message. +%% +%% Data: menutitle: string containing the name of the menu, e.g., "File". +%% menulist: list of tuples having the following format: +%% {Text, Data}, where Text is the string that shall be +%% written in each menulist item, and Data is optional data, +%% presumably the name of a function that is to be called +%% when the corresponding menulist message is received. +%%====================================================================== + +-record(pw_create_menu, {sender, + menutitle, + title_acc_pos, + menulist}). + + + +-record(pw_create_menu_cfm, {sender}). + + + +-record(pw_select_menu, {sender, + menu, + old_menus}). + + + + + +%%%********************************************************************* +%%% MESSAGES OWNED BY DBS +%%%********************************************************************* + + + +-record(dbs_deblock, {sender, + etsread_pid, + type, + keypos, + sublist_length}). + + + +-record(dbs_deblock_cfm, {sender}). + + + + +-record(dbs_new_data, {sender, + data, + keys, + time_to_read_table + }). + + + +-record(dbs_new_mnesia_data, {sender, + new_or_changed, + deleted, + keys + }). + + + +-record(dbs_subset, {sender, + data, + requested_row, + subset_pos, + db_length, + max_elem_size, + list_of_keys, + required_time_etsread, + required_time_dbs}). + + + + + +-record(dbs_subset_req, {sender, + subset_pos, + subset_length + }). + + + + +-record(dbs_sorting_mode, {sender, + sorting, % 'true' or 'false' + reverse, % 'true' or 'false' + sort_key_no + }). + + + +-record(dbs_marked_row, {sender, + row_no + }). + + + + +-record(dbs_search_req, {sender + }). + + + +-record(dbs_updated_object, {sender, + object, + old_object, + old_color, + obj_no + }). + + +-record(dbs_new_object, {sender, + object + }). + + +-record(dbs_delete_object, {sender, + object, + color, + obj_no + }). + + + +%%%********************************************************************* +%%% MESSAGES OWNED BY ETSREAD +%%%********************************************************************* + + + +-record(etsread_update_object, {sender, + object, + old_object, + key_no + }). + +-record(etsread_update_object_cfm, {sender, + success + }). + + + +-record(etsread_new_object, {sender, + object + }). + + +-record(etsread_new_object_cfm, {sender, + success + }). + + + +-record(etsread_delete_object, {sender, + object, + key_no + }). + + +-record(etsread_delete_object_cfm, {sender, + success + }). + + + +-record(etsread_deblock, {sender, + dbs_pid, + node, + local_node, + table_id, + table_type, % One of 'ets' or 'mnesia' + poll_interval + }). + + + +-record(etsread_deblock_cfm, {sender, + type, + keypos, + protection + }). + + + +-record(etsread_set_poll_interval, {sender, + interval}). + + + +-record(etsread_poll_table, {sender}). + + + +-record(etsread_nodedown, {sender}). + + + +%%%********************************************************************* +%%% MESSAGES OWNED BY IP +%%%********************************************************************* + + + + +-record(ip_dead_table, {sender}). + + +-record(ip_register_parent, {sender}). + + + +-record(ip_update, {sender, + nof_elements_to_mark, + text}). + + + +-record(ip_quit, {sender}). + + + + +%%%********************************************************************* +%%% MESSAGES OWNED BY INFO +%%%********************************************************************* + + +-record(info_update_table_info, {sender}). + + + +-record(info_raise_window, {sender}). + + + +-record(info_restart, {sender, + node, + table_id, + table_type}). + + + +-record(info_quit, {sender}). + + diff --git a/lib/tv/src/tv_io_lib.erl b/lib/tv/src/tv_io_lib.erl new file mode 100644 index 0000000000..f693ff796d --- /dev/null +++ b/lib/tv/src/tv_io_lib.erl @@ -0,0 +1,222 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1998-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% +%%%********************************************************************* +%%% +%%% Description: This file contains io functions adapted to the +%%% TV requirements. +%%% +%%%********************************************************************* + +-module(tv_io_lib). + + +-export([format/2]). + +-export([write/1,write/2]). +-export([write_atom/1,write_string/2]). + +-export([char_list/1,deep_char_list/1,printable_list/1]). + + + +%% Interface calls to sub-modules. + +format(Format, Args) -> + tv_io_lib_format:fwrite(Format, Args). + + +%% write(Term) +%% write(Term, Depth) +%% write(Term, Depth, Pretty) +%% Return a (non-flattened) list of characters giving a printed +%% representation of the term. + +write(Term) -> write(Term, -1). + +write(_Term, 0) -> "..."; +write(Term, _D) when is_integer(Term) -> integer_to_list(Term); +write(Term, _D) when is_float(Term) -> tv_io_lib_format:fwrite_g(Term); +write(Atom, _D) when is_atom(Atom) -> write_atom(Atom); +write(Term, _D) when is_port(Term) -> "#Port"; +write(Term, _D) when is_pid(Term) -> pid_to_list(Term); +write(Term, _D) when is_reference(Term) -> "#Ref"; +write(Term, _D) when is_binary(Term) -> "#Bin"; +write(Term, _D) when is_bitstring(Term) -> "#Bitstr"; +write([], _D) -> "[]"; +write({}, _D) -> "{}"; +write([H|T], D) -> + if + D =:= 1 -> "[...]"; + true -> + [$[,[write(H, D-1)|write_tail(T, D-1)],$]] + end; +write(F, _D) when is_function(F) -> + {module,M} = erlang:fun_info(F, module), + ["#Fun<",atom_to_list(M),">"]; +write(T, D) when is_tuple(T) -> + if + D =:= 1 -> "{...}"; + true -> + [${, + [write(element(1, T), D-1)|write_tail(tl(tuple_to_list(T)), D-1)], + $}] + end. + +%% write_tail(List, Depth) +%% Test the terminating case first as this looks better with depth. + +write_tail([], _D) -> ""; +write_tail(_List, 1) -> "|..."; +write_tail([H|T], D) -> + [$,,write(H, D-1)|write_tail(T, D-1)]; +write_tail(Other, D) -> + [$|,write(Other, D-1)]. + +%% write_atom(Atom) -> [Char] +%% Generate the list of characters needed to print an atom. + +write_atom(Atom) -> + Chars = atom_to_list(Atom), + case quote_atom(Atom, Chars) of + true -> + write_string(Chars, $'); + false -> + Chars + end. + + +write_string(S, Q) -> + [Q|write_string1(S, Q)]. + +write_string1([], Q) -> + [Q]; +write_string1([C|Cs], Q) -> + write_char(C, Q, write_string1(Cs, Q)). + + +write_char(Q, Q, Tail) -> %Must check this first + [$\\,Q|Tail]; +write_char($\\, _, Tail) -> %In printable character range + [$\\,$\\|Tail]; +write_char(C, _, Tail) when C >= $ , C =< $~ -> + [C|Tail]; +write_char(C, _, Tail) when C >= 128+$ , C =< 255 -> + [C|Tail]; +write_char($\n, _Q, Tail) -> %\n = LF + [$\\,$n|Tail]; +write_char($\r, _, Tail) -> %\r = CR + [$\\,$r|Tail]; +write_char($\t, _, Tail) -> %\t = TAB + [$\\,$t|Tail]; +write_char($\v, _, Tail) -> %\v = VT + [$\\,$v|Tail]; +write_char($\b, _, Tail) -> %\b = BS + [$\\,$b|Tail]; +write_char($\f, _, Tail) -> %\f = FF + [$\\,$f|Tail]; +write_char($\e, _, Tail) -> %\e = ESC + [$\\,$e|Tail]; +write_char($\d, _, Tail) -> %\d = DEL + [$\\,$d|Tail]; +write_char(C, _, Tail) when C < $ -> + C1 = (C bsr 3) + $0, + C2 = (C band 7) + $0, + [$\\,$0,C1,C2|Tail]; +write_char(C, _, Tail) when C > $~ -> + C1 = (C bsr 6) + $0, + C2 = ((C bsr 3) band 7) + $0, + C3 = (C band 7) + $0, + [$\\,C1,C2,C3|Tail]. + +%% quote_atom(Atom, CharList) +%% Return 'true' if atom with chars in CharList needs to be quoted, else +%% return 'false'. + +quote_atom(Atom, Cs0) -> + case erl_scan:reserved_word(Atom) of + true -> true; + false -> + case Cs0 of + [C|Cs] when C >= $a, C =< $z -> + quote_atom(Cs); + _ -> true + end + end. + +quote_atom([C|Cs]) when C >= $a, C =< $z -> + quote_atom(Cs); +quote_atom([C|Cs]) when C >= $A, C =< $Z -> + quote_atom(Cs); +quote_atom([C|Cs]) when C >= $0, C =< $9 -> + quote_atom(Cs); +quote_atom([$_|Cs]) -> + quote_atom(Cs); +quote_atom([$@|Cs]) -> + quote_atom(Cs); +quote_atom([_|_]) -> + true; +quote_atom([]) -> + false. + +%% char_list(CharList) +%% deep_char_list(CharList) +%% Return true if CharList is a (possibly deep) list of characters, else +%% false. + +char_list([C|Cs]) when is_integer(C), C >= 0, C =< 255 -> + char_list(Cs); +char_list([]) -> true; +char_list(_Other) -> false. %Everything else is false + +deep_char_list(Cs) -> + deep_char_list(Cs, []). + +deep_char_list([C|Cs], More) when is_list(C) -> + deep_char_list(C, [Cs|More]); +deep_char_list([C|Cs], More) when is_integer(C), C >= 0, C =< 255 -> + deep_char_list(Cs, More); +deep_char_list([], [Cs|More]) -> + deep_char_list(Cs, More); +deep_char_list([], []) -> true; +deep_char_list(_Other, _More) -> %Everything else is false + false. + +%% printable_list([Char]) -> bool() +%% Return true if CharList is a list of printable characters, else +%% false. + +printable_list([C|Cs]) when is_integer(C), C >= $ , C =< 255 -> + printable_list(Cs); +printable_list([$\n|Cs]) -> + printable_list(Cs); +printable_list([$\r|Cs]) -> + printable_list(Cs); +printable_list([$\t|Cs]) -> + printable_list(Cs); +printable_list([$\v|Cs]) -> + printable_list(Cs); +printable_list([$\b|Cs]) -> + printable_list(Cs); +printable_list([$\f|Cs]) -> + printable_list(Cs); +printable_list([$\e|Cs]) -> + printable_list(Cs); +printable_list([]) -> true; +printable_list(_Other) -> false. %Everything else is false + + diff --git a/lib/tv/src/tv_io_lib_format.erl b/lib/tv/src/tv_io_lib_format.erl new file mode 100644 index 0000000000..5042fd3f9d --- /dev/null +++ b/lib/tv/src/tv_io_lib_format.erl @@ -0,0 +1,389 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1998-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% +-module(tv_io_lib_format). + + +-export([fwrite/2,fwrite_g/1,indentation/2]). + + +%% fwrite(Format, ArgList) -> [Char]. +%% Format the arguments in ArgList after string Format. Just generate +%% an error if there is an error in the arguments. +%% +%% To do the printing command correctly we need to calculate the +%% current indentation for everything before it. This may be very +%% expensive, especially when it is not needed, so we first determine +%% if, and for how long, we need to calculate the indentations. We do +%% this by first collecting all the control sequences and +%% corresponding arguments, then counting the print sequences and +%% then building the output. This method has some drawbacks, it does +%% two passes over the format string and creates more temporary data, +%% and it also splits the handling of the control characters into two +%% parts. + +fwrite(Format, Args) when is_atom(Format) -> + fwrite(atom_to_list(Format), Args); +fwrite(Format, Args) -> + Cs = collect(Format, Args), + Pc = pcount(Cs), + build(Cs, Pc, 0). + +collect([$~|Fmt0], Args0) -> + {C,Fmt1,Args1} = collect_cseq(Fmt0, Args0), + [C|collect(Fmt1, Args1)]; +collect([C|Fmt], Args) -> + [C|collect(Fmt, Args)]; +collect([], []) -> []. + +collect_cseq(Fmt0, Args0) -> + {F,Ad,Fmt1,Args1} = field_width(Fmt0, Args0), + {P,Fmt2,Args2} = precision(Fmt1, Args1), + {Pad,Fmt3,Args3} = pad_char(Fmt2, Args2), + {C,As,Fmt4,Args4} = collect_cc(Fmt3, Args3), + {{C,As,F,Ad,P,Pad},Fmt4,Args4}. + +field_width([$-|Fmt0], Args0) -> + {F,Fmt,Args} = field_value(Fmt0, Args0), + field_width(-F, Fmt, Args); +field_width(Fmt0, Args0) -> + {F,Fmt,Args} = field_value(Fmt0, Args0), + field_width(F, Fmt, Args). + +field_width(F, Fmt, Args) when F < 0 -> + {-F,left,Fmt,Args}; +field_width(F, Fmt, Args) when F >= 0 -> + {F,right,Fmt,Args}. + +precision([$.|Fmt], Args) -> + field_value(Fmt, Args); +precision(Fmt, Args) -> + {none,Fmt,Args}. + +field_value([$*|Fmt], [A|Args]) when is_integer(A) -> + {A,Fmt,Args}; +field_value([C|Fmt], Args) when C >= $0, C =< $9 -> + field_value([C|Fmt], Args, 0); +field_value(Fmt, Args) -> + {none,Fmt,Args}. + +field_value([C|Fmt], Args, F) when C >= $0, C =< $9 -> + field_value(Fmt, Args, 10*F + (C - $0)); +field_value(Fmt, Args, F) -> %Default case + {F,Fmt,Args}. + +pad_char([$.,$*|Fmt], [Pad|Args]) -> {Pad,Fmt,Args}; +pad_char([$.,Pad|Fmt], Args) -> {Pad,Fmt,Args}; +pad_char(Fmt, Args) -> {$ ,Fmt,Args}. + +%% collect_cc([FormatChar], [Argument]) -> +%% {Control,[ControlArg],[FormatChar],[Arg]}. +%% Here we collect the argments for each control character. +%% Be explicit to cause failure early. + +collect_cc([$w|Fmt], [A|Args]) -> {$w,[A],Fmt,Args}; +collect_cc([$p|Fmt], [A|Args]) -> {$p,[A],Fmt,Args}; +collect_cc([$W|Fmt], [A,Depth|Args]) -> {$W,[A,Depth],Fmt,Args}; +collect_cc([$P|Fmt], [A,Depth|Args]) -> {$P,[A,Depth],Fmt,Args}; +collect_cc([$s|Fmt], [A|Args]) -> {$s,[A],Fmt,Args}; +collect_cc([$e|Fmt], [A|Args]) -> {$e,[A],Fmt,Args}; +collect_cc([$f|Fmt], [A|Args]) -> {$f,[A],Fmt,Args}; +collect_cc([$g|Fmt], [A|Args]) -> {$g,[A],Fmt,Args}; +collect_cc([$c|Fmt], [A|Args]) -> {$c,[A],Fmt,Args}; +collect_cc([$~|Fmt], Args) -> {$~,[],Fmt,Args}; +collect_cc([$n|Fmt], Args) -> {$n,[],Fmt,Args}; +collect_cc([$i|Fmt], [A|Args]) -> {$i,[A],Fmt,Args}. + +%% pcount([ControlC]) -> Count. +%% Count the number of print requests. + +pcount(Cs) -> pcount(Cs, 0). + +pcount([{$p,_As,_F,_Ad,_P,_Pad}|Cs], Acc) -> pcount(Cs, Acc+1); +pcount([{$P,_As,_F,_Ad,_P,_Pad}|Cs], Acc) -> pcount(Cs, Acc+1); +pcount([_|Cs], Acc) -> pcount(Cs, Acc); +pcount([], Acc) -> Acc. + +%% build([Control], Pc, Indentation) -> [Char]. +%% Interpret the control structures. Count the number of print +%% remaining and only calculate indentation when necessary. Must also +%% be smart when calculating indentation for characters in format. + +build([{C,As,F,Ad,P,Pad}|Cs], Pc0, I) -> + S = control(C, As, F, Ad, P, Pad, I), + Pc1 = decr_pc(C, Pc0), + if + Pc1 > 0 -> [S|build(Cs, Pc1, indentation(S, I))]; + true -> [S|build(Cs, Pc1, I)] + end; +build([$\n|Cs], Pc, _I) -> [$\n|build(Cs, Pc, 0)]; +build([$\t|Cs], Pc, I) -> [$\t|build(Cs, Pc, ((I + 8) div 8) * 8)]; +build([C|Cs], Pc, I) -> [C|build(Cs, Pc, I+1)]; +build([], _, _) -> []. + +decr_pc($p, Pc) -> Pc - 1; +decr_pc($P, Pc) -> Pc - 1; +decr_pc(_C, Pc) -> Pc. + +%% control(FormatChar, [Argument], FieldWidth, Adjust, Precision, PadChar, + +%% Indentation) -> +%% [Char] +%% This is the main dispatch function for the various formatting commands. +%% Field widths and precisions have already been calculated. + +control($w, [A], F, Adj, P, Pad, _I) -> + term(tv_io_lib:write(A, -1), F, Adj, P, Pad); +control($p, [A], F, Adj, P, Pad, I) -> + print(A, -1, F, Adj, P, Pad, I); +control($W, [A,Depth], F, Adj, P, Pad, _I) when is_integer(Depth) -> + term(tv_io_lib:write(A, Depth), F, Adj, P, Pad); +control($P, [A,Depth], F, Adj, P, Pad, I) when is_integer(Depth) -> + print(A, Depth, F, Adj, P, Pad, I); +control($s, [A], F, Adj, P, Pad, _I) when is_atom(A) -> + string(atom_to_list(A), F, Adj, P, Pad); +control($s, [L], F, Adj, P, Pad, _I) -> + true = tv_io_lib:deep_char_list(L), %Check if L a character list + string(L, F, Adj, P, Pad); +control($e, [A], F, Adj, P, Pad, _I) when is_float(A) -> + fwrite_e(A, F, Adj, P, Pad); +control($f, [A], F, Adj, P, Pad, _I) when is_float(A) -> + fwrite_f(A, F, Adj, P, Pad); +control($g, [A], F, Adj, P, Pad, _I) when is_float(A) -> + fwrite_g(A, F, Adj, P, Pad); +control($c, [A], F, Adj, P, Pad, _I) when is_integer(A) -> + char(A band 255, F, Adj, P, Pad); +control($~, [], F, Adj, P, Pad, _I) -> char($~, F, Adj, P, Pad); +control($n, [], F, Adj, P, Pad, _I) -> newline(F, Adj, P, Pad); +control($i, [_A], _F, _Adj, _P, _Pad, _I) -> []. + +%% indentation([Char], Indentation) -> Indentation. +%% Calculate the indentation of the end of a string given its start +%% indentation. We assume tabs at 8 cols. + +indentation([$\n|Cs], _I) -> indentation(Cs, 0); +indentation([$\t|Cs], I) -> indentation(Cs, ((I + 8) div 8) * 8); +indentation([C|Cs], I) when is_integer(C) -> + indentation(Cs, I+1); +indentation([C|Cs], I) -> + indentation(Cs, indentation(C, I)); +indentation([], I) -> I. + +%% term(TermList, Field, Adjust, Precision, PadChar) +%% Output the characters in a term. + +term(T, none, _Adj, none, _Pad) -> T; +term(T, none, Adj, P, Pad) -> term(T, P, Adj, P, Pad); +term(T, F, Adj, none, Pad) -> term(T, F, Adj, min(flat_length(T), F), Pad); +term(T, F, Adj, P, Pad) when F >= P -> + adjust_error(T, F, Adj, P, Pad). + +%% print(Term, Depth, Field, Adjust, Precision, PadChar, Indentation) +%% Print a term. + +print(T, D, none, Adj, P, Pad, I) -> print(T, D, 80, Adj, P, Pad, I); +print(T, D, F, Adj, none, Pad, I) -> print(T, D, F, Adj, I+1, Pad, I); +print(T, D, F, right, P, _Pad, _I) -> + tv_io_lib_pretty:pretty_print(T, P, F, D). + +%% fwrite_e(Float, Field, Adjust, Precision, PadChar) + +fwrite_e(Fl, none, Adj, none, Pad) -> %Default values + fwrite_e(Fl, none, Adj, 6, Pad); +fwrite_e(Fl, none, _Adj, P, _Pad) when P >= 2 -> + float_e(Fl, float_data(Fl), P); +fwrite_e(Fl, F, Adj, none, Pad) -> + fwrite_e(Fl, F, Adj, 6, Pad); +fwrite_e(Fl, F, Adj, P, Pad) when P >= 2 -> + adjust_error(float_e(Fl, float_data(Fl), P), F, Adj, F, Pad). + +float_e(Fl, Fd, P) when Fl < 0.0 -> %Negative numbers + [$-|float_e(-Fl, Fd, P)]; +float_e(_Fl, {Ds,E}, P) -> + case float_man(Ds, 1, P-1) of + {[$0|Fs],true} -> [[$1|Fs]|float_exp(E)]; + {Fs,false} -> [Fs|float_exp(E-1)] + end. + +%% float_man([Digit], Icount, Dcount) -> {[Chars],CarryFlag}. +%% Generate the characters in the mantissa from the digits with Icount +%% characters before the '.' and Dcount decimals. Handle carry and let +%% caller decide what to do at top. + +float_man(Ds, 0, Dc) -> + {Cs,C} = float_man(Ds, Dc), + {[$.|Cs],C}; +float_man([D|Ds], I, Dc) -> + case float_man(Ds, I-1, Dc) of + {Cs,true} when D =:= $9 -> {[$0|Cs],true}; + {Cs,true} -> {[D+1|Cs],false}; + {Cs,false} -> {[D|Cs],false} + end; +float_man([], I, Dc) -> %Pad with 0's + {string:chars($0, I, [$.|string:chars($0, Dc)]),false}. + +float_man([D|_Ds], 0) when D >= $5 -> {[],true}; +float_man([_|_], 0) -> {[],false}; +float_man([D|Ds], Dc) -> + case float_man(Ds, Dc-1) of + {Cs,true} when D =:= $9 -> {[$0|Cs],true}; + {Cs,true} -> {[D+1|Cs],false}; + {Cs,false} -> {[D|Cs],false} + end; +float_man([], Dc) -> {string:chars($0, Dc),false}. %Pad with 0's + +%% float_exp(Exponent) -> [Char]. +%% Generate the exponent of a floating point number. Alwayd include sign. + +float_exp(E) when E >= 0 -> + [$e,$+|integer_to_list(E)]; +float_exp(E) -> + [$e|integer_to_list(E)]. + +%% fwrite_f(FloatData, Field, Adjust, Precision, PadChar) + +fwrite_f(Fl, none, Adj, none, Pad) -> %Default values + fwrite_f(Fl, none, Adj, 6, Pad); +fwrite_f(Fl, none, _Adj, P, _Pad) when P >= 1 -> + float_f(Fl, float_data(Fl), P); +fwrite_f(Fl, F, Adj, none, Pad) -> + fwrite_f(Fl, F, Adj, 6, Pad); +fwrite_f(Fl, F, Adj, P, Pad) when P >= 1 -> + adjust_error(float_f(Fl, float_data(Fl), P), F, Adj, F, Pad). + +float_f(Fl, Fd, P) when Fl < 0.0 -> + [$-|float_f(-Fl, Fd, P)]; +float_f(Fl, {Ds,E}, P) when E =< 0 -> + float_f(Fl, {string:chars($0, -E+1, Ds),1}, P); %Prepend enough 0's +float_f(_Fl, {Ds,E}, P) -> + case float_man(Ds, E, P) of + {Fs,true} -> "1" ++ Fs; %Handle carry + {Fs,false} -> Fs + end. + +%% float_data([FloatChar]) -> {[Digit],Exponent} + +float_data(Fl) -> + float_data(float_to_list(Fl), []). + +float_data([$e|E], Ds) -> + {reverse(Ds),list_to_integer(E)+1}; +float_data([D|Cs], Ds) when D >= $0, D =< $9 -> + float_data(Cs, [D|Ds]); +float_data([_D|Cs], Ds) -> + float_data(Cs, Ds). + + +%% fwrite_g(Float, Field, Adjust, Precision, PadChar) +%% Use the f form if Float is > 0.1 and < 10^4, else the e form. +%% Precision always means the # of significant digits. + +fwrite_g(Fl) -> + fwrite_g(Fl, none, right, none, $\s). + +fwrite_g(Fl, F, Adj, none, Pad) -> + fwrite_g(Fl, F, Adj, 6, Pad); +fwrite_g(Fl, F, Adj, P, Pad) when abs(Fl) < 0.1 -> + fwrite_e(Fl, F, Adj, P, Pad); +fwrite_g(Fl, F, Adj, P, Pad) when abs(Fl) < 1.0 -> + fwrite_f(Fl, F, Adj, P, Pad); +fwrite_g(Fl, F, Adj, P, Pad) when abs(Fl) < 10.0 -> + fwrite_f(Fl, F, Adj, P-1, Pad); +fwrite_g(Fl, F, Adj, P, Pad) when abs(Fl) < 100.0 -> + fwrite_f(Fl, F, Adj, P-2, Pad); +fwrite_g(Fl, F, Adj, P, Pad) when abs(Fl) < 1000.0 -> + fwrite_f(Fl, F, Adj, P-3, Pad); +fwrite_g(Fl, F, Adj, P, Pad) when abs(Fl) < 10000.0 -> + fwrite_f(Fl, F, Adj, P-4, Pad); +fwrite_g(Fl, F, Adj, P, Pad) -> + fwrite_e(Fl, F, Adj, P, Pad). + +%% string(String, Field, Adjust, Precision, PadChar) + +string(S, none, _Adj, none, _Pad) -> S; +string(S, F, Adj, none, Pad) -> + string(S, F, Adj, min(flat_length(S), F), Pad); +string(S, none, _Adj, P, Pad) -> + string:left(flatten(S), P, Pad); +string(S, F, Adj, P, Pad) when F >= P -> + adjust(string:left(flatten(S), P, Pad), string:chars(Pad, F - P), Adj). + +%% char(Char, Field, Adjust, Precision, PadChar) -> [Char]. + +char(C, none, _Adj, none, _Pad) -> [C]; +char(C, F, _Adj, none, _Pad) -> string:chars(C, F); +char(C, none, _Adj, P, _Pad) -> string:chars(C, P); +char(C, F, Adj, P, Pad) when F >= P -> + adjust(string:chars(C, P), string:chars(Pad, F - P), Adj). + +%% newline(Field, Adjust, Precision, PadChar) -> [Char]. + +newline(none, _Adj, _P, _Pad) -> "\n"; +newline(F, right, _P, _Pad) -> string:chars($\n, F). + +%% adjust_error([Char], Field, Adjust, Max, PadChar) -> [Char]. +%% Adjust the characters within the field if length less than Max padding +%% with PadChar. + +adjust_error(Cs, F, Adj, M, Pad) -> + L = flat_length(Cs), + if + L > M -> + adjust(string:chars($*, M), string:chars(Pad, F - M), Adj); + true -> + adjust(Cs, string:chars(Pad, F - L), Adj) + end. + +adjust(Data, Pad, left) -> [Data,Pad]; +adjust(Data, Pad, right) -> [Pad,Data]. + +%% +%% Utilities +%% + +reverse(List) -> + reverse(List, []). + +reverse([H|T], Stack) -> + reverse(T, [H|Stack]); +reverse([], Stack) -> Stack. + +min(L, R) when L < R -> L; +min(_, R) -> R. + +%% flatten(List) +%% Flatten a list. + +flatten(List) -> flatten(List, []). + +flatten([H|T], Cont) when is_list(H) -> + flatten(H, [T|Cont]); +flatten([H|T], Cont) -> + [H|flatten(T, Cont)]; +flatten([], [H|Cont]) -> flatten(H, Cont); +flatten([], []) -> []. + +%% flat_length(List) +%% Calculate the length of a list of lists. + +flat_length(List) -> flat_length(List, 0). + +flat_length([H|T], L) when is_list(H) -> + flat_length(H, flat_length(T, L)); +flat_length([_|T], L) -> + flat_length(T, L + 1); +flat_length([], L) -> L. diff --git a/lib/tv/src/tv_io_lib_pretty.erl b/lib/tv/src/tv_io_lib_pretty.erl new file mode 100644 index 0000000000..c19277d006 --- /dev/null +++ b/lib/tv/src/tv_io_lib_pretty.erl @@ -0,0 +1,171 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1998-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% +-module(tv_io_lib_pretty). + + + +-export([pretty_print/4]). + +%% pretty_print(Term, Column, LineLength, Depth) -> [Chars] +%% Depth = -1 gives unlimited print depth. Use tv_io_lib:write for atomic terms. + +pretty_print(_, _, _, 0) -> "..."; +pretty_print([], _, _, _) -> "[]"; +pretty_print({}, _, _, _) -> "{}"; +pretty_print(List, Col, Ll, D) when is_list(List) -> + case tv_io_lib:printable_list(List) of + true -> + tv_io_lib:write_string(List, $"); + false -> + Len = write_length(List, D, 0, Ll - Col), + if + D =:= 1 -> "[...]"; + Len + Col < Ll -> + write(List, D); + true -> + [$[, + [pretty_print(hd(List), Col + 1, Ll, D - 1)| + pretty_print_tail(tl(List), Col + 1, Ll, D - 1)], + $]] + end + end; +pretty_print(Fun, _Col, _Ll, _D) when is_function(Fun) -> + tv_io_lib:write(Fun); +pretty_print(Tuple, Col, Ll, D) when is_tuple(Tuple) -> + Len = write_length(Tuple, D, 0, Ll - Col), + if + D =:= 1 -> "{...}"; + Len + Col < Ll -> + write(Tuple, D); + is_atom(element(1, Tuple)), size(Tuple) > 1 -> + print_tag_tuple(Tuple, Col, Ll, D); + true -> + [${, + [pretty_print(element(1, Tuple), Col + 1, Ll, D - 1)| + pretty_print_tail(tl(tuple_to_list(Tuple)), Col + 1, Ll, D - 1)], + $}] + end; +pretty_print(Term, _Col, _Ll, D) -> tv_io_lib:write(Term, D). + +%% print_tag_tuple(Tuple, Column, LineLength, Depth) -> [Char] +%% Print a tagged tuple by indenting the rest of the elements differently +%% to the tag. Start beside the tag if start column not too far to +%% the right. Tuple has size >= 2. + +print_tag_tuple(Tuple, Col, Ll, D) -> + Tag = tv_io_lib:write_atom(element(1, Tuple)), + Tlen = length(Tag), + Tcol = Col + Tlen + 2, + if + Tcol >= Ll div 2, Tlen > 2 -> + [${,Tag, + pretty_print_tail(tl(tuple_to_list(Tuple)), Col + 4, Ll, D - 2), + $}]; + true -> + [${,Tag,$,, + [pretty_print(element(2, Tuple), Col + Tlen + 2, Ll, D - 2)| + pretty_print_tail(tl(tl(tuple_to_list(Tuple))), Tcol, Ll, D - 3)], + $}] + end. + +%% pretty_print_tail([Element], Column, LineLength, D) -> [Char] +%% Pretty print the elements of a list or tuple. + +pretty_print_tail([], _Col, _Ll, _D) -> ""; +pretty_print_tail(_Es, _Col, _Ll, 1) -> "|..."; +pretty_print_tail([E|Es], Col, Ll, D) -> + [$,,nl_indent(Col-1), + pretty_print(E, Col, Ll, D-1)| + pretty_print_tail(Es, Col, Ll, D-1)]; +pretty_print_tail(E, Col, Ll, D) -> + [$|,nl_indent(Col-1),pretty_print(E, Col, Ll, D-1)]. + +%% write(Term, Depth) -> [Char] +%% Write a term down to Depth on one line. Use tv_io_lib:write/2 for +%% atomic terms. + +write(_, 0) -> "..."; +write([], _) -> "[]"; +write({}, _) -> "{}"; +write(List, D) when is_list(List) -> + case tv_io_lib:printable_list(List) of + true -> + tv_io_lib:write_string(List, $"); + false -> + if + D =:= 1 -> "[...]"; + true -> + [$[, + [write(hd(List), D-1)|write_tail(tl(List), D-1)], + $]] + end + end; +write(Fun, _D) when is_function(Fun) -> tv_io_lib:write(Fun); %Must catch this first +write(T, D) when is_tuple(T) -> + if + D =:= 1 -> "{...}"; + true -> + [${, + [write(element(1, T), D-1)|write_tail(tl(tuple_to_list(T)), D-1)], + $}] + end; +write(Term, D) -> tv_io_lib:write(Term, D). + +write_tail([], _D) -> ""; +write_tail(_Es, 1) -> "|..."; +write_tail([E|Es], D) -> + [$,,write(E, D - 1)|write_tail(Es, D - 1)]; +write_tail(E, D) -> + [$|,write(E, D - 1)]. + +%% write_length(Term, Depth, Accumulator, MaxLength) -> integer() +%% Calculate the print length of a term, but exit when length becomes +%% greater than MaxLength. + +write_length(_T, _D, Acc, Max) when Acc > Max -> Acc; +write_length(_T, 0, Acc, _Max) -> Acc + 3; +write_length([], _, Acc, _) -> Acc + 2; +write_length({}, _, Acc, _) -> Acc + 2; +write_length(List, D, Acc, Max) when is_list(List) -> + case tv_io_lib:printable_list(List) of + true -> + Acc + length(tv_io_lib:write_string(List, $")); + false -> + write_length_list(List, D, Acc, Max) + end; +write_length(Fun, _D, Acc, _Max) when is_function(Fun) -> + Acc + length(tv_io_lib:write(Fun)); +write_length(Tuple, D, Acc, Max) when is_tuple(Tuple) -> + write_length_list(tuple_to_list(Tuple), D, Acc, Max); +write_length(Term, _D, Acc, _Max) -> + Acc + length(tv_io_lib:write(Term)). + +write_length_list(_, _, Acc, Max) when Acc > Max -> Acc; +write_length_list([], _, Acc, _) -> Acc + 1; %] +write_length_list(_Es, 1, Acc, _) -> Acc + 5; %|...] +write_length_list([E|Es], D, Acc, Max) -> + write_length_list(Es, + D - 1, + write_length(E, D - 1, Acc + 1, Max), + Max); +write_length_list(E, D, Acc, Max) -> + write_length(E, D - 1, Acc + 2, Max). %| ] + + + +nl_indent(_) -> "". diff --git a/lib/tv/src/tv_ip.erl b/lib/tv/src/tv_ip.erl new file mode 100644 index 0000000000..aeec4e8f6d --- /dev/null +++ b/lib/tv/src/tv_ip.erl @@ -0,0 +1,236 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1997-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% +-module(tv_ip). + + + +-export([ip/1]). + + + +-include("tv_int_msg.hrl"). + + +-define(NOF_LABELS, 25). + +-define(DEFAULT_BG_COLOR, {217, 217, 217}). + + + + + + + +%%%********************************************************************* +%%% EXTERNAL FUNCTIONS +%%%********************************************************************* + + + +%%====================================================================== +%% Function: +%% +%% Return Value: +%% +%% Description: +%% +%% Parameters: +%%====================================================================== + + +ip(_Master) -> + W = gs:window(win, gs:start(), [{width, 302}, + {height, 38}, + {bg, ?DEFAULT_BG_COLOR}, + {title, "Launching..."} + ]), + C = gs:canvas(W, [{width, 40}, + {height, 35}, + {x, 0}, + {bg, {255, 255, 255}} + ]), + gs:create(image, C, [{load_gif, code:priv_dir(tv) ++ "/erlang.gif"}]), + gs:label(W, [{width, 252}, + {height, 12}, + {x, 47}, + {y, 23}, + {bg, {0, 0, 0}}, + {cursor, arrow} + ]), + + LabelList = create_labels(?NOF_LABELS, W, 48), + + L = gs:label(W, [{width, 250}, + {height, 18}, + {x, 47}, + {y, 0}, + {bg, ?DEFAULT_BG_COLOR}, + {fg, {0, 0, 0}}, + {align, w} + ]), + gs:config(win, [{map, true}]), + loop(1, LabelList, L). + + + + + + + + + +%%%********************************************************************* +%%% INTERNAL FUNCTIONS +%%%********************************************************************* + + + + +%%====================================================================== +%% Function: +%% +%% Return Value: +%% +%% Description: +%% +%% Parameters: +%%====================================================================== + + +create_labels(0, _WinId, _Xpos) -> + []; +create_labels(N, WinId, Xpos) -> + Width = 10, + Xdiff = Width, + LabelId = gs:label(WinId, [{width, Width}, + {height, 10}, + {x, Xpos}, + {y, 24}, + {bg, {235, 235, 235}}, + {cursor, arrow} + ]), + + [LabelId | create_labels(N - 1, WinId, Xpos + Xdiff)]. + + + + + + + + + + + +%%====================================================================== +%% Function: +%% +%% Return Value: +%% +%% Description: +%% +%% Parameters: +%%====================================================================== + + +loop(N, LabelList, L) -> + receive + Msg -> + case Msg of + + #ip_update{nof_elements_to_mark = X, text = Text} -> + update_window(LabelList, N, N + X, L, Text), + loop(N + X, LabelList, L); + + #ip_quit{} -> + update_labels(LabelList, N, ?NOF_LABELS), + receive + after 1000 -> + done + end, + done; + + _Other -> + loop(N, LabelList, L) + end + end. + + + + + + + + + + + +%%====================================================================== +%% Function: +%% +%% Return Value: +%% +%% Description: +%% +%% Parameters: +%%====================================================================== + + +update_window(LabelList, N, Hi, LblId, Text) -> + gs:config(win, [raise]), + gs:config(LblId, [{label, {text, Text}}]), + update_labels(LabelList, N, Hi). + + + + + + + + +%%====================================================================== +%% Function: +%% +%% Return Value: +%% +%% Description: +%% +%% Parameters: +%%====================================================================== + + +update_labels(_LabelList, N, _Hi) when N > ?NOF_LABELS -> + done; +update_labels(_LabelList, N, Hi) when N >= Hi -> + done; +update_labels(LabelList, N, Hi) -> + LabelId = lists:nth(N, LabelList), + gs:config(LabelId, [{bg, {0, 0, 255}}]), + update_labels(LabelList, N + 1, Hi). + + + + + + + + + + + + diff --git a/lib/tv/src/tv_main.erl b/lib/tv/src/tv_main.erl new file mode 100644 index 0000000000..2f743c2397 --- /dev/null +++ b/lib/tv/src/tv_main.erl @@ -0,0 +1,1807 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1998-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% +-module(tv_main). + + + +-export([start/0, + init/0 + ]). + + +-export([get_ets_tables/1, + get_mnesia_tables/1 + ]). + + + +-include("tv_main.hrl"). +-include("tv_int_msg.hrl"). +-include("tv_pd_int_msg.hrl"). +-include("tv_pd_int_def.hrl"). + + + + +%%%********************************************************************* +%%% EXTERNAL FUNCTIONS +%%%********************************************************************* + + +start() -> + spawn(?MODULE, init, []). + + + +init() -> + process_flag(trap_exit,true), + %% OK, so it's *BAD* to use the process dictionary... + %% So why have I used it? Because it is simple to remove the haiku-functionality, + %% if that is desired. Otherwise a lot of functions (the parameters) would have + %% to be changed. + put(error_msg_mode, ?ERROR_MSG_MODE), + KindOfTable = ets, + SysTabHidden = true, + UnreadHidden = true, + SortKey = ?NAME_COL, + CurrNode = node(), + Children = start_tv_nodewin(CurrNode), + {MarkedCell, TempGridLines, WinSize, ShortcutList} = create_window([]), + Tables = get_tables(CurrNode, KindOfTable, UnreadHidden, SysTabHidden,SortKey), + gs:config(grid, [{rows, {1, get_nof_rows(length(Tables), + gs:read(grid, height))}}]), + GridLines = update_gridlines(Tables, TempGridLines, 1), + gs:config(win, [{map, true}, {cursor,arrow}]), + %% To avoid unpleasant error/exit messages, we surround the loop with a catch. + catch loop(KindOfTable, CurrNode, MarkedCell, GridLines, WinSize, Tables, ShortcutList, + UnreadHidden, SysTabHidden, SortKey, Children). + + + +start_tv_nodewin(CurrNode) -> + NodewinPid = tv_nodewin:start(CurrNode, get(error_msg_mode)), + [{NodewinPid, tv_nodewin, CurrNode}]. + + + + + +get_ets_tables(SysTabHidden) -> + Tables = ets:all(), + get_ets_table_info(Tables, + hidden_tables(ets, SysTabHidden) ++ + current_mnesia_tables(SysTabHidden), + owners_to_hide(ets, SysTabHidden), + []). + + + +get_mnesia_tables(SysTabHidden) -> + Tables = mnesia:system_info(tables), + get_mnesia_table_info(Tables -- hidden_tables(mnesia, SysTabHidden), + owners_to_hide(mnesia, SysTabHidden), + []). + + + + + +owners_to_hide(ets, true) -> + ?SYSTEM_OWNERS; +owners_to_hide(ets, false) -> + []; +owners_to_hide(mnesia, true) -> + []; +owners_to_hide(mnesia, false) -> + []. + + + + +get_mnesia_table_info([], _OwnersToHide, Acc) -> + lists:keysort(?NAME_ELEM, Acc); +get_mnesia_table_info([TabId | Tail], OwnersToHide, Acc) -> + case catch get_mnesia_owner_size(TabId) of + {'EXIT', _Reason} -> + %% Ignore tables ceasing to exist. + %% Nodedown errors caught above! + get_mnesia_table_info(Tail, OwnersToHide, Acc); + {OwnerPid, OwnerName, Size} -> + case lists:member(OwnerName, OwnersToHide) of + true -> + get_mnesia_table_info(Tail, OwnersToHide, Acc); + false -> + Readable = not(lists:member(TabId, ?UNREADABLE_MNESIA_TABLES)), + get_mnesia_table_info(Tail, + OwnersToHide, + [{TabId, {notext}, {notext}, Readable, + OwnerPid, OwnerName, Size} | Acc]) + end + end. + + + + +get_mnesia_owner_size(TabId) -> + {OwnerPid, OwnerName} = + case catch mnesia:table_info(TabId, owner) of + Pid when is_pid(Pid) -> + case lists:keysearch(registered_name, 1, process_info(Pid)) of + false -> + {Pid, {notext}}; + {value, {registered_name, ProcName}} -> + {Pid, ProcName} + end; + _Other -> + {{notext}, {notext}} + end, + Size = mnesia:table_info(TabId, size), + {OwnerPid, OwnerName, Size}. + + + + + + + +hidden_tables(_Any, true) -> + ?SYSTEM_TABLES ++ ?MNESIA_TABLES; +hidden_tables(ets, _SysTabHidden) -> + ?MNESIA_TABLES; +hidden_tables(mnesia, _SysTabHidden) -> + []. + + + + +get_tables(Node, KindOfTable, UnreadHidden, SysTabHidden,SortKey) -> + LocalNode = (Node =:= node()), + Tables = + case catch get_table_list(Node,LocalNode,KindOfTable,SysTabHidden) of + Result when is_list(Result) -> + case UnreadHidden of + true -> + lists:filter(fun(H) -> + element(?READABLE_ELEM, H) + end, + Result); + _Other -> + Result + end; + Error -> + analyze_error(Error, Node, undefined), + [] + end, + case SortKey of + ?PROCNAME_ELEM -> + lists:keysort(SortKey, + lists:keysort(?PID_ELEM, Tables)); + _OtherCol -> + lists:keysort(SortKey, + lists:keysort(?NAME_ELEM, Tables)) + end. + + + + + +get_ets_table_info([], _TablesToHide, _OwnersToHide, Acc) -> + lists:keysort(?ID_ELEM, Acc); +get_ets_table_info([TabId | Tail], TablesToHide, OwnersToHide, Acc) -> + case catch get_ets_name_owner_protection(TabId) of + {'EXIT', _Reason} -> + %% Ignore tables ceasing to exist. + %% Nodedown errors caught above! + get_ets_table_info(Tail, TablesToHide, OwnersToHide, Acc); + {Name, NamedTable, Id, Readable, OwnerPid, OwnerName, Size} -> + case lists:member(Name, TablesToHide) of + true -> + get_ets_table_info(Tail, TablesToHide, OwnersToHide, Acc); + false -> + case lists:member(OwnerName, OwnersToHide) of + true -> + get_ets_table_info(Tail, TablesToHide, OwnersToHide, Acc); + false -> + get_ets_table_info(Tail, TablesToHide, OwnersToHide, + [{Name,NamedTable,Id,Readable, + OwnerPid,OwnerName,Size} | Acc]) + end + end + end. + + + +get_ets_name_owner_protection(TabId) -> + Name = ets:info(TabId, name), + OwnerPid = ets:info(TabId, owner), + Readable = case ets:info(TabId, protection) of + private -> + false; + _Other -> + true + end, + Size = ets:info(TabId, size), + {NamedTable,Id} = case ets:info(TabId, named_table) of + true -> + {true,{notext}}; + false -> + {false, TabId} + end, + PName = case lists:keysearch(registered_name, 1, process_info(OwnerPid)) of + false -> + {notext}; + {value, {registered_name, ProcName}} -> + ProcName + end, + {Name, NamedTable, Id, Readable, OwnerPid, PName, Size}. + + + + + + +current_mnesia_tables(SysTabHidden) -> + case catch get_table_list(node(), true, mnesia, SysTabHidden) of + Result when is_list(Result) -> + lists:map(fun(H) -> + element(?NAME_ELEM, H) + end, + Result); + nodedown -> + handle_error(nodedown, node(), undefined), + []; + _Other -> + [] + end. + + + + +get_table_list(_Node, true, ets, SysTabHidden) -> + get_ets_tables(SysTabHidden); +get_table_list(Node, false, ets, SysTabHidden) -> + case rpc:block_call(Node, ?MODULE, get_ets_tables, [SysTabHidden]) of + {badrpc, Reason} -> + throw({badrpc,Reason}); + Result -> + Result + end; +get_table_list(_Node, true, mnesia, SysTabHidden) -> + get_mnesia_tables(SysTabHidden); +get_table_list(Node, false, mnesia, SysTabHidden) -> + case rpc:block_call(Node, ?MODULE, get_mnesia_tables, [SysTabHidden]) of + {badrpc,Reason} -> + throw({badrpc,Reason}); + Result -> + Result + end. + + + + +analyze_error(Cause, Node, Table) -> + case Cause of + {badrpc, {'EXIT', {badarg,_Reason}}} -> + done; %% Table has ceased to exist. + {'EXIT', {badarg, {ets,local_info,_Args}}} -> + done; + + {badrpc, nodedown} -> + handle_error(nodedown, Node, Table); + {'EXIT', nodedown} -> + handle_error(nodedown, Node, Table); + + {'EXIT', {aborted, {node_not_running,_ErrNode}}} -> + handle_error(mnesia_not_started, Node, Table); + {'EXIT', {'EXIT', {aborted, {node_not_running,_ErrNode}}}} -> + handle_error(mnesia_not_started, Node, Table); + {badrpc, {'EXIT', {aborted, {node_not_running,_ErrNode}}}} -> + handle_error(mnesia_not_started, Node, Table); + {'EXIT', {undef, {mnesia,_Fcn,_Args}}} -> + handle_error(mnesia_not_started, Node, Table); + + {'EXIT', Reason} -> + handle_error({unexpected_error,Reason}, Node, Table); + Error when is_tuple(Error) -> + handle_error({unexpected_error,Error}, Node, Table) + end. + + + +handle_error(mnesia_not_started, _Node, _Table) -> + gs:config(win, [beep]), + case get(error_msg_mode) of + normal -> + tv_utils:notify(win, "TV Notification", ["Mnesia not started!"]); + haiku -> + tv_utils:notify(win, "TV Notification", ["Mnesia is stopped.", + "We wish to reach all data", + "But we never will."]) + end; +handle_error(nodedown, _Node, _Table) -> + gs:config(win, [beep]), + case get(error_msg_mode) of + normal -> + tv_utils:notify(win, "TV Notification", ["The selected node is down!"]); + haiku -> + Msg = ["With searching comes loss", + "And the presence of absence:", + "Node is down."], + tv_utils:notify(win, "TV Notification", Msg) + end, + self() ! nodedown; +handle_error({unexpected_error,Cause}, _Node, _Table) -> + io:format("Unexpected error: ~p~n", [Cause]), + gs:config(win, [beep]). + + + + +loop(KindOfTable,CurrNode,MarkedCell,GridLines, + WinSize,Tables,Shortcuts,UnreadHidden,SysTabHidden,SortKey,Children) -> + receive + + {gs, Gridline, click, {grid,Readable}, [Col,Row,Text | _]} when Text =/= "" -> + unmark_cell(MarkedCell, Tables), + NewMarkedCell = mark_cell({Gridline, Col, Row}, MarkedCell, Readable), + loop(KindOfTable,CurrNode,NewMarkedCell,GridLines,WinSize,Tables,Shortcuts, + UnreadHidden,SysTabHidden,SortKey,Children); + + + {gs, _Gridline, click, {grid,_Readable}, [_Col,_Row,"" | _]} -> + NewMarkedCell = unmark_cell(MarkedCell, Tables), + loop(KindOfTable,CurrNode,NewMarkedCell,GridLines,WinSize,Tables,Shortcuts, + UnreadHidden,SysTabHidden,SortKey,Children); + + + {gs, Gridline, doubleclick, {grid,Data}, [?NAME_COL,Row,Text | _]} when Text =/= "" -> + unmark_cell(MarkedCell, Tables), + NewMarkedCell = mark_cell({Gridline, ?NAME_COL, Row}, undefined, Data), + {Table, Name, Readable} = get_table_id(KindOfTable, Row, Tables), + case start_tv_browser(Table,CurrNode,Name,KindOfTable,Readable,Children) of + Children -> + {FinalMarkedCell, NewTables, NewGridLines} = + refresh_window(NewMarkedCell,Tables,KindOfTable,CurrNode,GridLines, + UnreadHidden,SysTabHidden,SortKey, Children), + loop(KindOfTable,CurrNode,FinalMarkedCell,NewGridLines,WinSize,NewTables, + Shortcuts,UnreadHidden,SysTabHidden,SortKey,Children); + NewChildren -> + loop(KindOfTable,CurrNode,NewMarkedCell,GridLines,WinSize,Tables,Shortcuts, + UnreadHidden,SysTabHidden,SortKey,NewChildren) + end; + + + {gs, Gridline, doubleclick, {grid,Data}, [?ID_COL,Row,Text | _]} when Text =/= "" -> + unmark_cell(MarkedCell, Tables), + NewMarkedCell = mark_cell({Gridline, ?ID_COL, Row}, undefined, Data), + {Table, Name, Readable} = get_table_id(KindOfTable, Row, Tables), + case start_tv_browser(Table,CurrNode,Name,KindOfTable,Readable,Children) of + Children -> + {FinalMarkedCell, NewTables, NewGridLines} = + refresh_window(NewMarkedCell,Tables,KindOfTable,CurrNode,GridLines, + UnreadHidden,SysTabHidden,SortKey, Children), + loop(KindOfTable,CurrNode,FinalMarkedCell,NewGridLines,WinSize,NewTables, + Shortcuts,UnreadHidden,SysTabHidden,SortKey,Children); + NewChildren -> + loop(KindOfTable,CurrNode,NewMarkedCell,GridLines,WinSize,Tables,Shortcuts, + UnreadHidden,SysTabHidden,SortKey,NewChildren) + end; + + + {gs, Gridline, doubleclick, {grid,Data}, [?INFO_COL,Row,Text | _]} when Text =/= "" -> + unmark_cell(MarkedCell, Tables), + NewMarkedCell = mark_cell({Gridline, ?INFO_COL, Row}, undefined, Data), + {Table, _Name, _Readable} = get_table_id(KindOfTable, Row, Tables), + case start_tv_info(Table, CurrNode, CurrNode =:= node(), KindOfTable, Children) of + Children -> + {FinalMarkedCell, NewTables, NewGridLines} = + refresh_window(NewMarkedCell,Tables,KindOfTable,CurrNode,GridLines, + UnreadHidden,SysTabHidden,SortKey, Children), + loop(KindOfTable,CurrNode,FinalMarkedCell,NewGridLines,WinSize,NewTables, + Shortcuts,UnreadHidden,SysTabHidden,SortKey,Children); + NewChildren -> + loop(KindOfTable,CurrNode,NewMarkedCell,GridLines,WinSize,Tables,Shortcuts, + UnreadHidden,SysTabHidden,SortKey,NewChildren) + end; + + + {gs, Gridline, doubleclick, {grid,Data}, [?PID_COL,Row,Text | _]} when Text =/= "" -> + unmark_cell(MarkedCell, Tables), + NewMarkedCell = mark_cell({Gridline, ?PID_COL, Row}, undefined, Data), + OwnerPid = element(?PID_ELEM, lists:nth(Row, Tables)), + NewChildren = start_pman(OwnerPid, Children), + loop(KindOfTable,CurrNode,NewMarkedCell,GridLines,WinSize,Tables,Shortcuts, + UnreadHidden,SysTabHidden,SortKey, NewChildren); + + + {gs, Gridline, doubleclick, {grid,Data}, [?PROCNAME_COL,Row,Text | _]} when Text =/= "" -> + unmark_cell(MarkedCell, Tables), + NewMarkedCell = mark_cell({Gridline, ?PROCNAME_COL, Row}, undefined, Data), + OwnerPid = element(?PID_ELEM, lists:nth(Row, Tables)), + NewChildren = start_pman(OwnerPid, Children), + loop(KindOfTable,CurrNode,NewMarkedCell,GridLines,WinSize,Tables,Shortcuts, + UnreadHidden,SysTabHidden,SortKey, NewChildren); + + +%% {gs, win, configure, _Data, [Width, Height | _]} when {Width,Height} /= WinSize -> + Msg0 = {gs, win, configure, _Data, [Width0, Height0 | _]} + when {Width0,Height0} =/= WinSize -> + {gs, win, configure, _, [Width,Height|_]} = flush_msgs(Msg0), + + NewSize = resize_window(Width, Height, length(Tables)), + loop(KindOfTable,CurrNode,MarkedCell,GridLines,NewSize,Tables,Shortcuts, + UnreadHidden,SysTabHidden,SortKey,Children); + + + {gs, _Id, click, update, _Args} -> + gs:config(win, [{cursor,busy}]), + NewMarkedCell = unmark_cell(MarkedCell, Tables), + {NewTables, NewGridLines} = + update_grid(KindOfTable,CurrNode,GridLines,UnreadHidden,SysTabHidden,SortKey), + update_tv_info(Children), + gs:config(win, [{cursor,arrow}]), + loop(KindOfTable,CurrNode,NewMarkedCell,NewGridLines,WinSize,NewTables,Shortcuts, + UnreadHidden,SysTabHidden,SortKey,Children); + + + {gs, _Id, click, open_table, _Args} -> + {Table, Name, Readable} = get_table_id(KindOfTable, element(3, MarkedCell), + Tables), + case start_tv_browser(Table,CurrNode,Name,KindOfTable,Readable,Children) of + Children -> + {NewMarkedCell, NewTables, NewGridLines} = + refresh_window(MarkedCell,Tables,KindOfTable,CurrNode,GridLines, + UnreadHidden,SysTabHidden,SortKey, Children), + loop(KindOfTable,CurrNode,NewMarkedCell,NewGridLines,WinSize,NewTables, + Shortcuts,UnreadHidden,SysTabHidden,SortKey,Children); + NewChildren -> + loop(KindOfTable,CurrNode,MarkedCell,GridLines,WinSize,Tables,Shortcuts, + UnreadHidden,SysTabHidden,SortKey,NewChildren) + end; + + + {gs, _Id, click, new_table, _Args} -> + NewChildren = start_tv_new_table(CurrNode, Children), + loop(KindOfTable,CurrNode,MarkedCell,GridLines,WinSize,Tables,Shortcuts, + UnreadHidden,SysTabHidden,SortKey,NewChildren); + + + {gs, _Id, click, select_node, _Args} -> + show_tv_nodewin(Children), + loop(KindOfTable,CurrNode,MarkedCell,GridLines,WinSize,Tables,Shortcuts, + UnreadHidden,SysTabHidden,SortKey,Children); + + + {gs, _Id, click, show_mnesia, _Args} when KindOfTable =:= ets -> + gs:config(win, [{cursor,busy}]), + NewMarkedCell = unmark_cell(MarkedCell, Tables), + gs:config(label2, [{fg, ?DISABLED_COLOR}]), + gs:config(sort_table_id, [{enable, false}]), + NewSortKey = + case SortKey of + ?ID_ELEM -> + gs:config(sort_table_name, [{select,true}]), + ?NAME_ELEM; + _Other -> + SortKey + end, + {NewTables, NewGridLines} = + update_grid(mnesia, CurrNode, GridLines, UnreadHidden, SysTabHidden, NewSortKey), + gs:config(win, [{cursor,arrow}]), + loop(mnesia,CurrNode,NewMarkedCell,NewGridLines,WinSize,NewTables,Shortcuts, + UnreadHidden,SysTabHidden,NewSortKey,Children); + + + {gs, _Id, click, show_ets, _Args} when KindOfTable =:= mnesia -> + gs:config(win, [{cursor,busy}]), + NewMarkedCell = unmark_cell(MarkedCell, Tables), + gs:config(label2, [{fg, ?NORMAL_FG_COLOR}]), + gs:config(label3, [{fg, ?NORMAL_FG_COLOR}]), + gs:config(label4, [{fg, ?NORMAL_FG_COLOR}]), + {NewTables, NewGridLines} = + update_grid(ets, CurrNode, GridLines, UnreadHidden, SysTabHidden,SortKey), + %% gs:config(show_unreadable, [{enable, true}, + %% {select, not(UnreadHidden)}]), + gs:config(sort_table_id, [{enable, true}]), + gs:config(win, [{cursor,arrow}]), + loop(ets,CurrNode,NewMarkedCell,NewGridLines,WinSize,NewTables,Shortcuts, + UnreadHidden,SysTabHidden,SortKey,Children); + + + {gs, _Id, click, show_system, _Args} when SysTabHidden -> + gs:config(win, [{cursor,busy}]), + NewMarkedCell = unmark_cell(MarkedCell, Tables), + {NewTables, NewGridLines} + = update_grid(KindOfTable, CurrNode, GridLines, UnreadHidden, false, SortKey), + gs:config(show_system, [{data, hide_system}]), + gs:config(win, [{cursor,arrow}]), + loop(KindOfTable,CurrNode,NewMarkedCell,NewGridLines,WinSize,NewTables,Shortcuts, + UnreadHidden,false,SortKey,Children); + + + {gs, _Id, click, hide_system, _Args} when not SysTabHidden -> + gs:config(win, [{cursor,busy}]), + NewMarkedCell = unmark_cell(MarkedCell, Tables), + {NewTables, NewGridLines} = + update_grid(KindOfTable, CurrNode, GridLines, UnreadHidden, true, SortKey), + gs:config(show_system, [{label, {text, " System Tables "}}, + {data, show_system}]), + gs:config(win, [{cursor,arrow}]), + loop(KindOfTable,CurrNode,NewMarkedCell,NewGridLines,WinSize,NewTables,Shortcuts, + UnreadHidden,true,SortKey,Children); + + + {gs, _Id, click, show_unreadable, _Args} when UnreadHidden -> + gs:config(win, [{cursor,busy}]), + NewMarkedCell = unmark_cell(MarkedCell, Tables), + {NewTables, NewGridLines} + = update_grid(KindOfTable, CurrNode, GridLines, false, SysTabHidden, SortKey), + gs:config(show_unreadable, [{data, hide_unreadable}]), + gs:config(win, [{cursor,arrow}]), + loop(KindOfTable,CurrNode,NewMarkedCell,NewGridLines,WinSize,NewTables,Shortcuts, + false,SysTabHidden,SortKey,Children); + + + {gs, _Id, click, hide_unreadable, _Args} when not UnreadHidden -> + gs:config(win, [{cursor,busy}]), + NewMarkedCell = unmark_cell(MarkedCell, Tables), + {NewTables, NewGridLines} = + update_grid(KindOfTable, CurrNode, GridLines, true, SysTabHidden, SortKey), + gs:config(show_unreadable, [{label, {text, " Unreadable Tables "}}, + {data, show_unreadable}]), + gs:config(win, [{cursor,arrow}]), + loop(KindOfTable,CurrNode,NewMarkedCell,NewGridLines,WinSize,NewTables,Shortcuts, + true,SysTabHidden,SortKey,Children); + + + {gs, _Id, click, show_info, _Args} -> + {Table, _Name, _Readable} = get_table_id(KindOfTable, element(3,MarkedCell), + Tables), + case start_tv_info(Table, CurrNode, CurrNode =:= node(), KindOfTable, Children) of + Children -> + {NewMarkedCell, NewTables, NewGridLines} = + refresh_window(MarkedCell,Tables,KindOfTable,CurrNode,GridLines, + UnreadHidden,SysTabHidden,SortKey, Children), + loop(KindOfTable,CurrNode,NewMarkedCell,NewGridLines,WinSize,NewTables, + Shortcuts,UnreadHidden,SysTabHidden,SortKey,Children); + NewChildren -> + loop(KindOfTable,CurrNode,MarkedCell,GridLines,WinSize,Tables,Shortcuts, + UnreadHidden,SysTabHidden,SortKey,NewChildren) + end; + + + {gs, _Id, click, sort_table_name, _Args} when SortKey =/= ?NAME_ELEM -> + gs:config(win, [{cursor,busy}]), + NewMarkedCell = unmark_cell(MarkedCell, Tables), + {NewTables, NewGridLines} = + update_grid(KindOfTable,CurrNode,GridLines,UnreadHidden,SysTabHidden,?NAME_ELEM), + gs:config(win, [{cursor,arrow}]), + loop(KindOfTable,CurrNode,NewMarkedCell,NewGridLines,WinSize,NewTables,Shortcuts, + UnreadHidden,SysTabHidden,?NAME_ELEM,Children); + + + {gs, _Id, click, sort_table_id, _Args} when SortKey =/= ?ID_ELEM -> + gs:config(win, [{cursor,busy}]), + NewMarkedCell = unmark_cell(MarkedCell, Tables), + {NewTables, NewGridLines} = + update_grid(KindOfTable,CurrNode,GridLines,UnreadHidden,SysTabHidden,?ID_ELEM), + gs:config(win, [{cursor,arrow}]), + loop(KindOfTable,CurrNode,NewMarkedCell,NewGridLines,WinSize,NewTables,Shortcuts, + UnreadHidden,SysTabHidden,?ID_ELEM,Children); + + + {gs, _Id, click, sort_owner_name, _Args} when SortKey =/= ?PROCNAME_ELEM -> + gs:config(win, [{cursor,busy}]), + NewMarkedCell = unmark_cell(MarkedCell, Tables), + {NewTables, NewGridLines} = + update_grid(KindOfTable,CurrNode,GridLines,UnreadHidden,SysTabHidden, + ?PROCNAME_ELEM), + gs:config(win, [{cursor,arrow}]), + loop(KindOfTable,CurrNode,NewMarkedCell,NewGridLines,WinSize,NewTables,Shortcuts, + UnreadHidden,SysTabHidden,?PROCNAME_ELEM,Children); + + + {gs, _Id, click, sort_owner_pid, _Args} when SortKey =/= ?PID_ELEM -> + gs:config(win, [{cursor,busy}]), + NewMarkedCell = unmark_cell(MarkedCell, Tables), + {NewTables, NewGridLines} = + update_grid(KindOfTable,CurrNode,GridLines,UnreadHidden,SysTabHidden,?PID_ELEM), + gs:config(win, [{cursor,arrow}]), + loop(KindOfTable,CurrNode,NewMarkedCell,NewGridLines,WinSize,NewTables,Shortcuts, + UnreadHidden,SysTabHidden,?PID_ELEM,Children); + + + {gs, _Id, click, trace_process, _Args} -> + OwnerPid = element(?PID_ELEM, lists:nth(element(3,MarkedCell), Tables)), + NewChildren = start_pman(OwnerPid, Children), + loop(KindOfTable,CurrNode,MarkedCell,GridLines,WinSize,Tables,Shortcuts, + UnreadHidden,SysTabHidden,SortKey,NewChildren); + + + {gs, _Id, click, help_button, _Args} -> + HelpFile = filename:join([code:lib_dir(tv), "doc", "html", "index.html"]), + tool_utils:open_help(win, HelpFile), + loop(KindOfTable,CurrNode,MarkedCell,GridLines,WinSize,Tables,Shortcuts, + UnreadHidden,SysTabHidden,SortKey,Children); + + + {gs, _Id, click, otp_help_button, _Args} -> + IndexFile = filename:join([code:root_dir(), "doc", "index.html"]), + tool_utils:open_help(win, IndexFile), + loop(KindOfTable,CurrNode,MarkedCell,GridLines,WinSize,Tables,Shortcuts, + UnreadHidden,SysTabHidden,SortKey,Children); + + + {gs, win, configure, _Data, _Args} -> + loop(KindOfTable,CurrNode,MarkedCell,GridLines,WinSize,Tables,Shortcuts, + UnreadHidden,SysTabHidden,SortKey,Children); + + + {gs, _Id, click, exit_button, _Args} -> + lists:foreach( + fun({Pid,pman,_OP}) -> + exit(Pid,kill); + (_) -> + done + end, + Children), + exit(normal); + + + {gs, _Id, click, show_haiku, _Args} -> + gs:config(win, [{cursor,busy}]), + gs:config(show_haiku, [{data, hide_haiku}]), + lists:foreach( + fun({Pid,tv_info,_Data}) -> + Pid ! {error_msg_mode,haiku}; + ({Pid,tv_browser,_Data}) -> + Pid ! {error_msg_mode,haiku}; + ({Pid,tv_nodewin,_Data}) -> + Pid ! {error_msg_mode,haiku}; + ({Pid,tv_new_table,_Data}) -> + Pid ! {error_msg_mode,haiku}; + (_Other) -> + done + end, + Children), + put(error_msg_mode, haiku), + gs:config(win, [{cursor,arrow}]), + loop(KindOfTable, CurrNode, MarkedCell, GridLines, WinSize, Tables, Shortcuts, + UnreadHidden,SysTabHidden,SortKey,Children); + + + {gs, _Id, click, hide_haiku, _Args} -> + gs:config(win, [{cursor,busy}]), + gs:config(show_haiku, [{data, show_haiku}]), + lists:foreach( + fun({Pid,tv_info,_Data}) -> + Pid ! {error_msg_mode,normal}; + ({Pid,tv_browser,_Data}) -> + Pid ! {error_msg_mode,normal}; + ({Pid,tv_nodewin,_Data}) -> + Pid ! {error_msg_mode,normal}; + ({Pid,tv_new_table,_Data}) -> + Pid ! {error_msg_mode,normal}; + (_Other) -> + done + end, + Children), + put(error_msg_mode, normal), + gs:config(win, [{cursor,arrow}]), + loop(KindOfTable, CurrNode, MarkedCell, GridLines, WinSize, Tables, Shortcuts, + UnreadHidden,SysTabHidden,SortKey,Children); + + + {gs, win, destroy, _Data, _Args} -> + lists:foreach( + fun({Pid,pman,_OP}) -> + exit(Pid,kill); + (_) -> + done + end, + Children), + exit(normal); + + + {gs, win, keypress, _Data, [Key, _, _, 1 | _]} -> + case lists:keysearch(Key, 1, Shortcuts) of + {value, {Key, Value}} -> + handle_keypress(Value,KindOfTable,CurrNode,MarkedCell, + GridLines,WinSize,Tables, Shortcuts, + UnreadHidden,SysTabHidden,SortKey,Children); + false -> + loop(KindOfTable,CurrNode,MarkedCell,GridLines,WinSize,Tables,Shortcuts, + UnreadHidden,SysTabHidden,SortKey,Children) + end; + + + {gs, win, keypress, _Data, _Args} -> + loop(KindOfTable, CurrNode, MarkedCell, GridLines, WinSize, Tables, Shortcuts, + UnreadHidden,SysTabHidden,SortKey,Children); + + + {tv_new_node, _Sender, NewCurrNode} -> + gs:config(win, [{cursor,busy}]), + NewMarkedCell = unmark_cell(MarkedCell, Tables), + {NewTables, NewGridLines} = + update_grid(KindOfTable,NewCurrNode,GridLines,UnreadHidden,SysTabHidden,SortKey), + update_tv_info(Children), + update_tv_browser(Children), + NewChildren = + case replace_node_name(NewCurrNode, CurrNode) of + false -> + Children; + true -> + update_node_name(Children) + end, + gs:config(win, [{cursor,arrow}]), + loop(KindOfTable,NewCurrNode,NewMarkedCell,NewGridLines,WinSize,NewTables,Shortcuts, + UnreadHidden,SysTabHidden,SortKey,NewChildren); + + + {tv_start_infowin, Table, Node, LocalNode, TableType} -> + case start_tv_info(Table, Node, LocalNode, TableType, Children) of + Children -> + {NewMarkedCell, NewTables, NewGridLines} = + refresh_window(MarkedCell,Tables,KindOfTable,CurrNode,GridLines, + UnreadHidden,SysTabHidden,SortKey, Children), + loop(KindOfTable,CurrNode,NewMarkedCell,NewGridLines,WinSize,NewTables, + Shortcuts,UnreadHidden,SysTabHidden,SortKey,Children); + NewChildren -> + loop(KindOfTable,CurrNode,MarkedCell,GridLines,WinSize,Tables,Shortcuts, + UnreadHidden,SysTabHidden,SortKey,NewChildren) + end; + + + {tv_update_infowin, Table, Node, _Type} -> + case get_tv_info_pid(Table, Node, Children) of + undefined -> + done; + Pid -> + Pid ! #info_update_table_info{sender=self()} + end, + loop(KindOfTable,CurrNode,MarkedCell,GridLines,WinSize, + Tables,Shortcuts,UnreadHidden,SysTabHidden,SortKey,Children); + + + {tv_new_table, NewTabWinPid, Node, Name, Options, KindOfTableToCreate, _Readable, false} -> + case create_table(KindOfTableToCreate, Node, Node =:= node(), Name, Options, + NewTabWinPid) of + error -> + loop(KindOfTable,CurrNode,MarkedCell,GridLines,WinSize, + Tables,Shortcuts,UnreadHidden,SysTabHidden,SortKey,Children); + _TabId -> + case KindOfTable of + mnesia -> + done; + ets -> + self() ! {gs, tv_main, click, update, []} + end, + loop(KindOfTable,CurrNode,MarkedCell,GridLines,WinSize,Tables, + Shortcuts,UnreadHidden,SysTabHidden,SortKey,Children) + end; + + + + {tv_new_table, NewTabWinPid, Node, Name, Options, KindOfTableToCreate, Readable, true} -> + case create_table(KindOfTableToCreate, Node, Node =:= node(), Name, Options, + NewTabWinPid) of + error -> + loop(KindOfTable,CurrNode,MarkedCell,GridLines,WinSize, + Tables,Shortcuts,UnreadHidden,SysTabHidden,SortKey,Children); + TabId -> + case start_tv_browser(TabId,Node,Name,KindOfTableToCreate,Readable,Children) of + Children -> + {FinalMarkedCell, NewTables, NewGridLines} = + case KindOfTable of + mnesia -> + {MarkedCell, Tables, GridLines}; + ets -> + refresh_window(MarkedCell,Tables,KindOfTable, + CurrNode,GridLines,UnreadHidden, + SysTabHidden,SortKey, Children) + end, + loop(KindOfTable,CurrNode,FinalMarkedCell,NewGridLines,WinSize, + NewTables,Shortcuts,UnreadHidden,SysTabHidden,SortKey,Children); + NewChildren -> + case KindOfTable of + mnesia -> + done; + ets -> + self() ! {gs, tv_main, click, update, []} + end, + loop(KindOfTable,CurrNode,MarkedCell,GridLines,WinSize,Tables, + Shortcuts,UnreadHidden,SysTabHidden,SortKey,NewChildren) + end + end; + + + + {'EXIT', Pid, _Reason} -> + case lists:keysearch(Pid, 1, Children) of + false -> + loop(KindOfTable,CurrNode,MarkedCell,GridLines,WinSize, + Tables,Shortcuts,UnreadHidden,SysTabHidden,SortKey,Children); + {value, {Pid,Prog,_Data}} -> + NewChildren = + case Prog of + tv_nodewin -> + lists:keydelete(Pid, 1, Children) ++ start_tv_nodewin(CurrNode); + _Other -> + lists:keydelete(Pid, 1, Children) + end, + loop(KindOfTable,CurrNode,MarkedCell,GridLines,WinSize, + Tables,Shortcuts,UnreadHidden,SysTabHidden,SortKey,NewChildren) + end; + + + _Other -> + loop(KindOfTable, CurrNode, MarkedCell, GridLines, WinSize, Tables, Shortcuts, + UnreadHidden,SysTabHidden,SortKey,Children) + end. + + +flush_msgs(Msg0 = {gs, Win, Op, _, _}) -> + receive Msg = {gs, Win,Op,_,_} -> + flush_msgs(Msg) + after 100 -> + Msg0 + end. + +handle_keypress(open_table,KindOfTable,CurrNode,MarkedCell,GridLines, + WinSize,Tables,Shortcuts,UnreadHidden,SysTabHidden,SortKey,Children) -> + NewChildren = + case MarkedCell of + {undefined,_,_} -> + case get(error_msg_mode) of + normal -> + gs:config(win, [beep]), + tv_utils:notify(win, "TV Notification", "No table selected!"); + haiku -> + Msg = ["Rather than a beep", + "Or a rude error message", + "These words: make a choice."], + tv_utils:notify(win, "TV Notification", Msg) + end, + Children; + _OtherCell -> + {Table, Name, Readable} = get_table_id(KindOfTable, element(3, MarkedCell), + Tables), + start_tv_browser(Table, CurrNode, Name, KindOfTable, Readable, Children) + end, + case NewChildren of + Children -> + {NewMarkedCell, NewTables, NewGridLines} = + refresh_window(MarkedCell,Tables,KindOfTable,CurrNode,GridLines,UnreadHidden, + SysTabHidden, SortKey, Children), + loop(KindOfTable,CurrNode,NewMarkedCell,NewGridLines,WinSize,NewTables, + Shortcuts,UnreadHidden,SysTabHidden,SortKey,Children); + _Other -> + loop(KindOfTable,CurrNode,MarkedCell,GridLines,WinSize,Tables,Shortcuts, + UnreadHidden,SysTabHidden,SortKey,NewChildren) + end; + + +handle_keypress(update,KindOfTable,CurrNode,MarkedCell,GridLines, + WinSize,Tables,Shortcuts,UnreadHidden,SysTabHidden,SortKey,Children) -> + gs:config(win, [{cursor,busy}]), + NewMarkedCell = unmark_cell(MarkedCell, Tables), + {NewTabs, NewGrLines} = + update_grid(KindOfTable,CurrNode,GridLines,UnreadHidden,SysTabHidden,SortKey), + update_tv_info(Children), + gs:config(win, [{cursor,arrow}]), + loop(KindOfTable,CurrNode,NewMarkedCell,NewGrLines,WinSize,NewTabs,Shortcuts, + UnreadHidden,SysTabHidden,SortKey,Children); + + +handle_keypress(show_mnesia,ets,CurrNode,MarkedCell,GridLines, + WinSize,Tables,Shortcuts,UnreadHidden,SysTabHidden,SortKey,Children) -> + gs:config(win, [{cursor,busy}]), + NewMarkedCell = unmark_cell(MarkedCell, Tables), + gs:config(label2, [{fg, ?DISABLED_COLOR}]), + gs:config(label3, [{fg, ?DISABLED_COLOR}]), + gs:config(label4, [{fg, ?DISABLED_COLOR}]), + gs:config(show_unreadable, [{label, {text, " Unreadable Tables "}}, + {data, show_unreadable}]), + %% gs:config(show_unreadable, [{enable, false}, + %% {select, false}]), + gs:config(sort_table_id, [{enable, false}]), + NewSortKey = + case SortKey of + ?ID_ELEM -> + gs:config(sort_table_name, [{select,true}]), + ?NAME_ELEM; + _Other -> + SortKey + end, + {NewTables, NewGridLines} = + update_grid(mnesia,CurrNode,GridLines,UnreadHidden,SysTabHidden,NewSortKey), + gs:config(win, [{cursor,arrow}]), + loop(mnesia,CurrNode,NewMarkedCell,NewGridLines,WinSize,NewTables,Shortcuts, + UnreadHidden,SysTabHidden,NewSortKey,Children); + + + +handle_keypress(show_ets,mnesia,CurrNode,MarkedCell,GridLines, + WinSize,Tables,Shortcuts,UnreadHidden,SysTabHidden,SortKey,Children) -> + gs:config(win, [{cursor,busy}]), + NewMarkedCell = unmark_cell(MarkedCell, Tables), + gs:config(label2, [{fg, ?NORMAL_FG_COLOR}]), + gs:config(label3, [{fg, ?NORMAL_FG_COLOR}]), + gs:config(label4, [{fg, ?NORMAL_FG_COLOR}]), + {NewTables, NewGridLines} = + update_grid(ets,CurrNode,GridLines,UnreadHidden,SysTabHidden,SortKey), + %% gs:config(show_unreadable, [{enable, true}, + %% {select, not(UnreadHidden)}]), + gs:config(sort_table_id, [{enable, true}]), + gs:config(win, [{cursor,arrow}]), + loop(ets,CurrNode,NewMarkedCell,NewGridLines,WinSize,NewTables,Shortcuts, + UnreadHidden,SysTabHidden,SortKey,Children); + + +handle_keypress(trace_process,KindOfTable,CurrNode,MarkedCell,GridLines, + WinSize,Tables,Shortcuts,UnreadHidden,SysTabHidden,SortKey,Children) -> + NewChildren = + case MarkedCell of + {_Id, ?PID_COL, Row} -> + OwnerPid = element(?PID_ELEM, lists:nth(Row, Tables)), + start_pman(OwnerPid, Children); + {_Id, ?PROCNAME_COL, Row} -> + OwnerPid = element(?PID_ELEM, lists:nth(Row, Tables)), + start_pman(OwnerPid, Children); + _Other -> + Children + end, + loop(KindOfTable,CurrNode,MarkedCell,GridLines,WinSize,Tables,Shortcuts, + UnreadHidden,SysTabHidden,SortKey, NewChildren); + + +handle_keypress(select_node,KindOfTable,CurrNode,MarkedCell,GridLines, + WinSize,Tables,Shortcuts,UnreadHidden,SysTabHidden,SortKey,Children) -> + show_tv_nodewin(Children), + loop(KindOfTable,CurrNode,MarkedCell,GridLines,WinSize,Tables,Shortcuts, + UnreadHidden,SysTabHidden,SortKey,Children); + + +handle_keypress(show_info,KindOfTable,CurrNode,MarkedCell,GridLines, + WinSize,Tables,Shortcuts,UnreadHidden,SysTabHidden,SortKey,Children) -> + NewChildren = + case MarkedCell of + {_Id, ?NAME_COL, Row} -> + {Table, _Name, _Readable} = get_table_id(KindOfTable, Row, Tables), + start_tv_info(Table, CurrNode, CurrNode =:= node(), KindOfTable, Children); + {_Id, ?ID_COL, Row} -> + {Table, _Name, _Readable} = get_table_id(KindOfTable, Row, Tables), + start_tv_info(Table, CurrNode, CurrNode =:= node(), KindOfTable, Children); + {_Id, ?INFO_COL, Row} -> + {Table, _Name, _Readable} = get_table_id(KindOfTable, Row, Tables), + start_tv_info(Table, CurrNode, CurrNode =:= node(), KindOfTable, Children); + _OtherCell -> + Children + end, + case NewChildren of + Children -> + {NewMarkedCell, NewTables, NewGridLines} = + refresh_window(MarkedCell,Tables,KindOfTable,CurrNode,GridLines,UnreadHidden, + SysTabHidden, SortKey, Children), + loop(KindOfTable,CurrNode,NewMarkedCell,NewGridLines,WinSize,NewTables, + Shortcuts,UnreadHidden,SysTabHidden,SortKey,Children); + _Other -> + loop(KindOfTable,CurrNode,MarkedCell,GridLines,WinSize,Tables,Shortcuts, + UnreadHidden,SysTabHidden,SortKey,NewChildren) + end; + + +handle_keypress(help_button,KindOfTable,CurrNode,MarkedCell,GridLines, + WinSize,Tables,Shortcuts,UnreadHidden,SysTabHidden,SortKey,Children) -> + HelpFile = filename:join([code:lib_dir(tv), "doc", "html", "index.html"]), + tool_utils:open_help(win, HelpFile), + loop(KindOfTable,CurrNode,MarkedCell,GridLines,WinSize,Tables,Shortcuts, + UnreadHidden,SysTabHidden,SortKey,Children); + +handle_keypress(exit_button,_KindOfTable,_CurrNode,_MarkedCell,_GridLines, + _WinSize,_Tables,_Shortcuts,_UnreadHidden,_SysTabHidden,_SortKey,Children) -> + lists:foreach( + fun({Pid,pman,_OP}) -> + exit(Pid,kill); + (_) -> + done + end, + Children), + exit(normal); + + +handle_keypress(_Any,KindOfTable,CurrNode,MarkedCell,GridLines, + WinSize,Tables,Shortcuts,UnreadHidden,SysTabHidden,SortKey,Children) -> + loop(KindOfTable,CurrNode,MarkedCell,GridLines,WinSize,Tables,Shortcuts, + UnreadHidden,SysTabHidden,SortKey,Children). + + + + +refresh_window(MarkedCell,Tables,KindOfTable, + CurrNode,GridLines,UnreadHidden,SysTabHidden, SortKey, Children) -> + gs:config(win, [{cursor,busy}]), + NewMarkedCell = unmark_cell(MarkedCell, Tables), + {NewTables, NewGridLines} = + update_grid(KindOfTable,CurrNode,GridLines,UnreadHidden,SysTabHidden, + SortKey), + update_tv_info(Children), + gs:config(win, [{cursor,arrow}]), + {NewMarkedCell, NewTables, NewGridLines}. + + + + + +get_table_id(mnesia, Row, Tables) -> + TabTuple = lists:nth(Row, Tables), + Readable = element(?READABLE_ELEM, TabTuple), + Id = element(?NAME_ELEM, TabTuple), + {Id, Id, Readable}; +get_table_id(ets, Row, Tables) -> + TabTuple = lists:nth(Row, Tables), + Readable = element(?READABLE_ELEM, TabTuple), + Name = element(?NAME_ELEM, TabTuple), + case element(?NAMED_TABLE_ELEM, TabTuple) of + false -> + {element(?ID_ELEM, TabTuple), Name, Readable}; + _Other -> + {Name, Name, Readable} + end. + + + +replace_node_name('nonode@nohost', 'nonode@nohost') -> + %% Still undistributed... + false; +replace_node_name(_Node, _OldNode) when node() =:= 'nonode@nohost' -> + %% No longer distributed, but previously was! + true; +replace_node_name(_Node, 'nonode@nohost') -> + %% The system has been distributed! + true; +replace_node_name(_Node, _OldNode) -> + false. + + + +update_node_name(Children) when node() =:= 'nonode@nohost' -> + %% We have been distributed, but no longer are! + %% We change all node names stored to 'nonode@nohost'! + %% This works because we *will* receive exit signals + %% for those processes that have died on other nodes, + %% whereupon these processes will be removed from the + %% 'Children' list. + lists:map(fun({Pid, Prog, {Table,_Node}}) -> + {Pid, Prog, {Table,'nonode@nohost'}}; + (H) -> + H + end, + Children); +update_node_name(Children) -> + %% We have become distributed! + %% Change all occurrences of 'nonode@nohost' + %% to the new current node name! + HomeNode = node(), + lists:map(fun({Pid, Prog, {Table,'nonode@nohost'}}) -> + {Pid, Prog, {Table,HomeNode}}; + (H) -> + H + end, + Children). + + + + +show_tv_nodewin(Children) -> + {value, {Pid,tv_nodewin,_Node}} = lists:keysearch(tv_nodewin, 2, Children), + Pid ! show_window. + + + +update_tv_info(Children) -> + Sender = self(), + lists:foreach(fun({Pid,tv_info,{_Table,_Node}}) -> + Pid ! #info_update_table_info{sender=Sender}; + (_) -> + done + end, + Children). + + + +update_tv_browser(Children) -> + lists:foreach(fun({Pid,tv_browser,{_Table,_Node}}) -> + Pid ! check_node; + (_) -> + done + end, + Children). + + + +get_tv_info_pid(TabId,Node,Children) -> + TvInfoChildren = [X || X <- Children, element(2,X) =:= tv_info], + case lists:keysearch({TabId,Node}, 3, TvInfoChildren) of + {value, {Pid, tv_info, {_Table,Node}}} -> + Pid; + _Other -> + undefined + end. + + + +start_tv_browser(Tab,Node,_Name,KindOfTable,false,Children) -> + gs:config(win, [beep]), + case get(error_msg_mode) of + normal -> + tv_utils:notify(win, "TV Notification", + ["The selected table is unreadable!", + "Only table information may be viewed!"]); + haiku -> + Msg = ["Table protected.", + "The answers that you're seeking", + "will remain unknown."], + tv_utils:notify(win, "TV Notification", Msg) + end, + start_tv_info(Tab, Node, Node =:= node(), KindOfTable, Children); +start_tv_browser(Table,Node,Name,KindOfTable,_Readable,Children) -> + TvBrowserChildren = [X || X <- Children, element(2,X) =:= tv_browser], + case lists:keysearch({Table,Node}, 3, TvBrowserChildren) of + {value, {BPid,tv_browser,{Table,Node}}} -> + BPid ! raise, + Children; + _Other -> + %% Check that table still exists! + case table_still_there(KindOfTable, Node, Node =:= node(), Table, Name) of + true -> + LocalNode = (Node =:= node()), + NewBPid = tv:start_browser(Node, LocalNode, Table, KindOfTable, Name, + get(error_msg_mode)), + [{NewBPid, tv_browser, {Table,Node}} | Children]; + _TableDead -> + gs:config(win, [beep]), + case get(error_msg_mode) of + normal -> + tv_utils:notify(win, "TV Notification", + ["The table no longer exists!"]); + haiku -> + Msg = ["A table that big?", + "It might be very useful.", + "But now it is gone."], + tv_utils:notify(win, "TV Notification", Msg) + end, + Children + end + end. + + + + + +table_still_there(ets, Node, LocalNode, Table, Name) -> + case catch tv_ets_rpc:all(Node, LocalNode) of + Tables when is_list(Tables) -> + case lists:member(Table, Tables) of + true -> + true; + false -> %% May be a named table... + lists:keymember(Name, 1, Tables) + end; + Error -> + analyze_error(Error, Node, Table), + false + end; +table_still_there(mnesia, Node, LocalNode, Table, Name) -> + case catch tv_mnesia_rpc:system_info(Node, LocalNode, tables) of + Tables when is_list(Tables) -> + lists:member(Name, Tables); + Error -> + analyze_error(Error, Node, Table), + false + end. + + + + + + +start_tv_info(Table, Node, LocalNode, KindOfTable, Children) -> + TvInfoChildren = [X || X <- Children, element(2,X) =:= tv_info], + case lists:keysearch({Table,Node}, 3, TvInfoChildren) of + {value, {Pid,tv_info,{Table,Node}}} -> + Pid ! #info_raise_window{sender = self()}, + Children; + _Other -> + %% May have started a browser but no info window! + %% Info window may have been started from that browser, but + %% don't bother with checking *that*. + Pid = spawn_link(tv_info, info, [self(), Node, LocalNode, Table, KindOfTable, + get(error_msg_mode)]), + [{Pid, tv_info, {Table,Node}} | Children] + end. + + + + + +start_tv_new_table(CurrNode, Children) -> + TvNewTableChild = [X || X <- Children, element(2,X) =:= tv_new_table], + case TvNewTableChild of + [{Pid,tv_new_table,undefined}] -> + Pid ! raise, + Children; + [] -> + Pid = tv_new_table:start(CurrNode, get(error_msg_mode)), + [{Pid, tv_new_table, undefined} | Children] + end. + + + + +create_table(mnesia, _Node, _LocalNode, _TabName, _Options, _NewTabWinPid) -> + error; +create_table(ets, Node, LocalNode, TabName, Options, NewTabWinPid) -> + case tv_table_owner:create(ets, Node, LocalNode, TabName, Options) of + {ok, TabId} -> + NewTabWinPid ! ok, + TabId; + error -> + NewTabWinPid ! error, + error + end. + + + + +start_pman(OwnerPid, Children) -> + Pid = pman_shell:start(OwnerPid), + [{Pid,pman,OwnerPid} | Children]. + + + + +update_grid(TableType, CurrNode, GridLines, UnreadHidden, SysTabHidden,SortKey) -> + NewTables = get_tables(CurrNode, TableType, UnreadHidden, SysTabHidden,SortKey), + TabStr = case TableType of + mnesia -> + "Mnesia "; + ets -> + "ETS " + end, + NodeStr = atom_to_list(CurrNode), + gs:config(win, [{title, "[TV] " ++ TabStr ++ "tables on " ++ NodeStr}]), + gs:config(grid, [{rows, {1, get_nof_rows(length(NewTables), gs:read(grid,height))}}]), + NewGridLines = update_gridlines(NewTables, GridLines, 1), + {NewTables, NewGridLines}. + + + +unmark_cell({undefined, AnyCol, AnyRow}, _Tables) -> + {undefined, AnyCol, AnyRow}; +unmark_cell({Id, Col, Row}, Tables) -> + disable_menus(), + TabTuple = lists:nth(Row, Tables), + ReadableTable = element(?READABLE_ELEM, TabTuple), + NamedTable = element(?NAMED_TABLE_ELEM, TabTuple), + BgColor = + case ReadableTable of + false -> + ?UNREADABLE_BG_COLOR; + _Other1 -> + ?READABLE_BG_COLOR + end, + + FgColor = + case NamedTable of + false when Col =:= ?NAME_COL -> + ?UNNAMED_FG_COLOR; + _Other2 -> + ?NORMAL_FG_COLOR + end, + + gs:config(Id, [{bg, {Col, BgColor}}, + {fg, {Col, FgColor}}]), + {undefined, undefined, undefined}. + + + + +mark_cell({Id,Col,Row}, {Id,Col,Row}, _Readable) -> + {undefined, undefined, undefined}; +mark_cell({Id,Col,Row}, _Any, Readable) -> + case lists:member(Col, ?POSSIBLE_MARK_COLS) of + true -> + enable_menus(Col, Readable), + gs:config(Id, [{bg, {Col, ?GRID_MARK_COLOR}}, + {fg, {Col, ?NORMAL_FG_COLOR}}]), + {Id, Col,Row}; + false -> + {undefined, undefined, undefined} + end. + + +disable_menus() -> + disable_open_menu(), + disable_trace_menu(), + disable_info_menu(). + + +enable_menus(?ID_COL, true) -> + enable_open_menu(), + enable_info_menu(); +enable_menus(?ID_COL, {notext}) -> + enable_open_menu(), + enable_info_menu(); +enable_menus(?ID_COL, false) -> + enable_info_menu(); +enable_menus(?NAME_COL, true) -> + enable_open_menu(), + enable_info_menu(); +enable_menus(?NAME_COL, {notext}) -> + enable_open_menu(), + enable_info_menu(); +enable_menus(?NAME_COL, false) -> + enable_info_menu(); +enable_menus(?PID_COL, _Any) -> + enable_trace_menu(); +enable_menus(?PROCNAME_COL, _Any) -> + enable_trace_menu(); +enable_menus(?INFO_COL, _Any) -> + enable_info_menu(); +enable_menus(_Col, _Any) -> + done. + + + +resize_window(Width, Height, NofElems) -> + WinWidth = lists:max([Width, ?MIN_WIN_WIDTH]), + WinHeight = lists:max([Height, ?MIN_WIN_HEIGHT]), + gs:config(win, [{width, WinWidth}, + {height, WinHeight} + ]), + {BgWidth, BgHeight, FgWidth, FgHeight} = get_frame_coords(WinWidth, WinHeight), + {GridWidth, GridHeight} = get_grid_coords(FgWidth, FgHeight), + ColWidths = get_col_widths(?COL_WIDTHS, GridWidth), + resize_header_labels(ColWidths, + [label1,label2,label3,label4,label5], + ?GRID_XPOS), + gs:config(bgframe, [{width, BgWidth}, + {height, BgHeight} + ]), + gs:config(fgframe, [{width, FgWidth}, + {height, FgHeight} + ]), + gs:config(grid, [{width, GridWidth}, + {height, GridHeight}, + {columnwidths, ColWidths}, + {rows, {1, get_nof_rows(NofElems, GridHeight)}} + ]), + {WinWidth, WinHeight}. + + + + +create_window(Tables) -> + gs:window(win, gs:start(), [{width, ?WIN_WIDTH}, + {height, ?WIN_HEIGHT}, + {bg, ?DEFAULT_BG_COLOR}, + {title, "[TV] ETS tables on " ++ + atom_to_list(node())}, + {destroy, true}, + {configure, true}, + {keypress, true} + ]), + + ShortcutList = create_menus(), + + disable_menus(), + + {BgFrameWidth, BgFrameHeight, FgFrameWidth, FgFrameHeight} = + get_frame_coords(?WIN_WIDTH, ?WIN_HEIGHT), + + {GridWidth, GridHeight} = get_grid_coords(FgFrameWidth, FgFrameHeight), + + ColWidths = get_col_widths(?COL_WIDTHS, GridWidth), + + gs:frame(bgframe, win, [{width, BgFrameWidth}, + {height, BgFrameHeight}, + {x, ?GRID_XPOS}, + {y, ?GRID_YPOS}, + {bg, {0,0,0}} + ]), + gs:frame(fgframe, bgframe, [{width, FgFrameWidth}, + {height, FgFrameHeight}, + {x, 0}, + {y, 1}, + {bg, ?DEFAULT_BG_COLOR} + ]), + + + create_header_labels(ColWidths, ?HEADER_LABELS), + gs:grid(grid, fgframe, [{width, GridWidth}, + {height, GridHeight}, + {x, 0}, + {y, -1}, + {hscroll,bottom}, + {vscroll,right}, + {rows, {1, get_nof_rows(length(Tables), GridHeight)}}, + {columnwidths, ColWidths}, + {fg, ?NORMAL_FG_COLOR}, + {bg, {255,255,255}}, + {font, ?FONT} + ]), + GridLines = update_gridlines(Tables, [], 1), + {{undefined,undefined,undefined}, GridLines, {?WIN_WIDTH,?WIN_HEIGHT}, ShortcutList}. + + + + +get_frame_coords(WinWidth, WinHeight) -> + BgWidth = WinWidth - 2 * ?GRID_XPOS, + BgHeight = WinHeight - ?GRID_YPOS - ?GRID_XPOS, + FgWidth = BgWidth, + FgHeight = BgHeight - 1, + {BgWidth, BgHeight, FgWidth, FgHeight}. + + + + +get_grid_coords(ParentWidth, ParentHeight) -> + {ParentWidth, ParentHeight + 1}. + + + +get_col_widths(Cols, GridWidth) -> + SbWidth = 25, %% OK, OK, don't bother about it, this constant makes it work... :-/ + FixColWidthSum = lists:sum(lists:map(fun(H) -> + lists:nth(H, Cols) + end, + ?FIX_WIDTH_COLS)), + AvailableWidth = GridWidth - FixColWidthSum - SbWidth, + OriginalWidth = ?WIN_WIDTH - 2 * ?GRID_XPOS - FixColWidthSum - SbWidth, + get_col_widths(1, Cols, AvailableWidth, OriginalWidth). + + + +get_col_widths(N, [H | T], AvailWidth, OrigWidth) -> + NewColWidth = + case lists:member(N, ?FIX_WIDTH_COLS) of + true -> + H; + _Other -> + round(H * (AvailWidth / OrigWidth) + 0.1) + end, + [NewColWidth | get_col_widths(N + 1, T, AvailWidth, OrigWidth)]; +get_col_widths(_N, [], _AvailWidth, _OrigWidth) -> + []. + + + +create_header_labels(ColWidths, Text) -> + create_header_labels(ColWidths, Text, 1, ?GRID_XPOS). + + + +create_header_labels([W | T], [{Name, Text} | TextT], N, Xpos) -> + Ypos = ?GRID_YPOS - 20, + gs:label(Name, win, [{width, W + 1 - 3}, + {height, 20}, + {x, Xpos + 1 + 3}, + {y, Ypos}, + {bg, ?DEFAULT_BG_COLOR}, + {fg, ?NORMAL_FG_COLOR}, + {font, ?HEADER_FONT}, + {align, w}, + {label, {text, Text}} + ]), + create_header_labels(T, TextT, N + 1, Xpos + 1 + W); +create_header_labels([], [], _N, _Xpos) -> + done. + + + +resize_header_labels([W | T], [Name | NT], Xpos) -> + gs:config(Name, [{width, W + 1 - 3}, + {x, Xpos + 1 + 3} + ]), + resize_header_labels(T, NT, Xpos + 1 + W); +resize_header_labels([], [], _Xpos) -> + done. + + + +disable_open_menu() -> + gs:config(open_table, [{enable,false}]). + + +disable_info_menu() -> + gs:config(show_info, [{enable,false}]). + +disable_trace_menu() -> + gs:config(trace_process, [{enable,false}]). + + +enable_open_menu() -> + gs:config(open_table, [{enable,true}]). + + +enable_info_menu() -> + gs:config(show_info, [{enable,true}]). + + +enable_trace_menu() -> + gs:config(trace_process, [{enable,true}]). + + +create_menus() -> + gs:menubar(menubar, win, [{bg, ?DEFAULT_BG_COLOR}]), + + HelpButt = gs:menubutton(menubar, [{bg, ?DEFAULT_BG_COLOR}, + {fg, ?FIREBRICK}, % firebrick + {label, {text, " Help "}}, + {underline, 1}, + {side, right} + ]), + FileButt = gs:menubutton(menubar, [{bg, ?DEFAULT_BG_COLOR}, + {fg, ?FIREBRICK}, % firebrick + {label, {text, " File "}}, + {underline, 1}, + {side, left} + ]), + ViewButt = gs:menubutton(menubar, [{bg, ?DEFAULT_BG_COLOR}, + {fg, ?FIREBRICK}, % firebrick + {label, {text, " View "}}, + {underline, 1}, + {side, left} + ]), + OptionsButt = gs:menubutton(menubar, [{bg, ?DEFAULT_BG_COLOR}, + {fg, ?FIREBRICK}, % firebrick + {label, {text, " Options "}}, + {underline, 1}, + {side, left} + ]), + + HelpMenu = gs:menu(HelpButt, [{bg, ?DEFAULT_BG_COLOR}, + {fg, ?FIREBRICK}, + {disabledfg,?DISABLED_COLOR} + ]), + FileMenu = gs:menu(FileButt, [{bg, ?DEFAULT_BG_COLOR}, + {fg, ?FIREBRICK}, + {disabledfg,?DISABLED_COLOR} + ]), + + OptionsMenu = gs:menu(OptionsButt, [{bg, ?DEFAULT_BG_COLOR}, + {fg, ?FIREBRICK}, + {disabledfg,?DISABLED_COLOR} + ]), + + ViewMenu = gs:menu(ViewButt, [{bg, ?DEFAULT_BG_COLOR}, + {fg, ?FIREBRICK}, + {disabledfg,?DISABLED_COLOR} + ]), + + ShortCutList = + create_menulist([{" Help ",normal,help_button,1,h}, + separator, + {" OTP Documentation ",normal,otp_help_button,1,no_char}], HelpMenu) ++ + create_menulist([{" Open Table ",normal,open_table,1,o}, + {" New Table... ",normal,new_table,1,no_char}, + {" Table Info ",normal,show_info,7,i}, + separator, + {" Nodes... ",normal,select_node,1,n}, + separator, + {" Trace Process ",normal,trace_process,1,t}, + separator, + {" Exit ",normal, exit_button,2,x}], FileMenu) ++ + [{c,exit_button}, {'C',exit_button}] ++ + create_menulist([{" Refresh ",normal,update,1,r}, + separator, + {" Unreadable Tables ",check,show_unreadable,1,no_char}, + separator, + {" System Tables ",check,show_system,1,no_char}, + separator, + {" Sort by Name ",radio,sort_table_name,9,no_char}, + {" Sort by Id ",radio,sort_table_id,9,no_char}, + {" Sort by Owner PID ",radio,sort_owner_pid,15,no_char}, + {" Sort by Owner Name ",radio,sort_owner_name,9,no_char}, + separator, + {" Error Messages in Haiku ",check,show_haiku,1,no_char} + ], + OptionsMenu) ++ + create_menulist([{" ETS Tables ",radio,show_ets,1,e}, + {" Mnesia Tables ",radio,show_mnesia,1,m}], ViewMenu), + gs:config(show_unreadable, [{select,false}]), + gs:config(show_system, [{select,false}]), + gs:config(show_haiku, [{select,false}]), + %% Due to a bug (or some other reason), only one of the radiobuttons belonging + %% to a specified group can be selected, even if different processes have created + %% the radiobuttons! This means that, if we have started more than one tv_main + %% process, selecting one radiobutton will affect the radiobuttons in the other + %% tv_main process(es)!!! Since this is a highly undesirable bahaviour, we have to + %% create unique group names (i.e., atoms). + %% (We need to group the radiobuttons, since otherwise all created by one process + %% belongs to the same group, which also is undesirable...) + SelfStr = pid_to_list(self()), + SortGroup = list_to_atom("sorting" ++ SelfStr), + TypeGroup = list_to_atom("table_type" ++ SelfStr), + gs:config(sort_table_name, [{group,SortGroup},{select,true}]), + gs:config(sort_table_id, [{group,SortGroup}]), + gs:config(sort_owner_pid, [{group,SortGroup}]), + gs:config(sort_owner_name, [{group,SortGroup}]), + gs:config(show_ets, [{group,TypeGroup}, {select,true}]), + gs:config(show_mnesia, [{group,TypeGroup}]), + ShortCutList. + + + + + +create_menulist(List, Menu) -> + MaxLength = get_length_of_longest_menu_text(List, 0), + create_menulist(List, Menu, MaxLength). + + + + +create_menulist([], _Menu, _MaxLength) -> + []; +create_menulist([{Text, Type, Data, AccCharPos, ShortcutChar} | Rest], Menu, MaxLength) -> + ShortcutCapitalChar = + if + ShortcutChar =:= no_char -> + no_char; + true -> + CharAsciiValue = lists:nth(1, atom_to_list(ShortcutChar)), + CapitalCharValue = CharAsciiValue - ($a - $A), + list_to_atom([CapitalCharValue]) + end, + + FinalText = if + ShortcutChar =:= no_char -> + Text; + true -> + Text ++ lists:duplicate(MaxLength - length(Text), " ") ++ + " Ctrl+" ++ atom_to_list(ShortcutCapitalChar) ++ " " + end, + gs:menuitem(Data, Menu, [{bg, ?DEFAULT_BG_COLOR}, + {fg, ?FIREBRICK}, + {itemtype, Type}, + {label, {text, FinalText}}, + {underline, AccCharPos}, + {data, Data} + ]), + [{ShortcutChar, Data}, {ShortcutCapitalChar, Data} | create_menulist(Rest, Menu, MaxLength)]; +create_menulist([separator | Rest], Menu, MaxLength) -> + gs:menuitem(Menu, [{itemtype, separator}]), + create_menulist(Rest, Menu, MaxLength). + + + + + + + +get_length_of_longest_menu_text([], MaxLength) -> + MaxLength; +get_length_of_longest_menu_text([{Text, _Type, _Data, _APos, _SChar} | Rest], CurrMax) -> + L = length(Text), + if + L > CurrMax -> + get_length_of_longest_menu_text(Rest, L); + true -> + get_length_of_longest_menu_text(Rest, CurrMax) + end; +get_length_of_longest_menu_text([separator | Rest], CurrMax) -> + get_length_of_longest_menu_text(Rest, CurrMax). + + + + + + +get_nof_rows(NofElems, GridHeight) -> + lists:max([NofElems, round((GridHeight - 20) / 21) + 1]). + + + +config_gridline(LineId, TabTuple) -> + Readable = element(?READABLE_ELEM, TabTuple), + NamedTable = element(?NAMED_TABLE_ELEM, TabTuple), + {FgColor, BgColor} = + case Readable of + true -> + {?NORMAL_FG_COLOR, ?READABLE_BG_COLOR}; + false -> + {?UNREADABLE_FG_COLOR, ?UNREADABLE_BG_COLOR}; + {notext} -> + {?NORMAL_FG_COLOR, ?READABLE_BG_COLOR} + end, + + NameFgColor = + case NamedTable of + false -> + ?UNNAMED_FG_COLOR; + _Other -> + ?NORMAL_FG_COLOR + end, + + gs:config(LineId, [{bg, BgColor}, + {fg, FgColor}, + {fg, {?NAME_COL, NameFgColor}}, + {click, true}, + {doubleclick, true}, + {data, {grid,Readable}} | + + lists:map( + fun({Elem,Col}) -> + case element(Elem, TabTuple) of + {notext} -> + {text, {Col, ""}}; + Other when Elem =:= ?NAME_ELEM -> + case NamedTable of + false -> + {text, {Col, " " ++ + lists:flatten( + io_lib:write( + Other)) ++ " "}}; + _AnyOther -> + {text, {Col, " " ++ lists:flatten( + io_lib:write( + Other))}} + end; + Other -> + {text, {Col, " " ++ lists:flatten( + io_lib:write( + Other))}} + end + end, + [{?NAME_ELEM, ?NAME_COL}, + {?ID_ELEM, ?ID_COL}, + {?PID_ELEM, ?PID_COL}, + {?PROCNAME_ELEM, ?PROCNAME_COL}, + {?INFO_ELEM, ?INFO_COL}] + ) + ]). + + + + + +update_gridlines([TabTuple | TT], [LineId | GT], CurrRow) -> + config_gridline(LineId, TabTuple), + [LineId | update_gridlines(TT, GT, CurrRow + 1)]; +update_gridlines([TabTuple | TT], [], CurrRow) -> + LineId = gs:gridline(grid, [{row, CurrRow}]), + config_gridline(LineId, TabTuple), + [LineId | update_gridlines(TT, [], CurrRow + 1)]; +update_gridlines([], [LineId | GT], _CurrRow) -> + gs:destroy(LineId), + update_gridlines([], GT, _CurrRow); +update_gridlines([], [], _CurrRow) -> + []. + + + + + + + + + diff --git a/lib/tv/src/tv_main.hrl b/lib/tv/src/tv_main.hrl new file mode 100644 index 0000000000..28329ca83c --- /dev/null +++ b/lib/tv/src/tv_main.hrl @@ -0,0 +1,286 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1998-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% + +-define(ERROR_MSG_MODE, normal). + +-define(WIN_WIDTH, 745). % 779 +-define(WIN_HEIGHT, 380). +-define(MIN_WIN_WIDTH, 524). +-define(MIN_WIN_HEIGHT, 150). + +-define(FONT, {screen, 12}). +-define(HEADER_FONT, {screen, [bold,italic], 12}). + +-define(GRID_XPOS, 3). +-define(GRID_YPOS, 68). + + +%% Unreadable tables are indicated by the background color. +%% Unnamed tables are indicated by the foreground color. + +-define(NORMAL_FG_COLOR, {0,0,0}). +-define(READABLE_BG_COLOR, {255,255,255}). +-define(UNREADABLE_FG_COLOR, ?NORMAL_FG_COLOR). +-define(UNREADABLE_BG_COLOR, {240,240,240}). +%-define(UNREADABLE_BG_COLOR, {255,250,230}). +%-define(UNREADABLE_BG_COLOR, {242,242,242}). +-define(UNNAMED_FG_COLOR, {175,175,175}). +%-define(UNNAMED_FG_COLOR, {140,35,35}). + + +-define(DISABLED_COLOR, {160,160,160}). + +-define(NAME_ELEM, 1). +-define(NAMED_TABLE_ELEM, 2). +-define(ID_ELEM, 3). +-define(READABLE_ELEM, 4). +-define(PID_ELEM, 5). +-define(PROCNAME_ELEM, 6). +-define(INFO_ELEM, 7). + +-define(NAME_COL, 1). +-define(ID_COL, 2). +-define(PID_COL, 3). +-define(PROCNAME_COL, 4). +-define(INFO_COL, 5). + +-define(POSSIBLE_MARK_COLS, [?NAME_COL, ?ID_COL, ?PID_COL, ?PROCNAME_COL, ?INFO_COL]). +-define(COL_WIDTHS, [205,131,91,197,90]). % [140,95,125,75,85,140,90]). +-define(FIX_WIDTH_COLS, [2,3,5]). + + +-define(HEADER_LABELS, [{label1, " Table Name"}, + % {label2, " Named Table"}, + {label2, " Table Id"}, + % {label4, " Readable"}, + {label3, " Owner Pid"}, + {label4, " Owner Name"}, + {label5, " Table Size"} + ]). + + + +%% TABLES_TO_HIDE shall contain both Mnesia and ETS tables that we want to hide. :-) + +-define(SYSTEM_TABLES, [ac_tab, + asn1, + cdv_dump_index_table, + cdv_menu_table, + cdv_decode_heap_table, + cell_id, + cell_pos, + clist, + cover_internal_data_table, + cover_collected_remote_data_table, + cover_binary_code_table, + code, + code_names, + cookies, + corba_policy, + corba_policy_associations, + dets, + dets_owners, + dets_registry, + disk_log_names, + disk_log_pids, + eprof, + erl_atom_cache, + erl_epmd_nodes, + etop_accum_tab, + etop_tr, + ets_coverage_data, + file_io_servers, + global, + global_locks, + global_names, + global_names_ext, + gs_mapping, + gs_names, + gstk_db, + gstk_grid_cellid, + gstk_grid_cellpos, + gstk_grid_id, + gvar, + httpd, + id, + ig, + ign_req_index, + ign_requests, + index, + inet_cache, + inet_db, + inet_hosts, + 'InitialReferences', + int_db, + interpreter_includedirs_macros, + ir_WstringDef, + lmcounter, + locks, + mnemosyne_tmp, + pg2_table, + queue, + snmp_agent_table, + snmp_local_db2, + snmp_mib_data, + snmp_note_store, + snmp_symbolic_ets, + sticky, + sys_dist, + tid_locks, + tkFun, + tkLink, + tkPriv, + ttb, + ttb_history_table, + udp_fds, + udp_pids + ]). + + +-define(MNESIA_TABLES, [alarm, + alarmTable, + evaLogDiscriminatorTable, + eva_snmp_map, + eventTable, + group, + imprec, + ir_AliasDef, + ir_ArrayDef, + ir_AttributeDef, + ir_ConstantDef, + ir_Contained, + ir_Container, + ir_EnumDef, + ir_ExceptionDef, + ir_IDLType, + ir_IRObject, + ir_InterfaceDef, + ir_ModuleDef, + ir_ORB, + ir_OperationDef, + ir_PrimitiveDef, + ir_Repository, + ir_SequenceDef, + ir_StringDef, + ir_StructDef, + ir_TypedefDef, + ir_UnionDef, + logTable, + logTransferTable, + mesh_meas, + mesh_type, + mnesia_clist, + mnesia_decision, + mnesia_transient_decision, + orber_CosNaming, + orber_objkeys, + schema, + user + ]). + + +-define(UNREADABLE_MNESIA_TABLES, [schema]). + + +-define(SYSTEM_OWNERS, [alarm_handler, + application_controller, + auth, + coast_server, + code_server, + cover_server_001, + dbg, + dets, + dets_sup, + disk_log_server, + disk_log_sup, + erl_epmd, + erl_prim_loader, + error_logger, + eva_log_sup, + eva_server, + eva_sup, + file_server, + file_server_2, + global_group, + global_group_check, + global_name_server, + gs_frontend, + heart, + help_main, + inet_db, + inet_gethost_native, + init, + int_db, + interpret, + jive_server, + kernel_safe_sup, + kernel_sup, + log_server, + mandel_server, + mesh_sup, + mesh_server, + mnesia_checkpoint_sup, + mnesia_dumper, + mnesia_event, + mnesia_fallback, + mnesia_init, + mnesia_kernel_sup, + mnesia_late_loader, + mnesia_locker, + mnesia_monitor, + mnesia_recover, + mnesia_snmp_sup, + mnesia_subscr, + mnesia_sup, + mnesia_tm, + net_kernel, + net_sup, + overload, + perfmon_sampler, + pxw_server, + release_handler, + %% rex, %% Otherwise we won't see tables we've created on other nodes! + rsh_starter, + sasl_safe_sup, + sasl_sup, + snmp_agent_sup, + snmp_local_db, + snmp_master_agent, + snmp_misc_sup, + snmp_note_store, + snmp_supervisor, + snmp_symbolic_store, + socket, + sounder, + ssl_socket, + take_over_monitor, + timer_server, + tk, + udp_server, + user, + winshell_controller, + xerl_copy, + xerl_monitor + ]). + + + + + + + diff --git a/lib/tv/src/tv_mnesia_rpc.erl b/lib/tv/src/tv_mnesia_rpc.erl new file mode 100644 index 0000000000..a2385714ec --- /dev/null +++ b/lib/tv/src/tv_mnesia_rpc.erl @@ -0,0 +1,104 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1998-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% +-module(tv_mnesia_rpc). + + + +-export([system_info/3, + table_info/4, + transaction/3 + ]). + + + + + + +system_info(_Node, true, Key) -> + chk(catch mnesia:system_info(Key)); +system_info(Node, false, Key) -> + chk(catch rpc:block_call(Node, mnesia, system_info, [Key])). + + + + +table_info(_Node, true, Tab, Item) -> + chk(catch mnesia:table_info(Tab, Item)); +table_info(Node, false, Tab, Item) -> + chk(catch rpc:block_call(Node, mnesia, table_info, [Tab, Item])). + + + + +transaction(_Node, true, Fun) -> + chk(catch mnesia:transaction(Fun)); +transaction(Node, false, Fun) -> + chk(catch rpc:block_call(Node, mnesia, transaction, [Fun])). + + + + +chk(Result) -> + case Result of + _Anything when is_list(Result) -> + Result; + _Anything when is_atom(Result) -> + Result; + _Anything when is_integer(Result) -> + Result; + _Anything when is_pid(Result) -> + Result; + + {aborted, {bad_type, _Rec}} -> + throw(bad_format); + + {badrpc,nodedown} -> + throw(nodedown); + {'EXIT', nodedown} -> + throw(nodedown); + + {'EXIT', {aborted, {no_exists, _Table, _Arg}}} -> + throw(no_table); + + {'EXIT', {aborted, {node_not_running, _Node}}} -> + throw(mnesia_not_started); + {'EXIT', {{badarg, {gen, set_monitor_mode, _Data}}, _Info}} -> + throw(mnesia_not_started); + {'EXIT', {'EXIT', {aborted, {node_not_running,_Node}}}} -> + throw(mnesia_not_started); + {badrpc, {'EXIT', {aborted, {node_not_running,_Node}}}} -> + throw(mnesia_not_started); + {badrpc, {'EXIT', {aborted, {no_exists,_Table,_Args}}}} -> + throw(mnesia_not_started); + {badrpc, _Reason} -> + throw(mnesia_not_started); + {'EXIT', {undef, {mnesia,_Fcn,_Args}}} -> + throw(mnesia_not_started); + + {'EXIT', Reason} -> + throw({unexpected_error, Reason}); + + Other when is_tuple(Other) -> + %% For example wild_pattern requests return a tuple! + Other; + + Other -> + io:format("Unexpected return value: ~p~n", [Other]) + end. + + diff --git a/lib/tv/src/tv_new_table.erl b/lib/tv/src/tv_new_table.erl new file mode 100644 index 0000000000..3d62b0548b --- /dev/null +++ b/lib/tv/src/tv_new_table.erl @@ -0,0 +1,656 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1998-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%k +-module(tv_new_table). + + + +-export([start/2, + init/3 + ]). + + + +-define(DEFAULT_BG_COLOR, {217, 217, 217}). +-define(FONT, {screen, 12}). + +-define(WIN_WIDTH, 400). +-define(WIN_HEIGHT, 555). %% 510 + +-define(FRAME_WIDTH, 400). +-define(FRAME1_HEIGHT, 170). +-define(FRAME2_HEIGHT, 260). +-define(FRAME3_HEIGHT, 125). %% 80 +-define(BW, 2). + +-define(FRAME_X, 0). +-define(FRAME1_Y, 0). +-define(FRAME2_Y, 170). +-define(FRAME3_Y, 430). + + +-define(LBL_HEIGHT, 30). +-define(NODE_LBL_WIDTH, 45). +-define(NAME_LBL_WIDTH, 85). +-define(TYPE_LBL_WIDTH, 45). +-define(PROT_LBL_WIDTH, 85). +-define(KEYPOS_LBL_WIDTH, 95). + +-define(LBL_X, 10). +-define(NODE_LBL_Y, 20). +-define(NAME_LBL_Y, 80). +-define(TYPE_LBL_Y, 10). +-define(PROT_LBL_Y, 100). +-define(KEYPOS_LBL_Y, 200). + + +-define(ENTRY_HEIGHT, 30). +-define(NODE_ENTRY_WIDTH, 275). +-define(NAME_ENTRY_WIDTH, 275). +-define(KEYPOS_ENTRY_WIDTH, 50). + +-define(ENTRY_X1, 110). +-define(ENTRY_X2, 110). +-define(NODE_ENTRY_Y, 20). +-define(NAME_ENTRY_Y, 80). +-define(KEYPOS_ENTRY_Y, 200). + +-define(RBTN_HEIGHT, 30). +-define(RBTN_WIDTH1, 105). +-define(RBTN_WIDTH2, 115). + +-define(RBTN_X1, 60). +-define(RBTN_X2, 165). +-define(RBTN_X3, 270). +-define(RBTN_Y1, 40). +-define(RBTN_Y1PLUS, 70). +-define(RBTN_Y2, 130). + + +-define(CBTN_HEIGHT, 30). +-define(NAMED_TABLE_CBTN_WIDTH, 100). +-define(OPEN_BROWSER_CBTN_WIDTH, 105). + +-define(NAMED_TABLE_CBTN_X, 110). +-define(NAMED_TABLE_CBTN_Y, 120). + +-define(OPEN_BROWSER_CBTN_X, 85). %% 215 +-define(OPEN_BROWSER_CBTN_Y, 10). %% 200 + + +-define(BTN_WIDTH, 100). +-define(BTN_HEIGHT, 30). + +-define(BTN_X1, 85). +-define(BTN_X2, 225). +-define(BTN_Y, 65). %% 30 + + +-define(VLINE_LBL_WIDTH, (380 - 2 * ?BW)). +-define(VLINE_LBL_HEIGHT, 1). +-define(HLINE_LBL_WIDTH, 1). +-define(HLINE_LBL_HEIGHT, 70). + +-define(VLINE_LBL_X, (10 - ?BW)). +-define(VLINE_LBL_Y1, 85). +-define(VLINE_LBL_Y2, 180). +-define(HLINE_LBL_X, 188). +-define(HLINE_LBL_Y, 180). + + +-define(DEFAULT_NAME, my_table). +-define(DEFAULT_TYPE, set). +-define(DEFAULT_PROT, public). +-define(DEFAULT_KEYPOS, 1). + + + + +start(Node, ErrMsgMode) -> + spawn_link(?MODULE, init, [Node, ErrMsgMode, self()]). + + + + + +init(Node, ErrMsgMode, MPid) -> + process_flag(trap_exit, true), + put(error_msg_mode, ErrMsgMode), + create_window(Node), + loop(false, ?DEFAULT_TYPE, ?DEFAULT_PROT, true, MPid). + + + + + +loop(NamedTab, Type, Prot, OpenBrowser, MPid) -> + receive + + {gs, ok, click, _Data, _Args} -> + gs:config(win, [{cursor, busy}]), + case create_table(NamedTab, Type, Prot, OpenBrowser, MPid) of + ok -> + exit(normal); + error -> + gs:config(win, [{cursor, arrow}]), + loop(NamedTab, Type, Prot, OpenBrowser, MPid) + end; + + + {gs, cancel, click, _Data, _Args} -> + exit(normal); + + + {gs, set, click, _Data, _Args} -> + loop(NamedTab, set, Prot, OpenBrowser, MPid); + + + {gs, ordered_set, click, _Data, _Args} -> + loop(NamedTab, ordered_set, Prot, OpenBrowser, MPid); + + + {gs, bag, click, _Data, _Args} -> + loop(NamedTab, bag, Prot, OpenBrowser, MPid); + + + {gs, duplicate_bag, click, _Data, _Args} -> + loop(NamedTab, duplicate_bag, Prot, OpenBrowser, MPid); + + + {gs, public, click, _Data, _Args} -> + gs:config(open_browser, [{enable, true}, {select, OpenBrowser}]), + loop(NamedTab, Type, public, OpenBrowser, MPid); + + + {gs, protected, click, _Data, _Args} -> + gs:config(open_browser, [{enable, true}, {select, OpenBrowser}]), + loop(NamedTab, Type, protected, OpenBrowser, MPid); + + + {gs, private, click, _Data, _Args} -> + gs:config(open_browser, [{select, false}, {enable, false}]), + loop(NamedTab, Type, private, OpenBrowser, MPid); + + + {gs, named_table, click, Data, _Args} -> + gs:config(named_table, [{data, not(Data)}]), + loop(Data, Type, Prot, OpenBrowser, MPid); + + + {gs, open_browser, click, Data, _Args} -> + gs:config(open_browser, [{data, not(Data)}]), + loop(Data, Type, Prot, Data, MPid); + + + {gs, EntryId, keypress, _Data, ['Tab', _No, 0 | _T]} -> + case get_entry_term(EntryId) of + {ok, _Term} -> + gs:config(next_entry(EntryId, forward), [{setfocus, true}, + {select, {0, 100000000}}]); + error -> + done + end, + loop(NamedTab, Type, Prot, OpenBrowser, MPid); + + + {gs, EntryId, keypress, _Data, ['Tab', _No, 1 | _T]} -> + case get_entry_term(EntryId) of + {ok, _Term} -> + gs:config(next_entry(EntryId, backward), [{setfocus, true}, + {select, {0, 100000000}}]); + error -> + done + end, + loop(NamedTab, Type, Prot, OpenBrowser, MPid); + + + {gs, EntryId, keypress, _Data, ['Down' | _T]} -> + case get_entry_term(EntryId) of + {ok, _Term} -> + gs:config(next_entry(EntryId, forward), [{setfocus, true}, + {select, {0, 100000000}}]); + error -> + done + end, + loop(NamedTab, Type, Prot, OpenBrowser, MPid); + + + {gs, EntryId, keypress, _Data, ['Up' | _T]} -> + case get_entry_term(EntryId) of + {ok, _Term} -> + gs:config(next_entry(EntryId, backward), [{setfocus, true}, + {select, {0, 100000000}}]); + error -> + done + end, + loop(NamedTab, Type, Prot, OpenBrowser, MPid); + + + {gs, _EntryId, keypress, _Data, ['Return' | _T]} -> + gs:config(win, [{cursor, busy}]), + case create_table(NamedTab, Type, Prot, OpenBrowser, MPid) of + ok -> + exit(normal); + error -> + gs:config(win, [{cursor, arrow}]), + loop(NamedTab, Type, Prot, OpenBrowser, MPid) + end; + + + {gs, win, configure, _Data, _Args} -> + gs:config(win, [{width, ?WIN_WIDTH}, + {height, ?WIN_HEIGHT}]), + loop(NamedTab, Type, Prot, OpenBrowser, MPid); + + + {gs, win, destroy, _Data, _Args} -> + exit(normal); + + + raise -> + gs:config(win, [raise]), + loop(NamedTab, Type, Prot, OpenBrowser, MPid); + + + {error_msg_mode, ErrMsgMode} -> + put(error_msg_mode, ErrMsgMode), + loop(NamedTab, Type, Prot, OpenBrowser, MPid); + + + {'EXIT', _Pid, _Reason} -> + exit(normal); + + + _Other -> + loop(NamedTab, Type, Prot, OpenBrowser, MPid) + + end. + + + + +create_table(NamedTab, Type, Prot, OpenBrowser, MPid) -> + case get_entry_term(node_entry) of + error -> + error; + {ok, Node} -> + case get_entry_term(name_entry) of + error -> + error; + {ok, TabName} -> + case get_entry_term(keypos_entry) of + error -> + error; + {ok, KeyPos} -> + Options = + [Type, Prot, {keypos, KeyPos}] ++ + case NamedTab of + true -> + [named_table]; + false -> + [] + end, + {Readable, NewOpenBrowser} = + case Prot of + private -> + {false, false}; + _Other -> + {true, OpenBrowser} + end, + MPid ! {tv_new_table, self(), Node, TabName, Options, ets, + Readable, NewOpenBrowser}, + receive + ok -> + ok; + error -> + show_error_msg(), + error + after + 5000 -> + show_error_msg(), + error + end + end + end + end. + + + + + +show_error_msg() -> + Msg = + case get(error_msg_mode) of + normal -> + ["Couldn't create a table using", + "the specified settings!"]; + haiku -> + ["The table you want", + "Could maybe be created.", + "But I don't know how."] + end, + tv_utils:notify(win, "TV Notification", Msg). + + + + + + + +get_entry_term(Id) -> + EditedStr = gs:read(Id, text), + case tv_db_search:string_to_term(EditedStr) of + {ok, NewTerm} when Id =:= node_entry, is_atom(NewTerm) -> + {ok,NewTerm}; + {ok, NewTerm} when Id =:= name_entry, is_atom(NewTerm) -> + {ok,NewTerm}; + {ok, NewTerm} when Id =:= keypos_entry, is_integer(NewTerm), NewTerm > 0 -> + {ok,NewTerm}; + _Other -> + NewMsg = + case get(error_msg_mode) of + normal -> + case Id of + node_entry -> + ["Please enter a valid node name!"]; + name_entry -> + ["Please enter a valid table name!"]; + keypos_entry -> + ["Please enter a valid key position!"] + end; + haiku -> + E1 = "Aborted effort", + L = + case Id of + node_entry -> + ["Reflect, repent and retype:", + "Enter valid node."]; + name_entry -> + ["Reflect, repent and retype:", + "Enter valid name."]; + keypos_entry -> + ["Reflect, repent and retype", + "Key position, please."] + end, + [E1 | L] + end, + gs:config(Id, [beep, {select, {0, 100000000}}, {setfocus, true}]), + tv_utils:notify(win, "TV Notification", NewMsg), + error + end. + + + + + +next_entry(node_entry, forward) -> + name_entry; +next_entry(node_entry, backward) -> + keypos_entry; +next_entry(name_entry, forward) -> + keypos_entry; +next_entry(name_entry, backward) -> + node_entry; +next_entry(keypos_entry, forward) -> + node_entry; +next_entry(keypos_entry, backward) -> + name_entry. + + + + +create_window(Node) -> + gs:window(win, gs:start(), [{width, ?WIN_WIDTH}, + {height, ?WIN_HEIGHT}, + {bg, ?DEFAULT_BG_COLOR}, + {title, "[TV] Create New ETS Table"}, + {configure, true}, + {destroy, true}, + {cursor, arrow} + ]), + + gs:frame(frame1, win, [{width, ?FRAME_WIDTH}, + {height, ?FRAME1_HEIGHT}, + {x, ?FRAME_X}, + {y, ?FRAME1_Y}, + {bg, ?DEFAULT_BG_COLOR}, + {bw, ?BW}]), + gs:frame(frame2, win, [{width, ?FRAME_WIDTH}, + {height, ?FRAME2_HEIGHT}, + {x, ?FRAME_X}, + {y, ?FRAME2_Y}, + {bg, ?DEFAULT_BG_COLOR}, + {bw, ?BW}]), + gs:frame(frame3, win, [{width, ?FRAME_WIDTH}, + {height, ?FRAME3_HEIGHT}, + {x, ?FRAME_X}, + {y, ?FRAME3_Y}, + {bg, ?DEFAULT_BG_COLOR}, + {bw, ?BW}]), + + gs:label(frame1, [{width, ?NODE_LBL_WIDTH}, + {height, ?LBL_HEIGHT}, + {x, ?LBL_X}, + {y, ?NODE_LBL_Y}, + {bg, ?DEFAULT_BG_COLOR}, + {fg, {0,0,0}}, + {align, w}, + {font, ?FONT}, + {label, {text, "Node:"}} + ]), + gs:label(frame1, [{width, ?NAME_LBL_WIDTH}, + {height, ?LBL_HEIGHT}, + {x, ?LBL_X}, + {y, ?NAME_LBL_Y}, + {bg, ?DEFAULT_BG_COLOR}, + {fg, {0,0,0}}, + {align, w}, + {font, ?FONT}, + {label, {text, "Table name:"}} + ]), + gs:label(frame2, [{width, ?TYPE_LBL_WIDTH}, + {height, ?LBL_HEIGHT}, + {x, ?LBL_X}, + {y, ?TYPE_LBL_Y}, + {bg, ?DEFAULT_BG_COLOR}, + {fg, {0,0,0}}, + {align, w}, + {font, ?FONT}, + {label, {text, "Type:"}} + ]), + gs:label(frame2, [{width, ?PROT_LBL_WIDTH}, + {height, ?LBL_HEIGHT}, + {x, ?LBL_X}, + {y, ?PROT_LBL_Y}, + {bg, ?DEFAULT_BG_COLOR}, + {fg, {0,0,0}}, + {align, w}, + {font, ?FONT}, + {label, {text, "Protection:"}} + ]), + gs:label(frame2, [{width, ?KEYPOS_LBL_WIDTH}, + {height, ?LBL_HEIGHT}, + {x, ?LBL_X}, + {y, ?KEYPOS_LBL_Y}, + {bg, ?DEFAULT_BG_COLOR}, + {fg, {0,0,0}}, + {align, w}, + {font, ?FONT}, + {label, {text, "Key position:"}} + ]), + + gs:entry(node_entry, frame1, [{width, ?NODE_ENTRY_WIDTH}, + {height, ?ENTRY_HEIGHT}, + {x, ?ENTRY_X1}, + {y, ?NODE_ENTRY_Y}, + {bg, {255,255,255}}, + {fg, {0,0,0}}, + {font, ?FONT}, + {enable, true}, + {text, "'" ++ atom_to_list(Node) ++ "'"}, + {keypress, true} + ]), + gs:entry(name_entry, frame1, [{width, ?NAME_ENTRY_WIDTH}, + {height, ?ENTRY_HEIGHT}, + {x, ?ENTRY_X1}, + {y, ?NAME_ENTRY_Y}, + {bg, {255,255,255}}, + {fg, {0,0,0}}, + {font, ?FONT}, + {enable, true}, + {text, atom_to_list(?DEFAULT_NAME)}, + {keypress, true}, + {setfocus, true}, + {select, {0,100000000}} + ]), + gs:entry(keypos_entry, frame2, [{width, ?KEYPOS_ENTRY_WIDTH}, + {height, ?ENTRY_HEIGHT}, + {x, ?ENTRY_X2}, + {y, ?KEYPOS_ENTRY_Y}, + {bg, {255,255,255}}, + {fg, {0,0,0}}, + {font, ?FONT}, + {enable, true}, + {keypress, true}, + {text, integer_to_list(?DEFAULT_KEYPOS)} + ]), + + gs:radiobutton(set, frame2, [{width, ?RBTN_WIDTH1}, + {height, ?RBTN_HEIGHT}, + {x, ?RBTN_X1}, + {y, ?RBTN_Y1}, + {align, w}, + {label, {text, "set"}}, + {group, type} + ]), + gs:radiobutton(ordered_set, frame2, [{width, ?RBTN_WIDTH1}, + {height, ?RBTN_HEIGHT}, + {x, ?RBTN_X2}, + {y, ?RBTN_Y1}, + {align, w}, + {label, {text, "ordered_set"}}, + {group, type} + ]), + gs:radiobutton(bag, frame2, [{width, ?RBTN_WIDTH1}, + {height, ?RBTN_HEIGHT}, + {x, ?RBTN_X1}, + {y, ?RBTN_Y1PLUS}, + {align, w}, + {label, {text, "bag"}}, + {group, type} + ]), + gs:radiobutton(duplicate_bag, frame2, [{width, ?RBTN_WIDTH2}, + {height, ?RBTN_HEIGHT}, + {x, ?RBTN_X2}, + {y, ?RBTN_Y1PLUS}, + {align, w}, + {label, {text, "duplicate_bag"}}, + {group, type} + ]), + + gs:radiobutton(public, frame2, [{width, ?RBTN_WIDTH1}, + {height, ?RBTN_HEIGHT}, + {x, ?RBTN_X1}, + {y, ?RBTN_Y2}, + {align, w}, + {label, {text, "public"}}, + {group, protection} + ]), + gs:radiobutton(protected, frame2, [{width, ?RBTN_WIDTH1}, + {height, ?RBTN_HEIGHT}, + {x, ?RBTN_X2}, + {y, ?RBTN_Y2}, + {align, w}, + {label, {text, "protected"}}, + {group, protection} + ]), + gs:radiobutton(private, frame2, [{width, ?RBTN_WIDTH2}, + {height, ?RBTN_HEIGHT}, + {x, ?RBTN_X3}, + {y, ?RBTN_Y2}, + {align, w}, + {label, {text, "private"}}, + {group, protection} + ]), + + gs:checkbutton(named_table, frame1, [{width, ?NAMED_TABLE_CBTN_WIDTH}, + {height, ?CBTN_HEIGHT}, + {x, ?NAMED_TABLE_CBTN_X}, + {y, ?NAMED_TABLE_CBTN_Y}, + {align, w}, + {label, {text, "Named table"}}, + {select, false}, + {data, true} + ]), + + gs:checkbutton(open_browser, frame3, [{width, ?OPEN_BROWSER_CBTN_WIDTH}, + {height, ?CBTN_HEIGHT}, + {x, ?OPEN_BROWSER_CBTN_X}, + {y, ?OPEN_BROWSER_CBTN_Y}, + {align, w}, + {label, {text, "Open browser"}}, + {select, true}, + {data, false} + ]), + +%% gs:label(frame2, [{width, ?VLINE_LBL_WIDTH}, +%% {height, ?VLINE_LBL_HEIGHT}, +%% {x, ?VLINE_LBL_X}, +%% {y, ?VLINE_LBL_Y1}, +%% {bg, {0,0,0}} +%% ]), +%% gs:label(frame2, [{width, ?VLINE_LBL_WIDTH}, +%% {height, ?VLINE_LBL_HEIGHT}, +%% {x, ?VLINE_LBL_X}, +%% {y, ?VLINE_LBL_Y2}, +%% {bg, {0,0,0}} +%% ]), +%% gs:label(frame2, [{width, ?HLINE_LBL_WIDTH}, +%% {height, ?HLINE_LBL_HEIGHT}, +%% {x, ?HLINE_LBL_X}, +%% {y, ?HLINE_LBL_Y}, +%% {bg, {0,0,0}} +%% ]), +%% + gs:button(ok, frame3, [{width, ?BTN_WIDTH}, + {height, ?BTN_HEIGHT}, + {x, ?BTN_X1}, + {y, ?BTN_Y}, + {bg, ?DEFAULT_BG_COLOR}, + {fg, {0,0,0}}, + {label, {text, "OK"}} + ]), + gs:button(cancel, frame3, [{width, ?BTN_WIDTH}, + {height, ?BTN_HEIGHT}, + {x, ?BTN_X2}, + {y, ?BTN_Y}, + {bg, ?DEFAULT_BG_COLOR}, + {fg, {0,0,0}}, + {label, {text, "Cancel"}} + ]), + + gs:config(?DEFAULT_TYPE, [{select, true}]), + gs:config(?DEFAULT_PROT, [{select, true}]), + + gs:config(win, [{map, true}]). + + + + + + + diff --git a/lib/tv/src/tv_nodewin.erl b/lib/tv/src/tv_nodewin.erl new file mode 100644 index 0000000000..3999d201d8 --- /dev/null +++ b/lib/tv/src/tv_nodewin.erl @@ -0,0 +1,403 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1998-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% +-module(tv_nodewin). + + + +-export([start/2, init/3]). + + +-include("tv_int_msg.hrl"). + + + +-define(WINDOW_WIDTH, 230). +-define(WINDOW_HEIGHT, 260). +-define(DEFAULT_BG_COLOR, {217,217,217}). +-define(POLL_INTERVAL, 5000). + + + +%%%********************************************************************* +%%% EXTERNAL FUNCTIONS +%%%********************************************************************* + + + + +start(CurrNode, ErrMsgMode) -> + spawn_link(?MODULE, init, [self(), CurrNode, ErrMsgMode]). + + + + + +init(Pid, CurrNode, ErrMsgMode) -> + process_flag(trap_exit, true), + net_kernel:monitor_nodes(true), + put(error_msg_mode, ErrMsgMode), + gs:start(), + NewCurrNode = update_node_listbox(CurrNode, false), + tell_master(NewCurrNode, CurrNode, Pid), + loop(Pid, NewCurrNode, node(), false). + + + + +%%%********************************************************************* +%%% INTERNAL FUNCTIONS +%%%********************************************************************* + + + +init_window(CurrNode, Pid) -> + create_window(), + NewCurrNode = update_node_listbox(CurrNode, true), + tell_master(NewCurrNode, CurrNode, Pid), + gs:config(win, [{map,true}]), + NewCurrNode. + + + + +handle_error(nodedown) -> + gs:window(errorwin, gs:start(), []), + gs:config(errorwin, [beep]), + case get(error_msg_mode) of + normal -> + tv_utils:notify(errorwin, "TV Notification", ["The selected node is down!"]); + haiku -> + Msg = ["With searching comes loss", + "And the presence of absence:", + "Node is down."], + tv_utils:notify(errorwin, "TV Notification", Msg) + end, + gs:destroy(errorwin); +handle_error(distributed) -> + gs:window(errorwin, gs:start(), []), + gs:config(errorwin, [beep]), + case get(error_msg_mode) of + normal -> + tv_utils:notify(errorwin, "TV Notification", + ["The system has become distributed!"]); + haiku -> + Msg = [], + tv_utils:notify(errorwin, "TV Notification", Msg) + end, + gs:destroy(errorwin); +handle_error(undistributed) -> + gs:window(errorwin, gs:start(), []), + gs:config(errorwin, [beep]), + case get(error_msg_mode) of + normal -> + tv_utils:notify(errorwin, "TV Notification", + ["The system is no longer distributed!"]); + haiku -> + Msg = ["The system you see", + "Is not a distributed", + "system anymore."], + tv_utils:notify(errorwin, "TV Notification", Msg) + end, + gs:destroy(errorwin). + +get_node_lists(CurrNode) -> + NodeDataList = lists:sort([node() | nodes()]), + NodeTextList = lists:map(fun(Item) -> + " " ++ atom_to_list(Item) + end, + NodeDataList), + + %% It *may* be possible that CurrNode has disappeared! + %% If this is the case, use the node where TV resides + %% as new current node. + %% This also covers the case when our own node (or some + %% other node) suddenly goes distributed. + + NewCurrNode = case lists:member(CurrNode, NodeDataList) of + true -> + CurrNode; + false -> + node() + end, + + %% Now get the index that shall be marked in the node listbox. + %% Remember that the first item has number 0 (zero)! + NodeMarkIndex = get_node_mark_index(NewCurrNode, NodeDataList, 0), + + {NewCurrNode, NodeDataList, NodeTextList, NodeMarkIndex}. + + + + +%% We know that CurrNode is *somewhere* in the list, since we have checked. +%% If the original CurrNode wasn't there, then we are using node() instead, +%% which definitely is in the list. (node() may have gone distributed in the +%% meantime, but it *IS* in the list!) :-) + +get_node_mark_index(CurrNode, [H | T], Acc) when CurrNode =/= H -> + get_node_mark_index(CurrNode, T, Acc + 1); +get_node_mark_index(CurrNode, [CurrNode | _], Acc) -> + Acc. %% Acc tells the index of the current head. :-) + + + + + +check_selected_node('nonode@nohost', _OldNode, _WinCreated) when node() =:= 'nonode@nohost' -> + %% Not distributed, OK! + 'nonode@nohost'; +check_selected_node(_Node, _OldNode, WinCreated) when node() =:= 'nonode@nohost' -> + %% No longer distributed, but previously was! + handle_error(undistributed), + update_node_listbox('nonode@nohost', WinCreated); +check_selected_node(Node, _OldNode, _WinCreated) when Node =:= node() -> + %% We are distributed, but on + %% our own node! Since we + % still are running, the node + %% is up. + Node; +check_selected_node(Node, 'nonode@nohost', WinCreated) -> + %% The system has been distributed! + net_kernel:monitor_nodes(true), + handle_error(distributed), + update_node_listbox(Node, WinCreated); +check_selected_node(Node, _OldNode, WinCreated) -> + %% We are distributed, and a new node has been chosen! + %% We better check this node! + case net_adm:ping(Node) of + pong -> + Node; + _Other -> + handle_error(nodedown), + update_node_listbox(Node, WinCreated) + end. + + + +available_nodes() -> + lists:sort([node() | nodes()]). + + + +loop(Pid, CurrNode, HomeNode, WinCreated) -> + receive + + {nodedown, _Node} -> + flush_nodedown_messages(), + flush_nodeup_messages(), + case lists:member(CurrNode, available_nodes()) of + true -> + done; + false when node() =:= 'nonode@nohost', CurrNode =/= 'nonode@nohost' -> + handle_error(undistributed); + false -> + handle_error(nodedown) + end, + NewCurrNode = update_node_listbox(CurrNode, WinCreated), + tell_master(NewCurrNode, CurrNode, Pid), + loop(Pid, NewCurrNode, node(), WinCreated); + + + {nodeup, _Node} -> + flush_nodeup_messages(), + flush_nodedown_messages(), + case lists:member(CurrNode, available_nodes()) of + true -> + done; + false when node() =:= 'nonode@nohost', CurrNode =/= 'nonode@nohost' -> + handle_error(undistributed); + false when CurrNode =:= 'nonode@nohost' -> + net_kernel:monitor_nodes(true), + handle_error(distributed); + false -> + handle_error(nodedown) + end, + NewCurrNode = update_node_listbox(CurrNode, WinCreated), + tell_master(NewCurrNode, CurrNode, Pid), + loop(Pid, NewCurrNode, node(), WinCreated); + + + {gs, node_listbox, click, Data, [Idx, _Txt | _]} -> + NewCurrNode = check_selected_node(lists:nth(Idx + 1, Data), CurrNode, WinCreated), + tell_master(NewCurrNode, CurrNode, Pid), + loop(Pid, NewCurrNode, node(), WinCreated); + + + {gs, win, configure, _, _} -> + gs:config(win, [{width, ?WINDOW_WIDTH}, {height, ?WINDOW_HEIGHT}]), + loop(Pid, CurrNode, HomeNode, WinCreated); + + + show_window when WinCreated-> + gs:config(win, [raise]), + loop(Pid, CurrNode, HomeNode, WinCreated); + + show_window when not WinCreated -> + init_window(CurrNode, Pid), + loop(Pid, CurrNode, HomeNode, true); + + {gs, _Id, click, close_menu, _Args} -> + gs:destroy(win), + loop(Pid, CurrNode, HomeNode, false); + + + {gs, _Id, keypress, _Data, [c, _, 0, 1 | _]} -> + gs:destroy(win), + loop(Pid, CurrNode, HomeNode, false); + + + {gs, _Id, keypress, _Data, ['C', _, 1, 1 | _]} -> + gs:destroy(win), + loop(Pid, CurrNode, HomeNode, false); + + + {gs, _Id, keypress, _Data, _Args} -> + loop(Pid, CurrNode, HomeNode, WinCreated); + + + {gs, _, destroy, _, _} -> + loop(Pid, CurrNode, HomeNode, false); + + + {error_msg_mode, Mode} -> + put(error_msg_mode, Mode), + loop(Pid, CurrNode, HomeNode, WinCreated); + + {'EXIT', Pid, _Reason} -> + net_kernel:monitor_nodes(false), + exit(normal); + + + {'EXIT', _OtherPid, _Reason} -> + loop(Pid, CurrNode, HomeNode, WinCreated); + + + _Other -> + io:format("Node window received message ~p ~n", [_Other]), + loop(Pid, CurrNode, HomeNode, WinCreated) + + after + 1000 -> + NewHomeNode = case node() of + HomeNode -> + HomeNode; + Other -> + self() ! {nodeup, Other} + end, + loop(Pid, CurrNode, NewHomeNode, WinCreated) + end. + + + + +tell_master(NewNode, NewNode, _Pid) -> + done; +tell_master(NewNode, _OldNode, Pid) -> + Pid ! {tv_new_node, self(), NewNode}. + + + + +flush_nodedown_messages() -> + receive + {nodedown,_Node} -> + flush_nodedown_messages() + after + 0 -> + done + end. + + + + +flush_nodeup_messages() -> + receive + {nodeup,_Node} -> + flush_nodeup_messages() + after + 0 -> + done + end. + + + + +update_node_listbox(Node, WinCreated) -> + {NewNode, NodeDataList, NodeTextList, MarkIndex} = get_node_lists(Node), + case WinCreated of + false -> + done; + true -> + catch gs:config(node_listbox, [{data, NodeDataList}, + {items, NodeTextList}, + {selection, MarkIndex} + ]) + end, + NewNode. + + + + + +create_window() -> + gs:window(win, gs:start(), [{width, ?WINDOW_WIDTH}, + {height, ?WINDOW_HEIGHT}, + {bg, ?DEFAULT_BG_COLOR}, + {title, "[TV] Connected nodes"}, + {configure, true}, + {destroy, true}, + {cursor, arrow}, + {keypress, true} + ]), + gs:menubar(menubar, win, [{bg, ?DEFAULT_BG_COLOR} + ]), + gs:menubutton(mbutt, menubar, [{bg, ?DEFAULT_BG_COLOR}, + {fg, {178, 34, 34}}, % firebrick + {label, {text, " File "}}, + {underline, 1} + ]), + + % Create the actual menu! + gs:menu(menu, mbutt, [{bg, ?DEFAULT_BG_COLOR}, + {fg, {178, 34, 34}}]), + gs:menuitem(menu, [{bg, ?DEFAULT_BG_COLOR}, + {fg, {178, 34, 34}}, + {label, {text, " Close Ctrl-C "}}, + {data, close_menu}, + {underline, 1} + ]), + + Xpos = 4, + Ypos = 40, + gs:listbox(node_listbox, win, [{x, Xpos}, + {y, Ypos}, + {width, ?WINDOW_WIDTH - 2 * Xpos}, + {height, ?WINDOW_HEIGHT - Ypos - Xpos}, + {bg, {255,255,255}}, + {vscroll, right}, + {hscroll, true}, + {click, true} + ]). + + + + + + + + diff --git a/lib/tv/src/tv_pb.erl b/lib/tv/src/tv_pb.erl new file mode 100644 index 0000000000..34db8d0772 --- /dev/null +++ b/lib/tv/src/tv_pb.erl @@ -0,0 +1,685 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1997-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% +-module(tv_pb). + + + +-export([pb/1]). + + +-include("tv_int_def.hrl"). +-include("tv_pd_int_msg.hrl"). +-include("tv_pb_int_def.hrl"). + + + + + + + + +%%%********************************************************************* +%%% EXTERNAL FUNCTIONS +%%%********************************************************************* + + + + +%%====================================================================== +%% Function: pb. +%% +%% Return Value: None. +%% +%% Description: Process controlling the grid buttons on the display. +%% +%% Parameters: None. +%%====================================================================== + + +pb(ParentPid) -> + process_flag(trap_exit, true), + ProcVars = #process_variables{parent_pid = ParentPid}, + loop(ProcVars). + + + + + + + + +%%%******************************************************************** +%%% INTERNAL FUNCTIONS +%%%******************************************************************** + + + + + +%%====================================================================== +%% Function: loop. +%% +%% Return Value: None. +%% +%% Description: Eternal (well, almost) loop, receiving messages and +%% handling them. +%% +%% Parameters: +%%====================================================================== + + +loop(ProcVars) -> + receive + Msg -> + case Msg of + + #pb_update_vbtns{} -> + NewProcVars = update_vbtns(Msg, ProcVars), + loop(NewProcVars); + + #pb_key_info{} -> + NewProcVars = update_keys(Msg, ProcVars), + loop(NewProcVars); + + #pb_update_hbtns{} -> + NewProcVars = update_hbtns(Msg, ProcVars), + loop(NewProcVars); + + #pb_set_sort_col{} -> + NewProcVars = set_sort_col(Msg, ProcVars), + loop(NewProcVars); + + #pb_remove_marks{} -> + NewProcVars = remove_marks(ProcVars), + loop(NewProcVars); + + #pb_init_btns{} -> + NewProcVars = init_btns(Msg, ProcVars), + loop(NewProcVars); + + {gs, Id, Event, Data, Args} -> + NewProcVars = gs_messages({Id, Event, Data, Args}, ProcVars), + loop(NewProcVars); + + + {'EXIT', Pid, Reason} -> + ParentPid = ProcVars#process_variables.parent_pid, + exit_signals({Pid, Reason}, ParentPid, ProcVars), + loop(ProcVars); + + _Other -> + loop(ProcVars) + end + end. + + + + + + + + +%%====================================================================== +%% Function: +%% +%% Return Value: +%% +%% Description: +%% +%% Parameters: +%%====================================================================== + + +exit_signals(ExitInfo, ParentPid, _ProcVars) -> + case ExitInfo of + {ParentPid, _Reason} -> + exit(normal); + _Other -> + done + end. + + + + + + + + + +%%====================================================================== +%% Function: +%% +%% Return Value: +%% +%% Description: +%% +%% Parameters: +%%====================================================================== + + +gs_messages(Msg, ProcVars) -> + + case Msg of + + {Id, click, {hbtn, RealCol, VirtualCol}, _Args} -> + handle_col_marking(Id, RealCol, VirtualCol, ProcVars); + + {Id, buttonpress, {resbtn, RealCol, VirtualCol, Xpos}, [1 | _Tail]} -> + handle_col_resizing(Id, RealCol, VirtualCol, Xpos, ProcVars), + ProcVars; + + {_Id, click, {vbtn, RealRow, VirtualRow}, _Args} -> + handle_row_marking(RealRow, VirtualRow, ProcVars); + + _OtherMessage -> + ProcVars + + end. + + + + + + + + +%%====================================================================== +%% Function: +%% +%% Return Value: +%% +%% Description: +%% +%% Parameters: +%%====================================================================== + + +remove_marks(ProcVars) -> + #process_variables{col_mark_params = ColMarkP, + row_mark_params = RowMarkP} = ProcVars, + + #col_mark_params{col_btn_id = BtnId, + virtual_col_marked = VirtualCol, + virtual_sort_col = SortCol} = ColMarkP, + + case BtnId of + undefined -> + done; + _AnyId -> + case VirtualCol of + SortCol -> + gs:config(BtnId, [{bg, ?SORT_MARK_COLOR}, + {fg, {0, 0, 0}} + ]); + _Other -> + gs:config(BtnId, [{bg, ?DEFAULT_BG_COLOR}, + {fg, {0, 0, 0}} + ]) + end + end, + + NewRowMarkP = RowMarkP#row_mark_params{virtual_row_marked = undefined, + real_row_marked = undefined + }, + NewColMarkP = ColMarkP#col_mark_params{col_btn_id = undefined, + virtual_col_marked = undefined + }, + ProcVars#process_variables{col_mark_params = NewColMarkP, + row_mark_params = NewRowMarkP + }. + + + + + + + + + + + + +%%====================================================================== +%% Function: +%% +%% Return Value: +%% +%% Description: +%% +%% Parameters: +%%====================================================================== + + +handle_col_marking(BtnId, RealCol, VirtualCol, ProcVars) -> + #process_variables{parent_pid = PdPid, + col_mark_params = ColMarkP, + row_mark_params = RowMarkP} = ProcVars, + + #col_mark_params{col_btn_id = OldBtnId, + virtual_col_marked = OldVirtualCol, + virtual_sort_col = SortCol} = ColMarkP, + + {ColMarked, NewColMarkP} = mark_col_btn(BtnId, OldBtnId, VirtualCol, + OldVirtualCol, RealCol, SortCol, + ColMarkP), + + PdPid ! #pb_col_marked{sender = self(), + col_marked = ColMarked, + real_col = RealCol, + virtual_col = VirtualCol + }, + + NewRowMarkP = RowMarkP#row_mark_params{virtual_row_marked = undefined, + real_row_marked = undefined + }, + ProcVars#process_variables{col_mark_params = NewColMarkP, + row_mark_params = NewRowMarkP + }. + + + + + + +%%====================================================================== +%% Function: +%% +%% Return Value: +%% +%% Description: +%% +%% Parameters: +%%====================================================================== + + +handle_row_marking(RealRow, VirtualRow, ProcVars) -> + #process_variables{parent_pid = PdPid, + col_mark_params = ColMarkP, + row_mark_params = RowMarkP} = ProcVars, + + #col_mark_params{col_btn_id = OldBtnId, + virtual_col_marked = OldVirtualCol, + virtual_sort_col = SortCol} = ColMarkP, + + {_ColMarked, NewColMarkP} = mark_col_btn(OldBtnId, OldBtnId, OldVirtualCol, + OldVirtualCol, undefined, SortCol, + ColMarkP), + + #row_mark_params{virtual_row_marked = OldVirtualRow} = RowMarkP, + + % Check if row shall be marked or unmarked! + {RowMarked, NewRowMarkP} = check_marked_row(VirtualRow, OldVirtualRow, RealRow, + RowMarkP), + + PdPid ! #pb_row_marked{sender = self(), + row_marked = RowMarked, + real_row = RealRow, + virtual_row = VirtualRow + }, + + ProcVars#process_variables{row_mark_params = NewRowMarkP, + col_mark_params = NewColMarkP}. + + + + + + + + + +%%====================================================================== +%% Function: +%% +%% Return Value: +%% +%% Description: +%% +%% Parameters: +%%====================================================================== + + +%% Three cases: no button previously clicked, or same button clicked, +%% or some other button clicked. + +check_marked_row(NewVirtRow, undefined, RealRow, RowMarkP) -> + % No btn already pressed! + {true, RowMarkP#row_mark_params{virtual_row_marked = NewVirtRow, + real_row_marked = RealRow}}; +check_marked_row(NewVirtRow, OldVirtRow, _RealRow, RowMarkP) when NewVirtRow =:= OldVirtRow -> + % The button previously pressed has been pressed again! + {false, RowMarkP#row_mark_params{virtual_row_marked = undefined, + real_row_marked = undefined}}; +check_marked_row(NewVirtRow, _OldVirtRow, RealRow, RowMarkP) -> + % A new btn has been pressed! + {true, RowMarkP#row_mark_params{virtual_row_marked = NewVirtRow, + real_row_marked = RealRow}}. + + + + + + + + + + + + +%%====================================================================== +%% Function: +%% +%% Return Value: +%% +%% Description: +%% +%% Parameters: +%%====================================================================== + + +set_sort_col(Msg, ProcVars) -> + #pb_set_sort_col{virtual_col = SortCol} = Msg, + tv_pb_funcs:set_new_sort_col(SortCol, ProcVars). + + + + + + + +%%====================================================================== +%% Function: +%% +%% Return Value: +%% +%% Description: +%% +%% Parameters: +%%====================================================================== + + +%% Three cases: no button previously clicked, or same button clicked, +%% or some other button clicked. + +mark_col_btn(NewId, undefined, NewVirtCol, _OldVirtCol, _RealCol, _SortCol, ColMarkP) -> + % No btn already pressed! + gs:config(NewId, [{bg, ?COL_MARK_COLOR}, + {fg, {255, 255, 255}} + ]), + {true, ColMarkP#col_mark_params{col_btn_id = NewId, + virtual_col_marked = NewVirtCol}}; +mark_col_btn(NewId, _OldId, NewVirtCol, OldVirtCol, _RealCol, SortCol, ColMarkP) when NewVirtCol =:= OldVirtCol, NewVirtCol =:= SortCol -> + % The button previously pressed has been pressed again! + gs:config(NewId, [{bg, ?SORT_MARK_COLOR}, + {fg, {0, 0, 0}} + ]), + {false, ColMarkP#col_mark_params{col_btn_id = undefined, + virtual_col_marked = undefined}}; +mark_col_btn(NewId, _OldId, NewVirtCol, OldVirtCol, _RealCol, _SortCol, ColMarkP) when NewVirtCol =:= OldVirtCol -> + % The button previously pressed has been pressed again! + gs:config(NewId, [{bg, ?DEFAULT_BG_COLOR}, + {fg, {0, 0, 0}} + ]), + {false, ColMarkP#col_mark_params{col_btn_id = undefined, + virtual_col_marked = undefined}}; +mark_col_btn(NewId, OldId, NewVirtCol, _OldVirtCol, _RealCol, _SortCol, ColMarkP) -> + % A new btn has been pressed! + gs:config(OldId, [{bg, ?DEFAULT_BG_COLOR}, + {fg, {0, 0, 0}} + ]), + gs:config(NewId, [{bg, ?COL_MARK_COLOR}, + {fg, {255, 255, 255}} + ]), + {true, ColMarkP#col_mark_params{col_btn_id = NewId, + virtual_col_marked = NewVirtCol}}. + + + + + + + + + + + +%%====================================================================== +%% Function: +%% +%% Return Value: +%% +%% Description: +%% +%% Parameters: +%%====================================================================== + + +handle_col_resizing(RbtnId, RealCol, VirtualCol, Xpos, ProcVars) -> + gs:config(RbtnId, [{motion, true}]), + #process_variables{parent_pid = ParentPid, + grid_frame_id = GrFrId, + grid_frame_height = Height, + hbtn_height = HbtnH, + resbtn_width = RbtnW, + cols_shown = ColsShown} = ProcVars, + + LineId = gs:frame(GrFrId, [{width, 1}, + {height, Height - HbtnH}, + {x, Xpos}, + {y, HbtnH - 1}, + {bg, ?DEFAULT_BG_COLOR} + ]), + MinColWidth = RbtnW, + + OldColWidth = lists:nth(RealCol, ColsShown), + Xdiff = get_xdiff(RbtnId, 1, 0, LineId, Xpos, MinColWidth - OldColWidth), + + ParentPid ! #pb_new_colwidth{sender = self(), + real_col = RealCol, + virtual_col = VirtualCol, + xdiff = Xdiff}, + + gs:config(RbtnId, [{motion, false}]), + gs:destroy(LineId). + + + + + + + + + + + + +%%====================================================================== +%% Function: +%% +%% Return Value: +%% +%% Description: +%% +%% Parameters: +%%====================================================================== + + +get_xdiff(Id, Btn, LastXdiff, LineId, LineXpos, MinAllowedXdiff) -> + receive + {gs, Id, motion, {resbtn, _RealCol, _VirtCol, _OldXpos}, [NewXdiff | _T]} -> + UsedXdiff = max(MinAllowedXdiff, NewXdiff), + gs:config(LineId, [{x, LineXpos + UsedXdiff}]), + get_xdiff(Id, Btn, UsedXdiff, LineId, LineXpos, MinAllowedXdiff); + {gs, Id, buttonrelease, _Data, [Btn | _T]} -> + LastXdiff; + {gs, Id, buttonrelease, _Data, _Args} -> + get_xdiff(Id, Btn, LastXdiff, LineId, LineXpos, MinAllowedXdiff); + {gs, Id, buttonpress, _Data, _Args} -> + get_xdiff(Id, Btn, LastXdiff, LineId, LineXpos, MinAllowedXdiff) + end. + + + + + + + + + + + +%%====================================================================== +%% Function: +%% +%% Return Value: +%% +%% Description: +%% +%% Parameters: +%%====================================================================== + + +init_btns(Msg, ProcVars) -> + #pb_init_btns{parent_id = ParentId, + parent_width = Width, + parent_height = Height, + ypos = Ypos, + hbtn_height = HbtnH, + resbtn_width = RbtnW, + vbtn_width = VbtnW, + nof_rows = NofRows, + row_height = RowHeight, + first_col_shown = FirstColShown, + cols_shown = ColsShown} = Msg, + + NewProcVars = tv_pb_funcs:init_btns(ParentId, Ypos, HbtnH, VbtnW, RbtnW, + FirstColShown, ColsShown, NofRows, + RowHeight, ProcVars), + + gs:frame(ParentId, [{bg, {0, 0, 0}}, + {bw, 0}, + {width, 1300}, + {height, 1}, + {x, 0}, + {y, Ypos - 1} + ]), + NewProcVars#process_variables{grid_frame_width = Width, + grid_frame_height = Height + }. + + + + + + + + +%%====================================================================== +%% Function: +%% +%% Return Value: +%% +%% Description: +%% +%% Parameters: +%%====================================================================== + + +update_hbtns(Msg, ProcVars) -> + #pb_update_hbtns{parent_width = Width, + parent_height = Height, + first_col_shown = FirstColShown, + cols_shown = ColsShown} = Msg, + + NewProcVars = tv_pb_funcs:update_hbtns(FirstColShown, ColsShown, ProcVars), + + NewProcVars#process_variables{grid_frame_width = Width, + grid_frame_height = Height + }. + + + + + + + + +%%====================================================================== +%% Function: +%% +%% Return Value: +%% +%% Description: +%% +%% Parameters: +%%====================================================================== + + +update_vbtns(Msg, ProcVars) -> + #pb_update_vbtns{color_list = Colors, + first_row_shown = FirstRowShown, + nof_rows_shown = NofRowsShown, + blinking_enabled = BlinkEnabled} = Msg, + + tv_pb_funcs:update_vbtns(NofRowsShown, FirstRowShown, Colors, BlinkEnabled, + ProcVars). + + + + + + +%%====================================================================== +%% Function: +%% +%% Return Value: +%% +%% Description: +%% +%% Parameters: +%%====================================================================== + + +update_keys(Msg, ProcVars) -> + #pb_key_info{list_of_keys = KeyList} = Msg, + tv_pb_funcs:update_keys(KeyList, ProcVars). + + + + + + + + +%%====================================================================== +%% Function: +%% +%% Return Value: +%% +%% Description: +%% +%% Parameters: +%%====================================================================== + + +max(A, B) when A >= B -> + A; +max(_, B) -> + B. + + diff --git a/lib/tv/src/tv_pb_funcs.erl b/lib/tv/src/tv_pb_funcs.erl new file mode 100644 index 0000000000..87a4719bbd --- /dev/null +++ b/lib/tv/src/tv_pb_funcs.erl @@ -0,0 +1,1050 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1997-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% +-module(tv_pb_funcs). + + + +-export([init_btns/10, + update_hbtns/3, + update_vbtns/5, + update_keys/2, + set_new_sort_col/2]). + + +-include("tv_int_def.hrl"). +-include("tv_pb_int_def.hrl"). + + + + + + + +%%%********************************************************************* +%%% EXTERNAL FUNCTIONS +%%%********************************************************************* + + + + +%%====================================================================== +%% Function: +%% +%% Return Value: +%% +%% Description: +%% +%% Parameters: +%%====================================================================== + + + +init_btns(ParentId, Ypos, HbtnH, + VbtnW, ResbtnW, FirstColShown, ColsShown, NofRows, RowH, ProcVars) -> + + #process_variables{key_numbers = KeyNos, + key_ids = KeyIds} = ProcVars, + +% C = gs:canvas(ParentId, [{width, VbtnW - 1}, +% {height, HbtnH}, +% {x, 0}, +% {y, HbtnH + 1}, +% {bg, white} +% ]), +% gs:create(image, C, [{load_gif, "erlang.gif"}]), + + {HbtnsShown, ResBtnsShown} = update_hbtns(ColsShown, [], [], + FirstColShown, ParentId, Ypos, + HbtnH, ResbtnW, VbtnW), + + NewKeyIds = update_keys(KeyNos, KeyIds, FirstColShown, + FirstColShown + length(ColsShown) - 1, HbtnsShown, + ParentId, []), + + VbtnsShown = create_vbtns(ParentId, Ypos, NofRows, RowH, VbtnW, HbtnH), + ProcVars#process_variables{grid_frame_id = ParentId, + ypos = Ypos, + hbtn_height = HbtnH, + vbtn_width = VbtnW, + resbtn_width = ResbtnW, + first_col_shown = FirstColShown, + hbtns_shown = HbtnsShown, + resbtns_shown = ResBtnsShown, + vbtns_shown = VbtnsShown, + cols_shown = ColsShown, + key_ids = NewKeyIds + }. + + + + + + + + + + +%%====================================================================== +%% Function: +%% +%% Return Value: +%% +%% Description: +%% +%% Parameters: +%%====================================================================== + + +update_hbtns(FirstColShown, ColsShown, ProcVars) -> + #process_variables{grid_frame_id = ParentId, + first_col_shown = OldFirstColShown, + cols_shown = OldColsShown, + ypos = Ypos, + hbtn_height = HbtnH, + vbtn_width = VbtnW, + resbtn_width = ResbtnW, + hbtns_shown = HbtnsShown, + resbtns_shown = ResbtnsShown, + key_numbers = KeyNos, + key_ids = KeyIds, + col_mark_params = ColMarkP} = ProcVars, + + % Only if the grid has been scrolled horizontally need we move the + % col mark! + case FirstColShown of + OldFirstColShown -> + done; + _NewValue -> + #col_mark_params{col_btn_id = MarkedBtnId, + virtual_col_marked = ColMarked, + sort_btn_id = SortBtnId, + virtual_sort_col = SortCol} = ColMarkP, + unmark_marked_col(MarkedBtnId, ColMarked, SortCol), + unmark_sort_col(SortBtnId, ColMarked, SortCol) + end, + + {NewHbtns, NewResbtns, NewKeys} = + case {FirstColShown, ColsShown} of + {OldFirstColShown, OldColsShown} -> + {HbtnsShown, ResbtnsShown, KeyIds}; + _Other -> + {NewHbtnsShown, NewResbtnsShown} = update_hbtns(ColsShown, + HbtnsShown, + ResbtnsShown, + FirstColShown, + ParentId, + Ypos, + HbtnH, + ResbtnW, + VbtnW), + NewKeyIds = update_keys(KeyNos, KeyIds, FirstColShown, + FirstColShown + length(ColsShown) - 1, + NewHbtnsShown, ParentId, []), + {NewHbtnsShown, NewResbtnsShown, NewKeyIds} + end, + + % Now mark the marked column again! + NewColMarkP = mark_marked_col(NewHbtns, FirstColShown, ColMarkP), + + ProcVars#process_variables{first_col_shown = FirstColShown, + hbtns_shown = NewHbtns, + resbtns_shown = NewResbtns, + cols_shown = ColsShown, + key_ids = NewKeys, + col_mark_params = NewColMarkP + }. + + + + + + + + + +%%====================================================================== +%% Function: +%% +%% Return Value: +%% +%% Description: +%% +%% Parameters: +%%====================================================================== + + +update_vbtns(NofRowsShown, FirstRowShown, Colors, BlinkEnabled, ProcVars) -> + #process_variables{vbtns_shown = Vbtns, + blink_color_list = BlinkList} = ProcVars, + + update_vbtns(1, NofRowsShown, FirstRowShown, Vbtns, Colors, BlinkEnabled, BlinkList), + NewProcVars = update_sort_btn_mark(ProcVars), + NewProcVars. + + + + + + + + + + +%%====================================================================== +%% Function: +%% +%% Return Value: +%% +%% Description: +%% +%% Parameters: +%%====================================================================== + + +set_new_sort_col(SortCol, ProcVars) -> + #process_variables{hbtns_shown = HbtnsShown, + col_mark_params = ColMarkP} = ProcVars, + + #col_mark_params{col_btn_id = MarkedColBtnId, + sort_btn_id = OldSortBtnId} = ColMarkP, + + % Set the new color of the sort btn, and remove the mark, if it is the same + % column! + + case MarkedColBtnId of + undefined -> + done; + _AnyId -> + gs:config(MarkedColBtnId, [{bg, ?DEFAULT_BG_COLOR}, + {fg, {0, 0, 0}} + ]) + end, + + SortBtnId = get_btn_id(SortCol, HbtnsShown), + case SortBtnId of + undefined -> + % The btn isn't visible, or no sorting shall be performed! + gs:config(OldSortBtnId, [{bg, ?DEFAULT_BG_COLOR}, + {fg, {0, 0, 0}} + ]); + _Other -> + % Unmark the old sort btn id! + gs:config(OldSortBtnId, [{bg, ?DEFAULT_BG_COLOR}, + {fg, {0, 0, 0}} + ]), + gs:config(SortBtnId, [{bg, ?SORT_MARK_COLOR}, + {fg, {0, 0, 0}} + ]) + end, + + NewColMarkP = ColMarkP#col_mark_params{col_btn_id = undefined, + virtual_col_marked = undefined, + sort_btn_id = SortBtnId, + virtual_sort_col = SortCol + }, + ProcVars#process_variables{col_mark_params = NewColMarkP}. + + + + + + + + + + + +%%====================================================================== +%% Function: +%% +%% Return Value: +%% +%% Description: +%% +%% Parameters: +%%====================================================================== + + +update_keys(KeyList, ProcVars) -> + #process_variables{key_numbers = OldKeyList, + key_ids = KeyIds, + first_col_shown = FirstColShown, + cols_shown = ColsShown, + hbtns_shown = HbtnsShown, + grid_frame_id = ParentId} = ProcVars, + + NewKeyIds = case KeyList of + OldKeyList -> + KeyIds; + NewKeyList -> + update_keys(NewKeyList, KeyIds, FirstColShown, + FirstColShown + length(ColsShown) - 1, + HbtnsShown, ParentId, []) + end, + + ProcVars#process_variables{key_numbers = KeyList, + key_ids = NewKeyIds + }. + + + + + + + + +%%%********************************************************************* +%%% INTERNAL FUNCTIONS +%%%********************************************************************* + + + + +%%====================================================================== +%% Function: +%% +%% Return Value: +%% +%% Description: +%% +%% Parameters: +%%====================================================================== + + +unmark_sort_col(undefined, _ColMarked, _SortCol) -> + done; +unmark_sort_col(SortBtnId, _ColMarked, _SortCol) -> + gs:config(SortBtnId, [{bg, ?DEFAULT_BG_COLOR}, + {fg, {0, 0, 0}} + ]). + + + + + + + +%%====================================================================== +%% Function: +%% +%% Return Value: +%% +%% Description: +%% +%% Parameters: +%%====================================================================== + + +mark_marked_col(HbtnsShown, _FirstColShown, ColMarkP) -> + #col_mark_params{virtual_col_marked = VirtualCol, + virtual_sort_col = SortCol} = ColMarkP, + + {NewMarkBtnId, NewSortBtnId} = + case VirtualCol of + SortCol -> + % Same btn! + BtnId = get_btn_id(VirtualCol, + HbtnsShown), + gs:config(BtnId, [{bg, ?SORT_MARK_COLOR}, + {fg, {0, 0, 0}} + ]), + {BtnId, BtnId}; + _OtherCol -> + MarkBtnId = get_btn_id(VirtualCol, HbtnsShown), + case MarkBtnId of + undefined -> + done; + _Else -> + gs:config(MarkBtnId, [{bg, ?COL_MARK_COLOR}, + {fg, {255, 255, 255}} + ]) + end, + + SortBtnId = get_btn_id(SortCol, HbtnsShown), + case SortBtnId of + undefined -> + done; + _OtherId -> + gs:config(SortBtnId, [{bg, ?SORT_MARK_COLOR}, + {fg, {0, 0, 0}} + ]) + end, + + {MarkBtnId, SortBtnId} + end, + + ColMarkP#col_mark_params{col_btn_id = NewMarkBtnId, + sort_btn_id = NewSortBtnId}. + + + + + + +%%====================================================================== +%% Function: +%% +%% Return Value: +%% +%% Description: +%% +%% Parameters: +%%====================================================================== + + +unmark_marked_col(undefined, _ColMarked, _SortCol) -> + done; +unmark_marked_col(BtnId, _ColMarked, _SortCol) -> + gs:config(BtnId, [{bg, ?DEFAULT_BG_COLOR}, + {fg, {0,0,0}} + ]). + + + + + + + +%%====================================================================== +%% Function: +%% +%% Return Value: +%% +%% Description: +%% +%% Parameters: +%%====================================================================== + + +update_sort_btn_mark(ProcVars) -> + #process_variables{hbtns_shown = HbtnsShown, + col_mark_params = ColMarkP} = ProcVars, + + #col_mark_params{col_btn_id = MarkedColBtnId, + virtual_col_marked = ColMarked, + sort_btn_id = OldSortBtnId, + virtual_sort_col = SortCol} = ColMarkP, + + {NewMarkedColBtnId, NewColMarked} = case ColMarked of + SortCol -> + {undefined, undefined}; + _Other -> + {MarkedColBtnId, ColMarked} + end, + + NewSortBtnId = set_sort_btn_color(OldSortBtnId, SortCol, HbtnsShown), + + NewColMarkP = ColMarkP#col_mark_params{col_btn_id = NewMarkedColBtnId, + virtual_col_marked = NewColMarked, + sort_btn_id = NewSortBtnId}, + + ProcVars#process_variables{col_mark_params = NewColMarkP}. + + + + + + + + + + +%%====================================================================== +%% Function: +%% +%% Return Value: +%% +%% Description: +%% +%% Parameters: +%%====================================================================== + + +get_btn_id(VirtualCol, HbtnsShown) -> + case lists:keysearch(VirtualCol, #hbtn.virtual_col, HbtnsShown) of + false -> + undefined; + {value, HbtnRec} -> + HbtnRec#hbtn.id + end. + + + + + + + + + +%%====================================================================== +%% Function: +%% +%% Return Value: +%% +%% Description: +%% +%% Parameters: +%%====================================================================== + + +set_sort_btn_color(undefined, SortCol, HbtnsShown) -> + case lists:keysearch(SortCol, #hbtn.virtual_col, HbtnsShown) of + false -> + undefined; + {value, HbtnRec} -> + BtnId = HbtnRec#hbtn.id, + gs:config(BtnId, [{bg, ?SORT_MARK_COLOR}]), + BtnId + end; +set_sort_btn_color(BtnId, undefined, _HbtnsShown) -> + gs:config(BtnId, [{bg, ?DEFAULT_BG_COLOR}]); +set_sort_btn_color(OldSortBtnId, SortCol, HbtnsShown) -> + case gs:read(OldSortBtnId, bg) of + SortCol -> + % Btn is already marked! + OldSortBtnId; + _OtherColor -> + % Unmark old btn, mark new btn, if visible. + gs:config(OldSortBtnId, [{bg, ?DEFAULT_BG_COLOR}]), + case lists:keysearch(SortCol, #hbtn.virtual_col, HbtnsShown) of + false -> + undefined; + {value, HbtnRec} -> + BtnId = HbtnRec#hbtn.id, + gs:config(BtnId, [{bg, ?SORT_MARK_COLOR}]), + BtnId + end + end. + + + + + + + + + +%%====================================================================== +%% Function: +%% +%% Return Value: +%% +%% Description: +%% +%% Parameters: +%%====================================================================== + + +update_vbtns(N, NofRowsShown, _VirtualRowNo, + _Vbtns, _Colors, _BlinkEnabled, _BlinkList) when N > NofRowsShown -> + done; +update_vbtns(_N, _NofRowsShown, _VirtualRowNo, [], [], _BlinkEnabled, _BlinkList) -> + done; +update_vbtns(_N, _NofRowsShown, _VirtualRowNo, [], _Colors, _BlinkEnabled, _BlinkList) -> + % Right now we don't bother with dynamically creating row buttons: + % we ought too know in advance the maximum number of rows that can + % be visible. + io:format("Configuration error: too few rows in grid.~n"), + done; +update_vbtns(N, NofRowsShown, + VirtualRowNo, [VbtnRec | VT], [], BlinkEnabled, BlinkList) -> + VbtnId = VbtnRec#vbtn.id, + gs:config(VbtnId, [{bg, ?DEFAULT_BG_COLOR}, + {fg, ?BLACK}, + {label, {text, integer_to_list(VirtualRowNo)}}, + {data, {vbtn, N, VirtualRowNo}} % Real row + virtual row + ]), + update_vbtns(N + 1, NofRowsShown, VirtualRowNo + 1,VT, [], BlinkEnabled, + BlinkList); +update_vbtns(N, NofRowsShown, + VirtualRowNo, [VbtnRec | VT], [Color | CT], true, BlinkList) -> + VbtnId = VbtnRec#vbtn.id, + {Text, TextColor} = get_vbtn_text_and_textcolor(Color, VirtualRowNo), + case lists:member(Color, BlinkList) of + true -> + gs:config(VbtnId, [{bg, Color}, + {fg, TextColor}, + {label, {text, Text}}, + {data, {vbtn, N, VirtualRowNo}}, % Real + virtual row + flash + ]); + false -> + gs:config(VbtnId, [{bg, Color}, + {fg, TextColor}, + {label, {text, Text}}, + {data, {vbtn, N, VirtualRowNo}} % Real + virtual row + ]) + end, + update_vbtns(N + 1, NofRowsShown, VirtualRowNo + 1, VT, CT, true, BlinkList); +update_vbtns(N, NofRowsShown, + VirtualRowNo, [VbtnRec | VT], [Color | CT], false, BlinkList) -> + VbtnId = VbtnRec#vbtn.id, + {Text, TextColor} = get_vbtn_text_and_textcolor(Color, VirtualRowNo), + gs:config(VbtnId, [{bg, Color}, + {fg, TextColor}, + {label, {text, Text}}, + {data, {vbtn, N, VirtualRowNo}} % Real row + virtual row + ]), + update_vbtns(N + 1, NofRowsShown, VirtualRowNo + 1, VT, CT, false, BlinkList). + + + + + + + + + + +%%====================================================================== +%% Function: +%% +%% Return Value: +%% +%% Description: +%% +%% Parameters: +%%====================================================================== + + +get_vbtn_text_and_textcolor(?BLACK, N) -> + {integer_to_list(N), ?WHITE}; +get_vbtn_text_and_textcolor(?RED1, N) -> + {integer_to_list(N), ?BLACK}; +get_vbtn_text_and_textcolor(?RED2, N) -> + {integer_to_list(N), ?BLACK}; +get_vbtn_text_and_textcolor(?RED3, N) -> + {integer_to_list(N), ?BLACK}; +get_vbtn_text_and_textcolor(?RED4, N) -> + {integer_to_list(N), ?BLACK}; +get_vbtn_text_and_textcolor(?RED5, N) -> + {integer_to_list(N), ?BLACK}; +get_vbtn_text_and_textcolor(?GREEN1, N) -> + {integer_to_list(N), ?BLACK}; +get_vbtn_text_and_textcolor(?GREEN2, N) -> + {integer_to_list(N), ?BLACK}; +get_vbtn_text_and_textcolor(?GREEN3, N) -> + {integer_to_list(N), ?BLACK}; +get_vbtn_text_and_textcolor(?GREEN4, N) -> + {integer_to_list(N), ?BLACK}; +get_vbtn_text_and_textcolor(?GREEN5, N) -> + {integer_to_list(N), ?BLACK}; +get_vbtn_text_and_textcolor(_AnyOtherColor, N) -> + {integer_to_list(N), ?BLACK}. + + + + + + + + + +%%====================================================================== +%% Function: +%% +%% Return Value: +%% +%% Description: +%% +%% Parameters: +%%====================================================================== + + +create_vbtns(ParentId, Ypos, NofRows, RowHeight, VbtnW, HbtnH) -> + create_vbtns(1, NofRows, RowHeight, ParentId, VbtnW, Ypos + HbtnH, []). + + + + + + + + +%%====================================================================== +%% Function: +%% +%% Return Value: +%% +%% Description: +%% +%% Parameters: +%%====================================================================== + + +create_vbtns(N, NofRows, _RowHeight, _ParId, _VbtnW, _Ypos, VAcc) when N > NofRows -> + lists:reverse(VAcc); +create_vbtns(N, NofRows, RowHeight, ParId, VbtnW, Ypos, VAcc) -> + VHeight = RowHeight + 1, + VInfo = create_one_vbtn(ParId, VHeight, VbtnW, Ypos, N), + create_vbtns(N + 1, NofRows, RowHeight, ParId, VbtnW, Ypos + VHeight, + [VInfo | VAcc]). + + + + + + + +%%====================================================================== +%% Function: +%% +%% Return Value: +%% +%% Description: +%% +%% Parameters: +%%====================================================================== + + +create_one_vbtn(ParentId, Height, VbtnW, Ypos, N) -> + Id = gs:button(ParentId, [{width, VbtnW}, + {height, Height}, + {x, 0}, + {y, Ypos}, + {font, ?BTN_FONT}, + {bg, ?DEFAULT_BG_COLOR}, + {align, center}, + {label, {text,integer_to_list(N)}}, + {data, {vbtn, N, N}} % Real row + virtual row + ]), + #vbtn{virtual_row = N, + real_row = N, + id = Id, + height = Height, + ypos = Ypos}. + + + + + + + + + +%%====================================================================== +%% Function: +%% +%% Return Value: +%% +%% Description: +%% +%% Parameters: +%%====================================================================== + + +update_hbtns([], _HBtnsShown, + _ResBtns, _VirtualColNo, _FrId, _Ypos, _HbtnH, _ResBtnW, _VbtnW) -> + {[], []}; +update_hbtns(ColsShown, HBtns, + ResBtns, VirtualColNo, FrId, Ypos, HbtnH, ResBtnW, VbtnW) -> + update_hbtns(1, ColsShown, HBtns, ResBtns, HbtnH, ResBtnW, VbtnW, + VirtualColNo, FrId, 0, Ypos, [], []). + + + + + + + + +%%====================================================================== +%% Function: +%% +%% Return Value: +%% +%% Description: +%% +%% Parameters: +%%====================================================================== + + +update_hbtns(_N, [], + [], [], _HbtnH, _ResBtnW, _VbtnW, _ColNo, _FrId, _Xpos, _Ypos, HAcc, RAcc) -> + {lists:reverse(HAcc), lists:reverse(RAcc)}; + +update_hbtns(N, [], [HInfo | HT], [RInfo | RT], + HbtnH, ResBtnW, VbtnW, ColNo, FrId, Xpos, Ypos, HAcc, RAcc) -> + % If too many buttons, i.e., if the ColsShown list + % has become empty. + gs:destroy(HInfo#hbtn.id), + gs:destroy(RInfo#resbtn.id), + update_hbtns(N, [], HT, RT, HbtnH, ResBtnW, VbtnW, ColNo, FrId, + Xpos, Ypos, HAcc, RAcc); + +update_hbtns(1, [ColW | T], [], [], + HbtnH, ResBtnW, VbtnW, ColNo, FrId, _Xpos, Ypos, HAcc, RAcc) -> + % The first button has to be bigger than the others. + {HInfo, RInfo} = create_one_hbtn_and_resbtn(FrId, ColW - 2, + HbtnH, VbtnW - 1, + Ypos, ResBtnW, 1, ColNo), + update_hbtns(2, T, [], [], HbtnH, ResBtnW, VbtnW, ColNo + 1, + FrId, VbtnW - 1 + ColW - 2 + ResBtnW, Ypos, [HInfo | HAcc], + [RInfo | RAcc]); + +update_hbtns(N, [ColW | T], [], [], + HbtnH, ResBtnW, VbtnW, ColNo, FrId, Xpos, Ypos, HAcc, RAcc) -> + {HInfo, RInfo} = create_one_hbtn_and_resbtn(FrId, ColW - 4, + HbtnH, Xpos, + Ypos, ResBtnW, N, ColNo), + update_hbtns(N + 1, T, [], [], HbtnH, ResBtnW, VbtnW, ColNo + 1, + FrId, Xpos + ColW - 4 + ResBtnW, Ypos, [HInfo | HAcc], + [RInfo | RAcc]); + +update_hbtns(1, [ColW | T], [HInfo | HT], [RInfo | RT], + HbtnH, ResBtnW, VbtnW, ColNo, FrId, _Xpos, Ypos, HAcc, RAcc) -> + {NewHInfo, NewRInfo} = config_one_hbtn_and_resbtn(HInfo, RInfo, + ColW - 2, + VbtnW - 1, + 1, ColNo), + update_hbtns(2, T, HT, RT, HbtnH, ResBtnW, VbtnW, ColNo + 1, + FrId, VbtnW - 1 + ColW - 2 + ResBtnW, Ypos, + [NewHInfo | HAcc], [NewRInfo | RAcc]); + +update_hbtns(N, [ColW | T], [HInfo | HT], [RInfo | RT], + HbtnH, ResBtnW, VbtnW, ColNo, FrId, Xpos, Ypos, HAcc, RAcc) -> + {NewHInfo, NewRInfo} = config_one_hbtn_and_resbtn(HInfo, RInfo, + ColW - 4, + Xpos, N, + ColNo), + update_hbtns(N + 1, T, HT, RT, HbtnH, ResBtnW, VbtnW, ColNo + 1, + FrId, Xpos + ColW - 4 + ResBtnW, Ypos, [NewHInfo | HAcc], + [NewRInfo | RAcc]). + + + + + + + + + + + + +%%====================================================================== +%% Function: +%% +%% Return Value: +%% +%% Description: +%% +%% Parameters: +%%====================================================================== + + +create_one_hbtn_and_resbtn(ParId, HWidth, HHeight, HXpos, Ypos, RWidth, N, ColNo) -> + HId = gs:button(ParId, [{width, HWidth}, + {height, HHeight}, + {x, HXpos}, + {y, Ypos}, + {font, ?BTN_FONT}, + {bg, ?DEFAULT_BG_COLOR}, + {data, {hbtn, N, ColNo}}, + {label, {text, integer_to_list(ColNo)}} + ]), + RId = gs:button(ParId, [{width, RWidth}, + {height, HHeight}, + {x, HXpos + HWidth}, + {y, Ypos}, + {cursor, resize}, + {buttonpress, true}, + {buttonrelease, true}, + {data, {resbtn, N, ColNo, (HXpos + HWidth + RWidth div 2)}}, + {bg, ?BLACK} + ]), + HInfo = #hbtn{virtual_col = ColNo, + real_col = N, + id = HId, + width = HWidth, + xpos = HXpos}, + RInfo = #resbtn{virtual_col = ColNo, + real_col = N, + id = RId, + width = RWidth, + xpos = HXpos + HWidth}, + {HInfo, RInfo}. + + + + + + + + + + + + +%%====================================================================== +%% Function: +%% +%% Return Value: +%% +%% Description: +%% +%% Parameters: +%%====================================================================== + + +config_one_hbtn_and_resbtn(HInfo, RInfo, HWidth, HXpos, N, ColNo) -> + gs:config(HInfo#hbtn.id, [{width, HWidth}, + {x, HXpos}, + {data, {hbtn, N, ColNo}}, + {label, {text, integer_to_list(ColNo)}} + ]), + gs:config(RInfo#resbtn.id, [{x, HXpos + HWidth}, + {data, {resbtn, N, ColNo, + (HXpos + HWidth + RInfo#resbtn.width div 2)}} + ]), + NewHInfo = HInfo#hbtn{virtual_col = ColNo, + width = HWidth, + xpos = HXpos}, + NewRInfo = RInfo#resbtn{virtual_col = ColNo, + xpos = HXpos + HWidth}, + {NewHInfo, NewRInfo}. + + + + + + + + + +%%====================================================================== +%% Function: +%% +%% Return Value: +%% +%% Description: +%% +%% Parameters: +%%====================================================================== + + +update_keys([], [], _FirstCol, _LastCol, _HBtns, _ParentId, KeyIdsAcc) -> + lists:reverse(KeyIdsAcc); + +update_keys([], [KeyId | IdT], FirstCol, LastCol, HBtns, ParentId, KeyIdsAcc) -> + gs:config(KeyId, [{x, 1200}]), + update_keys([], IdT, FirstCol, LastCol, HBtns, ParentId, + [KeyId | KeyIdsAcc]); + +update_keys([KeyNo | KT], [], FirstCol, LastCol, + HBtns,ParentId, KeyIdsAcc) when KeyNo >= FirstCol, KeyNo =< LastCol -> + {_Width, Xpos} = get_keywidth_and_pos(KeyNo, FirstCol, HBtns), + NewKeyId = create_key(ParentId, Xpos, 1), + update_keys(KT, [], FirstCol, LastCol, HBtns, ParentId, + [NewKeyId | KeyIdsAcc]); + +update_keys([_KeyNo | KT], [], FirstCol, LastCol, HBtns, ParentId, KeyIdsAcc) -> + update_keys(KT, [], FirstCol, LastCol, HBtns, ParentId, + KeyIdsAcc); + +update_keys([KeyNo | KT], [KeyId | IdT], FirstCol, LastCol, + HBtns, ParentId, KeyIdsAcc) when KeyNo >= FirstCol, KeyNo =< LastCol -> + {Width, Xpos} = get_keywidth_and_pos(KeyNo, FirstCol, HBtns), + gs:config(KeyId, [{width, Width}, + {x, Xpos} + ]), + update_keys(KT, IdT, FirstCol, LastCol, HBtns, ParentId, + [KeyId | KeyIdsAcc]); + +update_keys([_KeyNo | KT], + [KeyId | IdT], FirstCol, LastCol, HBtns, ParentId, KeyIdsAcc) -> + update_keys(KT, [KeyId | IdT], FirstCol, LastCol, HBtns, ParentId, + KeyIdsAcc). + + + + + + + + + +%%====================================================================== +%% Function: +%% +%% Return Value: +%% +%% Description: +%% +%% Parameters: +%%====================================================================== + + +get_keywidth_and_pos(VirtualCol, FirstCol, HBtns) -> + RealColNo = VirtualCol - FirstCol + 1, + HBtnR = lists:nth(RealColNo, HBtns), + #hbtn{width = Width, + xpos = Xpos} = HBtnR, + KeyWidth = 10, + % Compute the x position for the key! + KeyXpos = (Xpos + (Width div 2) - (KeyWidth div 2)), + {KeyWidth, KeyXpos}. + + + + + + + +%%====================================================================== +%% Function: +%% +%% Return Value: +%% +%% Description: +%% +%% Parameters: +%%====================================================================== + + +create_key(ParentId, Xpos, Ypos) -> + PicDir = code:priv_dir(tv), + C = gs:canvas(ParentId, [{width, 10}, + {height, 18}, + {x, Xpos}, + {y, Ypos}, + {bg, ?DEFAULT_BG_COLOR} + ]), + gs:create(image, C, [{bitmap, PicDir ++ "/key.xbm"}]), + C. + + + + + + + + + + + + + + + + + + + + + diff --git a/lib/tv/src/tv_pb_int_def.hrl b/lib/tv/src/tv_pb_int_def.hrl new file mode 100644 index 0000000000..0fe9df193a --- /dev/null +++ b/lib/tv/src/tv_pb_int_def.hrl @@ -0,0 +1,99 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1997-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% + +-define(WHITE, {255,255,255}). + +-define(DEFAULT_BG_COLOR, {217,217,217}). + +-define(COL_MARK_COLOR, {0, 0, 0}). +-define(SORT_MARK_COLOR, {255,215,0}). + +-define(BLINK_COLOR1, {255,0,0}). +-define(BLINK_COLOR2, {0,255,0}). +-define(BLINK_COLOR3, {0,0,0}). +-define(BTN_FONT, {courier,12}). + + + + +-record(col_mark_params, {col_btn_id, + virtual_col_marked, + sort_btn_id, + virtual_sort_col + }). + + + +-record(row_mark_params, {virtual_row_marked, + real_row_marked + }). + + + + +-record(process_variables, {parent_pid, + grid_frame_id, + grid_frame_width, + grid_frame_height, + ypos, + hbtn_height, + vbtn_width, + resbtn_width, + first_col_shown, + hbtns_shown = [], + vbtns_shown = [], + resbtns_shown = [], + cols_shown = [], + key_numbers = [], + key_ids = [], + blink_color_list = [?BLINK_COLOR1, + ?BLINK_COLOR2, + ?BLINK_COLOR3], + col_mark_params = #col_mark_params{}, + row_mark_params = #row_mark_params{} + }). + + + +-record(hbtn, {virtual_col, + real_col, + id, + width, + xpos + }). + + + +-record(resbtn, {virtual_col, + real_col, + id, + width, + xpos + }). + + + +-record(vbtn, {virtual_row, + real_row, + id, + height, + ypos + }). + + + diff --git a/lib/tv/src/tv_pc.erl b/lib/tv/src/tv_pc.erl new file mode 100644 index 0000000000..50214fe06a --- /dev/null +++ b/lib/tv/src/tv_pc.erl @@ -0,0 +1,794 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1997-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% +%%%********************************************************************* +%%% +%%% Description: pc part of the table tool, i.e., the process +%%% controlling all other processes, and managing +%%% the actions to take. +%%% +%%%********************************************************************* + + +-module(tv_pc). + + + +-export([pc/7, + send_data/2 + ]). + + + +-include("tv_int_def.hrl"). +-include("tv_int_msg.hrl"). +-include("tv_pc_int_def.hrl"). + + + + +%%%********************************************************************* +%%% EXTERNAL FUNCTIONS +%%%********************************************************************* + + + +%%====================================================================== +%% Function: pc. +%% +%% Return Value: None. +%% +%% Description: Process controlling the processes 'pd', 'pw', 'dbs' and 'etsread'. +%% After necessary initialisations, an eternal loop is +%% entered, where window created messages are received and +%% handled, as well as user input. +%% +%% Parameters: +%%====================================================================== + + +pc(Master, Node, LocalNode, TableId, KindOfTable, TableName, ErrMsgMode) -> + process_flag(trap_exit, true), + put(error_msg_mode, ErrMsgMode), + ProcVars = prepare_and_open_table(Node, LocalNode, TableId, KindOfTable, TableName, + false, #process_variables{parent_pid=Master}), + loop(ProcVars). + + + + + + + +%%%******************************************************************** +%%% INTERNAL FUNCTIONS +%%%******************************************************************** + + + + + +prepare_and_open_table(Node, LocalNode, TabId, TabType, TabName, Raise, ProcVars) -> + IpPid = spawn(tv_ip, ip, [self()]), + show_progress(IpPid, 5, "Initializing graphics..."), + + TmpProcVars = start_procs(IpPid, ProcVars), + + show_progress(IpPid, 5, "Loading table..."), + NewProcVars = ?MENU_FUNC_FILE:open_table(Node, LocalNode, TabId, TabType, TabName, + Raise, TmpProcVars), + + IpPid ! #ip_quit{sender = self()}, + % Now make window visible! + WinP = NewProcVars#process_variables.window_params, + gs:config(WinP#window_params.window_id, [{map, true}]), + NewProcVars. + + + + + +start_procs(IpPid, ProcVars) -> + ErrorMsgMode = get(error_msg_mode), + PwPid = spawn_link(tv_pw, pw, [self()]), + PdPid = spawn_link(tv_pd, pd, [self(), ErrorMsgMode]), + DbsPid = spawn_link(tv_db, dbs, [self(), ErrorMsgMode]), + EtsreadPid = spawn_link(tv_etsread, etsread, [self(), ErrorMsgMode]), + + show_progress(IpPid, 5, "Initializing graphics..."), + NewWinP = init_pw(PwPid, ProcVars), + + show_progress(IpPid, 5, "Initializing graphics..."), + init_pd(PdPid, NewWinP), + ProcVars#process_variables{pw_pid = PwPid, + pd_pid = PdPid, + dbs_pid = DbsPid, + etsread_pid = EtsreadPid, + current_node = node(), %% Will be replaced, when table opened. + local_node = true, + window_params = NewWinP + }. + + + + + + + +%%====================================================================== +%% Function: +%% +%% Return Value: +%% +%% Description: +%% +%% Parameters: +%%====================================================================== + + +show_progress(IpPid, NofElements, Text) -> + IpPid ! #ip_update{sender = self(), + nof_elements_to_mark = NofElements, + text = Text + }. + + + + + + + +%%====================================================================== +%% Function: loop. +%% +%% Return Value: None. +%% +%% Description: Eternal (well, almost) loop, receiving messages and +%% handling them. +%% +%% Parameters: None. +%%====================================================================== + + +loop(ProcVars) -> + receive + Msg -> + case Msg of + + % Normal messages! + #dbs_subset{} -> + NewProcVars1 = send_data(Msg, ProcVars), + NewProcVars2 = check_time_to_poll_table(Msg, NewProcVars1), + loop(NewProcVars2); + + #pc_poll_table{} -> + TmpProcVars = check_node(ProcVars), + NewProcVars = ?MENU_FUNC_FILE:poll_table(TmpProcVars), + loop(NewProcVars); + + #pc_search_req{} -> + DbsPid = ProcVars#process_variables.dbs_pid, + DbsPid ! #dbs_search_req{sender=self()}, + loop(ProcVars); + + #pc_set_sorting_mode{} -> + set_sorting_mode(Msg, ProcVars), + loop(ProcVars); + + + #pc_data_req{element = Pos, nof_elements = Length} -> + DbsPid = ProcVars#process_variables.dbs_pid, + DbsPid ! #dbs_subset_req{sender = self(), + subset_pos = Pos, + subset_length = Length + }, + loop(ProcVars); + + + #pc_marked_row{row_no=RowNo, object=Obj, color=Color} -> + DbsPid = ProcVars#process_variables.dbs_pid, + DbsPid ! #dbs_marked_row{sender = self(), + row_no = RowNo + }, + NewProcVars = ProcVars#process_variables{marked_row = RowNo, + marked_object = Obj, + marked_color = Color}, + loop(NewProcVars); + + + #pc_menu_msg{} -> + Fcn = Msg#pc_menu_msg.data, + NewProcVars = ?MENU_FUNC_FILE:Fcn(ProcVars), + loop(NewProcVars); + + + #pd_updated_object{object=Obj,old_object=OldObj,old_color=Color,obj_no=ObjNo} -> + DbsPid = ProcVars#process_variables.dbs_pid, + DbsPid ! #dbs_updated_object{sender = self(), + object = Obj, + old_object = OldObj, + old_color = Color, + obj_no = ObjNo}, + loop(ProcVars); + + + #pd_new_object{object=Obj} -> + DbsPid = ProcVars#process_variables.dbs_pid, + DbsPid ! #dbs_new_object{sender = self(), + object = Obj}, + loop(ProcVars); + + + #pc_show_table_info{} -> + NewProcVars = ?MENU_FUNC_FILE:table_info(ProcVars), + loop(NewProcVars); + + #pc_win_conf{} -> + NewProcVars = ?GRAPH_FUNC_FILE:win_conf(Msg, ProcVars), + loop(NewProcVars); + + #pc_help{} -> + NewProcVars = ?MENU_FUNC_FILE:help_button(ProcVars), + loop(NewProcVars); + + #pc_dead_table{automatic_polling = AutoPoll} -> + WinP = ProcVars#process_variables.window_params, + WinId = WinP#window_params.window_id, + gs:config(WinId, [beep]), + case get(error_msg_mode) of + normal -> + tv_utils:notify(WinId, "TV Notification", + ["The table no longer exists!"]); + haiku -> + ErrMsg1 = ["A table that big?", + "It might be very useful.", + "But now it is gone."], + tv_utils:notify(WinId, "TV Notification", ErrMsg1) + end, + NewProcVars = + case AutoPoll of + true -> + gs:config(WinId, [beep]), + case get(error_msg_mode) of + normal -> + tv_utils:notify(WinId, "TV Notification", + ["The automatic polling is turned off!"]); + haiku -> + ErrMsg2 = ["Previously on", + "The polling is now idled.", + "That's the way it is."], + tv_utils:notify(WinId, "TV Notification", ErrMsg2) + end, + ProcVars#process_variables{poll_interval = infinity}; + false -> + ProcVars + end, + loop(NewProcVars); + + #pc_nodedown{automatic_polling = AutoPoll} -> + WinP = ProcVars#process_variables.window_params, + WinId = WinP#window_params.window_id, + gs:config(WinId, [beep]), + case get(error_msg_mode) of + normal -> + tv_utils:notify(WinId, "TV Notification", + ["The node is down, and the", + "table cannot be reached."]); + haiku -> + ErrMsg1 = ["With searching comes loss", + "And the presence of absence:", + "Node is down."], + tv_utils:notify(WinId, "TV Notification", ErrMsg1) + end, + NewProcVars = + case AutoPoll of + true -> + gs:config(WinId, [beep]), + case get(error_msg_mode) of + normal -> + tv_utils:notify(WinId, "TV Notification", + ["The automatic polling is turned off!"]); + haiku -> + ErrMsg = ["Previously on,", + "The polling is now idled.", + "That's the way it is."], + tv_utils:notify(WinId, "TV Notification", ErrMsg) + end, + ProcVars#process_variables{poll_interval = infinity}; + false -> + ProcVars + end, + loop(NewProcVars); + + + {pc_edit_object, _Sender} -> + NewProcVars = ?MENU_FUNC_FILE:insert_object(ProcVars), + loop(NewProcVars); + + + check_node -> + NewProcVars = check_node(ProcVars), + loop(NewProcVars); + + + raise -> + WinP = ProcVars#process_variables.window_params, + gs:config(WinP#window_params.window_id, [raise]), + loop(ProcVars); + + + {error_msg_mode, Mode} -> + ProcVars#process_variables.dbs_pid ! {error_msg_mode, Mode}, + ProcVars#process_variables.etsread_pid ! {error_msg_mode, Mode}, + ProcVars#process_variables.pd_pid ! {error_msg_mode, Mode}, + put(error_msg_mode, Mode), + loop(ProcVars); + + % Exit messages! + {'EXIT', Sender, Reason} -> + exit_signals({Sender, Reason}, ProcVars); + + + _Other -> + loop(ProcVars) + + end + end. + + + + + + +check_node(ProcVars) -> + #process_variables{pw_pid = PwPid, + current_node = OldCurrNode, + local_node = LocalNode, + table_id = TableId, + table_type = TableType, + table_name = TableName} = ProcVars, + + HomeNode = node(), + case net_adm:ping(OldCurrNode) of + pong -> + ProcVars; + pang when not LocalNode -> + ProcVars; + pang when LocalNode -> + %% XXX [siri] Will this ever happen? I thought local_node + %% indicated if current_node was the node where tv was + %% started. If so, we are pinging ourselves here, and + %% a pang can never happen?? + WinTitle = ?MENU_FUNC_FILE:get_window_title(TableType,HomeNode,TableId,TableName), + PwPid ! #pw_set_window_title{sender = self(), + win_title = WinTitle}, + ProcVars#process_variables{current_node = HomeNode} + end. + + + + + + + +send_data(Msg, ProcVars) -> + #process_variables{pd_pid = PdPid, + parent_pid = ParentPid, + table_id = Table, + table_type = Type, + current_node = Node} = ProcVars, + + ParentPid ! {tv_update_infowin, Table, Node, Type}, + + #dbs_subset{data = DbData, + subset_pos = ScalePos, + db_length = DbLength, + list_of_keys = ListOfKeys, + max_elem_size = MaxElemSize, + requested_row = ReqRowData} = Msg, + + Range = case ScalePos of + 0 -> + {0, 0}; + _Other -> + {1, DbLength} + end, + + PdPid ! #pc_data{sender = self(), + scale_pos = ScalePos, + scale_range = Range, + elementlist = DbData, + list_of_keys = ListOfKeys, + max_elem_size = MaxElemSize, + marked_row = ReqRowData + }, + + {MarkedObject, MarkedColor} = + case ReqRowData of + [] -> + {undefined, undefined}; + [Data] -> + Data + end, + ProcVars#process_variables{marked_object = MarkedObject, + marked_color = MarkedColor}. + + + + + + + + +%%====================================================================== +%% Function: +%% +%% Return Value: +%% +%% Description: +%% +%% Parameters: +%%====================================================================== + + +set_sorting_mode(Msg, ProcVars) -> + #pc_set_sorting_mode{sorting = Sorting, + reverse = Reverse, + sort_key_no = SortKeyNo} = Msg, + + DbsPid = ProcVars#process_variables.dbs_pid, + PdPid = ProcVars#process_variables.pd_pid, + PwPid = ProcVars#process_variables.pw_pid, + TableType = ProcVars#process_variables.table_type, + + NewSortKeyNo = + case SortKeyNo of + undefined -> + if + TableType =:= mnesia -> + 2; + true -> + 1 + end; + _Other -> + SortKeyNo + end, + + Menu = + case Sorting of + true -> + case Reverse of + true -> + sort_falling_order; + false -> + sort_rising_order + end; + false -> + no_sorting + end, + + PwPid ! #pw_select_menu{sender = self(), + menu = Menu}, + + DbsPid ! #dbs_sorting_mode{sender = self(), + sorting = Sorting, + reverse = Reverse, + sort_key_no = NewSortKeyNo + }, + + PdPid ! #pc_set_sorting_mode_cfm{sender = self(), + sort_key_no = NewSortKeyNo + }. + + + + + + + +%%====================================================================== +%% Function: init_pw. +%% +%% Return Value: Tuple containing the Pid of the pw process, and the id of +%% the window created by the pw process. +%% +%% Description: Starts the pw process, and orders it to create a window. +%% (The size of the window may be given as option.) +%% +%% Parameters: None. +%%====================================================================== + + + +init_pw(PwPid, ProcVars) -> + #process_variables{window_params = WinP} = ProcVars, + + % Now deblock pw, and order it to create a window! + PwPid ! #pw_deblock{sender = self(), + win_title = ?APPLICATION_NAME, + win_width = ?DEFAULT_WINDOW_WIDTH, + win_height = ?DEFAULT_WINDOW_HEIGHT, + min_win_width = ?DEFAULT_MIN_WINDOW_WIDTH, + min_win_height = ?DEFAULT_MIN_WINDOW_HEIGHT + }, + + + receive + #pw_deblock_cfm{win_id = WindowId} -> + ?MENU_FUNC_FILE:create_menus(PwPid), + + % Store the window id as well as the size of it. + WinP#window_params{window_id = WindowId, + window_width = ?DEFAULT_WINDOW_WIDTH, + window_height = ?DEFAULT_WINDOW_HEIGHT + } + + + after 180000 -> % A timeout of 1000 ms is too short, at least the first + % time the system is started! + exit(error) + end. + + + + + + + + + + +%%====================================================================== +%% Function: +%% +%% Return Value: +%% +%% Description: +%% +%% Parameters: +%%====================================================================== + + +init_pd(PdPid, WinP) -> + #window_params{window_id = WindowId, + window_width = WindowWidth, + window_height = WindowHeight} = WinP, + + % Now deblock pd, and order it to create a canvas and a scale! + PdPid ! #pd_deblock{sender = self(), + win = WindowId, + win_width = WindowWidth, + win_height = WindowHeight, + scale = true + }, + + receive + #pd_deblock_cfm{} -> + done + after 180000 -> + exit(error) + end. + + + + + + + + + + +%%====================================================================== +%% Function: exit_signals. +%% +%% Return Value: None. +%% +%% Description: Decides, given an error message, action to take, i.e., whether +%% operation shall procede, any process shall be restarted, or +%% the table tool terminated. +%% +%% Parameters: Exit_info: tuple containing sender of the error message, and the +%% reason. +%%====================================================================== + + +exit_signals(ExitInfo, ProcVars) -> + #process_variables{parent_pid = ParentPid, + pd_pid = PdPid, + pw_pid = PwPid, + dbs_pid = DbsPid, + etsread_pid = EtsreadPid, + table_id = TabId, + table_type = TabType, + table_name = TabName, + current_node = Node, + local_node = LocalNode + } = ProcVars, + + case ExitInfo of + {ParentPid, Reason} -> + exit(Reason); + + {PwPid, normal} -> + exit(normal); + + {PwPid, error} -> + io:format("Internal error... restarting. ~n"), + kill_procs(normal, [PdPid, EtsreadPid, DbsPid]), + NewProcVars = pc(ParentPid, Node, LocalNode, TabId, TabType, TabName, + get(error_msg_mode)), + loop(NewProcVars); + + {PdPid, _Reason} -> + io:format("Internal error... restarting. ~n"), + kill_procs(normal, [PwPid, EtsreadPid, DbsPid]), + NewProcVars = pc(ParentPid, Node, LocalNode, TabId, TabType, TabName, + get(error_msg_mode)), + loop(NewProcVars); + + {DbsPid, _Reason} -> + io:format("Internal error... restarting. ~n"), + kill_procs(normal, [PdPid, PwPid, EtsreadPid]), + NewProcVars = pc(ParentPid, Node, LocalNode, TabId, TabType, TabName, + get(error_msg_mode)), + loop(NewProcVars); + + {EtsreadPid, _Reason} -> + io:format("Internal error... restarting. ~n"), + kill_procs(normal, [PdPid, PwPid, DbsPid]), + NewProcVars = pc(ParentPid, Node, LocalNode, TabId, TabType, TabName, + get(error_msg_mode)), + loop(NewProcVars); + + {_Sender, _OtherReason} -> + loop(ProcVars) + end. + + + + + + + + + +%%====================================================================== +%% Function: +%% +%% Return Value: +%% +%% Description: +%% +%% Parameters: +%%====================================================================== + + +kill_procs(_Status, []) -> + done; +kill_procs(Status, [Pid | Tail]) -> + exit(Pid, Status), + kill_procs(Status, Tail). + + + + +%%====================================================================== +%% Function: +%% +%% Return Value: +%% +%% Description: +%% +%% Parameters: +%%====================================================================== + + +check_time_to_poll_table(Msg, ProcVars) -> + #dbs_subset{required_time_etsread = EtsreadTime, + required_time_dbs = DbsTime} = Msg, + + UserSetPollInterval = ProcVars#process_variables.poll_interval, + WinP = ProcVars#process_variables.window_params, + WinId = WinP#window_params.window_id, + + case too_short_pollinterval_chosen(UserSetPollInterval, EtsreadTime, DbsTime) of + true -> + EtsreadPid = ProcVars#process_variables.etsread_pid, + EtsreadPid ! #etsread_set_poll_interval{sender = self(), + interval = infinity}, + + TimeRequired = trunc(max_time_required(EtsreadTime, DbsTime) / 10 + 0.5) * 10 + 20, + + gs:config(WinId, [beep]), + case get(error_msg_mode) of + normal -> + tv_utils:notify(WinId, "TV Notification", + ["The current poll interval is too short!"]), + Str = "to " ++ lists:flatten(io_lib:write(TimeRequired)) ++ " seconds!", + tv_utils:notify(WinId, "TV Notification", ["Setting the poll interval", Str]); + haiku -> + ErrMsg = ["Being way too short", + "The interval of polling", + "Is simply increased."], + tv_utils:notify(WinId, "TV Notification", ErrMsg) + end, + clear_message_buffer(), + EtsreadPid ! #etsread_set_poll_interval{sender = self(), + interval = TimeRequired}, + + ProcVars#process_variables{poll_interval = TimeRequired}; + false -> + ProcVars + end. + + + + + + +clear_message_buffer() -> + receive + #dbs_subset{} -> + clear_message_buffer() + after 100 -> + done + end. + + + + + +max_time_required(T1, T2) when is_number(T1), is_number(T2) -> + if + T1 > T2 -> + T1; + true -> + T2 + end; +max_time_required(T1, _T2) when is_number(T1) -> + T1; +max_time_required(_T1, T2) -> + T2. + + + + + + + + +%%====================================================================== +%% Function: +%% +%% Return Value: +%% +%% Description: +%% +%% Parameters: +%%====================================================================== + + +too_short_pollinterval_chosen(infinity, _EtsreadTime, _DbsTime) -> + false; +too_short_pollinterval_chosen(undefined, _EtsreadTime, _DbsTime) -> + false; +too_short_pollinterval_chosen(PollInt, EtsreadTime, _DbsTime) when EtsreadTime >= PollInt, is_number(EtsreadTime) -> + true; +too_short_pollinterval_chosen(PollInt, _EtsreadTime, DbsTime) when DbsTime >= PollInt, is_number(DbsTime) -> + true; +too_short_pollinterval_chosen(_PollInt, _EtsreadTime, _DbsTime) -> + false. diff --git a/lib/tv/src/tv_pc_graph_ctrl.erl b/lib/tv/src/tv_pc_graph_ctrl.erl new file mode 100644 index 0000000000..3fc3ded565 --- /dev/null +++ b/lib/tv/src/tv_pc_graph_ctrl.erl @@ -0,0 +1,120 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1997-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% +-module(tv_pc_graph_ctrl). + + + +-export([create_menu/4, win_conf/2]). + + +-include("tv_int_msg.hrl"). +-include("tv_pc_int_def.hrl"). + + + + + + + + +%%%********************************************************************* +%%% EXTERNAL FUNCTIONS +%%%********************************************************************* + + + + +%%====================================================================== +%% Function: +%% +%% Return Value: +%% +%% Description: +%% +%% Parameters: +%%====================================================================== + + +create_menu(PwPid, MenuTitle, TitleAccPos, MenuList) -> + PwPid ! #pw_create_menu{sender = self(), + menutitle = MenuTitle, + title_acc_pos = TitleAccPos, + menulist = MenuList + }, + receive + #pw_create_menu_cfm{} -> + done + after 10000 -> + exit(error) + end. + + + + + + + + + +%%====================================================================== +%% Function: win_conf. +%% +%% Return Value: None. +%% +%% Description: Configures all objects in the window according to new coordinates. +%% +%% Parameters: +%%====================================================================== + + +win_conf(Msg, ProcVars) -> + #pc_win_conf{width = NewWidth, + height = NewHeight} = Msg, + + #process_variables{pd_pid = PdPid, + window_params = WinP} = ProcVars, + + #window_params{window_width = OldWindowWidth, + window_height = OldWindowHeight} = WinP, + + + case {NewWidth, NewHeight} of + {OldWindowWidth, OldWindowHeight} -> + ProcVars; + _Other -> + PdPid ! #pd_win_conf{sender = self(), + width = NewWidth, + height = NewHeight + }, + NewWinP = WinP#window_params{window_width = NewWidth, + window_height = NewHeight}, + + ProcVars#process_variables{window_params = NewWinP} + end. + + + + + + + + + + + + diff --git a/lib/tv/src/tv_pc_int_def.hrl b/lib/tv/src/tv_pc_int_def.hrl new file mode 100644 index 0000000000..22f8dcd5d8 --- /dev/null +++ b/lib/tv/src/tv_pc_int_def.hrl @@ -0,0 +1,62 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1997-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% +%%%********************************************************************* +%%% +%%% Description: Include file for the pc parts of the table tool. +%%% +%%%********************************************************************* + + +-define(HEAD_FILE, pc). +-define(GRAPH_FUNC_FILE, tv_pc_graph_ctrl). +-define(MENU_FUNC_FILE, tv_pc_menu_handling). + + + +-define(APPLICATION_NAME, "Table Visualizer"). +-define(DEFAULT_WINDOW_WIDTH, 750). +-define(DEFAULT_WINDOW_HEIGHT, 600). +-define(DEFAULT_MIN_WINDOW_WIDTH, 300). +-define(DEFAULT_MIN_WINDOW_HEIGHT, 250). + + +-record(window_params, {window_id, + window_width, + window_height + }). + + + +-record(process_variables, {parent_pid, + pw_pid, + pd_pid, + dbs_pid, + etsread_pid, + current_node, + local_node, + table_id = undefined, + table_type = ets, + table_name, + table_protection, + marked_row, + marked_object, + marked_color, + lists_as_strings = true, + poll_interval = infinity, % seconds or 'infinity' + window_params = #window_params{} + }). diff --git a/lib/tv/src/tv_pc_menu_handling.erl b/lib/tv/src/tv_pc_menu_handling.erl new file mode 100644 index 0000000000..16195bf91f --- /dev/null +++ b/lib/tv/src/tv_pc_menu_handling.erl @@ -0,0 +1,485 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1997-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% +%%%********************************************************************* +%%% +%%% Description: Part of pc handling the creation of menus, as well as +%%% treating the signals these menus results in, +%%% when chosen. +%%% +%%%********************************************************************* + + +-module(tv_pc_menu_handling). + + + +-export([create_menus/1, + exit_button/1, + insert_object/1, + delete_object/1, + search_object/1, + open_table/7, + set_poll_interval/1, + poll_table/1, + sort_rising_order/1, + sort_falling_order/1, + no_sorting/1, + lists_as_strings/1, + lists_as_lists/1, + table_info/1, + help_button/1, + otp_help_button/1, + get_window_title/4]). + + + + + +-include("tv_int_def.hrl"). +-include("tv_int_msg.hrl"). +-include("tv_pc_int_def.hrl"). + + + + + + + + +%%%********************************************************************* +%%% EXTERNAL FUNCTIONS +%%%********************************************************************* + + +%% Shortcuts currently used, in alphabetical order: +%% +%% c -> "Exit" +%% d -> "Delete Object" +%% f -> "Sort Falling Order" +%% h -> "Help" +%% i -> "Table Info" +%% n -> "No Sorting" +%% o -> "Edit Object" +%% p -> "Poll Table" +%% r -> "Sort Rising Order" +%% s -> "Search Object" +%% v -> "Set Poll Interval" +%% x -> "Exit" + + +create_menus(PwPid) -> + %% Due to a bug (or some other reason), only one of the radiobuttons belonging + %% to a specified group can be selected, even if different processes have created + %% the radiobuttons! This means that, if we have started more than one tv_main + %% process, selecting one radiobutton will affect the radiobuttons in the other + %% tv_main process(es)!!! Since this is a highly undesirable bahaviour, we have to + %% create unique group names (i.e., atoms). + %% (We need to group the radiobuttons, since otherwise all created by one process + %% belongs to the same group, which also is undesirable...) + SelfStr = pid_to_list(self()), + SortGroup = list_to_atom("sorting" ++ SelfStr), + ListGroup = list_to_atom("lists" ++ SelfStr), + + % Order pw to create the 'File' menu. + ?GRAPH_FUNC_FILE:create_menu(PwPid, + " File ", + 1, + [{" Table Info ", normal, table_info, 7, i}, + separator, + {" Close ", normal, exit_button, 1, c} + ]), + ?GRAPH_FUNC_FILE:create_menu(PwPid, + " Edit ", + 1, + [{" Edit Object... ", normal, insert_object, 1, o}, + {" Delete Object ", normal, delete_object, 1, d} + ]), + ?GRAPH_FUNC_FILE:create_menu(PwPid, + " View ", + 1, + [{" Lists as Lists ",{radio,false,ListGroup},lists_as_lists,10,no_char}, + {" Lists as Strings ",{radio,true,ListGroup},lists_as_strings,10,no_char} + ]), + % Order pw to create the 'Options' menu. + ?GRAPH_FUNC_FILE:create_menu(PwPid, + " Options ", + 1, + [{" Poll Table ", normal, poll_table, 1, p}, + {" Poll Interval... ",normal,set_poll_interval,6,no_char}, + separator, + {" Search Object ", normal, search_object, 1, s}, + separator, + {" Sort Ascending Order ",{radio,false,SortGroup},sort_rising_order,6,no_char}, + {" Sort Descending Order ",{radio,false,SortGroup},sort_falling_order,6,no_char}, + {" No Sorting ",{radio,true,SortGroup},no_sorting,1,no_char} + ]). + + + + + +exit_button(_ProcVars) -> + exit(normal). + + + +help_button(ProcVars) -> + WinP = ProcVars#process_variables.window_params, + HelpFile = filename:join([code:lib_dir(tv), "doc", "html", "index.html"]), + tool_utils:open_help(WinP#window_params.window_id, HelpFile), + ProcVars. + + + + +otp_help_button(ProcVars) -> + WinP = ProcVars#process_variables.window_params, + IndexFile = filename:join([code:root_dir(), "doc", "index.html"]), + + tool_utils:open_help(WinP#window_params.window_id, IndexFile), + ProcVars. + + + + +table_info(ProcVars) -> + #process_variables{table_id = TableId, + current_node = Node, + local_node = LocalNode, + table_type = Type, + parent_pid = ParentPid} = ProcVars, + + case TableId of + undefined -> + done; + _OtherValue -> + ParentPid ! {tv_start_infowin, TableId, Node, LocalNode, Type} + end, + ProcVars. + + + +sort_rising_order(ProcVars) -> + request_sort_settings(ProcVars#process_variables.pd_pid, true, false), + ProcVars. + + +sort_falling_order(ProcVars) -> + request_sort_settings(ProcVars#process_variables.pd_pid, true, true), + ProcVars. + + +no_sorting(ProcVars) -> + request_sort_settings(ProcVars#process_variables.pd_pid, false, false), + ProcVars. + + +set_poll_interval(ProcVars) -> + #process_variables{etsread_pid = EtsreadPid, + poll_interval = PollInterval} = ProcVars, + + case tv_poll_dialog:start(PollInterval) of + cancel -> + ProcVars; + NewPollInterval -> + EtsreadPid ! #etsread_set_poll_interval{sender = self(), + interval = NewPollInterval}, + ProcVars#process_variables{poll_interval = NewPollInterval} + end. + + + +poll_table(ProcVars) -> + EtsreadPid = ProcVars#process_variables.etsread_pid, + EtsreadPid ! #etsread_poll_table{sender = self()}, + ProcVars. + + +search_object(ProcVars) -> + DbsPid = ProcVars#process_variables.dbs_pid, + DbsPid ! #dbs_search_req{sender=self()}, + ProcVars. + + + +lists_as_strings(ProcVars) -> + PdPid = ProcVars#process_variables.pd_pid, + PdPid ! #pc_list_info{sender=self(), lists_as_strings=true}, + DbsPid = ProcVars#process_variables.dbs_pid, + DbsPid ! #pc_list_info{sender=self(), lists_as_strings=true}, + ProcVars#process_variables{lists_as_strings=true}. + + + + +lists_as_lists(ProcVars) -> + PdPid = ProcVars#process_variables.pd_pid, + PdPid ! #pc_list_info{sender=self(), lists_as_strings=false}, + DbsPid = ProcVars#process_variables.dbs_pid, + DbsPid ! #pc_list_info{sender=self(), lists_as_strings=false}, + ProcVars#process_variables{lists_as_strings=false}. + + + + + + +insert_object(ProcVars) -> + #process_variables{pd_pid = PdPid, + current_node = Node, + local_node = LocalNode, + table_type = TabType, + table_name = TabName, + table_protection = Protection, + window_params = WinP} = ProcVars, + + case Protection of + public -> + case TabType of + mnesia -> + case catch tv_mnesia_rpc:table_info(Node, LocalNode, TabName, attributes) of + nodedown -> + handle_error(nodedown); + no_table -> + handle_error(nodedown); + mnesia_not_started -> + handle_error(mnesia_not_started); + {unexpected_error,Reason} -> + handle_error({unexpected_error,Reason}); + AttrList -> + PdPid ! #pd_rec_edit{sender = self(), + attributes = AttrList + } + end; + ets -> + PdPid ! #pd_rec_edit{sender = self(), + attributes = [tuple] + } + end; + _OtherProtection -> + WinId = WinP#window_params.window_id, + gs:config(WinId, [beep]), + ErrMsg = + case get(error_msg_mode) of + normal -> + ["The table is protected and", + " cannot be edited."]; + haiku -> + ["The table you see", + "Is cunningly protected:", + "You can only watch."] + end, + tv_utils:notify(WinId, "TV Notification", ErrMsg) + end, + ProcVars. + + + + + + +delete_object(ProcVars) -> + #process_variables{dbs_pid = DbsPid, + table_protection = Protection, + marked_row = MarkedRow, + marked_object = MarkedObject, + marked_color = MarkedColor, + window_params = WinP} = ProcVars, + + case MarkedRow of + undefined -> + done; + _AnyRow -> + case Protection of + public -> + DbsPid ! #dbs_delete_object{sender = self(), + object = MarkedObject, + color = MarkedColor, + obj_no = MarkedRow}; + _OtherProtection -> + WinId = WinP#window_params.window_id, + gs:config(WinId, [beep]), + ErrMsg = + case get(error_msg_mode) of + normal -> + ["The table is protected and", + " cannot be edited."]; + haiku -> + ["The table you see", + "Is cunningly protected:", + "You can only watch."] + end, + tv_utils:notify(WinId, "TV Notification", ErrMsg) + end + end, + ProcVars. + + + + + + +open_table(CurrNode, LocalNode, TableId, TableType, TableName, Raise, ProcVars) -> + #process_variables{dbs_pid = DbsPid, + etsread_pid = EtsreadPid, + pw_pid = PwPid, + pd_pid = PdPid, + poll_interval = PollInterval, + window_params = WinP} = ProcVars, + + case Raise of + true -> + gs:config(WinP#window_params.window_id, [raise]); + false -> + done + end, + + {Type, KeyPos, Protection} = init_etsread(EtsreadPid, DbsPid, CurrNode, LocalNode, TableId, + TableType, PollInterval), + WinTitle = get_window_title(TableType, CurrNode, TableId, TableName), + PwPid ! #pw_set_window_title{sender = self(), + win_title = WinTitle}, + Writable = + case Protection of + public -> + true; + _Other -> + false + end, + RecordName = + case TableType of + mnesia -> + tv_mnesia_rpc:table_info(CurrNode, LocalNode, TableId, record_name); + ets -> + undefined + end, + PdPid ! #pd_new_table{sender = self(), + table_type = TableType, + table_name = TableName, + record_name = RecordName, + writable = Writable}, + init_dbs(DbsPid, Type, KeyPos, EtsreadPid), + ProcVars#process_variables{current_node = CurrNode, + local_node = LocalNode, + table_id = TableId, + table_type = TableType, + table_name = TableName, + table_protection = Protection}. + + + + + + +get_window_title(ets, Node, TableId, TableName) -> + NameStr = lists:flatten(io_lib:write(TableName)), + TableStr = case TableId of + {TableName, _Pid} -> + NameStr; + TableName -> + NameStr; + _Other -> + lists:flatten(io_lib:write(TableId)) ++ " (" ++ NameStr ++ ")" + end, + + WinTitleSuffix = " Node: " ++ atom_to_list(Node), + "ETS: " ++ TableStr ++ WinTitleSuffix; +get_window_title(mnesia, Node, _TableId, TableName) -> + TableNameStr = lists:flatten(io_lib:write(TableName)), + WinTitleSuffix = " Node: " ++ atom_to_list(Node), + "Mnesia: " ++ TableNameStr ++ WinTitleSuffix. + + + + +%%%********************************************************************* +%%% INTERNAL FUNCTIONS +%%%********************************************************************* + + + +init_etsread(EtsreadPid, DbsPid, Node, LocalNode, TableId, TableType, PollInterval) -> + EtsreadPid ! #etsread_deblock{sender = self(), + dbs_pid = DbsPid, + node = Node, + local_node = LocalNode, + table_id = TableId, + table_type = TableType, + poll_interval = PollInterval + }, + receive + #etsread_deblock_cfm{type=Type, keypos=KeyPos, protection=Protection} -> + {Type, KeyPos, Protection} + after 10000 -> + exit(error) + end. + + + + +init_dbs(DbsPid, Type, KeyPos, EtsreadPid) -> + DbsPid ! #dbs_deblock{sender = self(), + etsread_pid = EtsreadPid, + type = Type, + keypos = KeyPos, + sublist_length = ?ITEMS_TO_DISPLAY + }, + receive + #dbs_deblock_cfm{} -> + done + after 10000 -> + exit(error) + end. + + + + + + +request_sort_settings(PdPid, Sorting, Reverse) -> + PdPid ! #pd_get_sort_settings{sender = self(), + sorting = Sorting, + reverse = Reverse + }. + + + + + + +handle_error(mnesia_not_started) -> + gs:window(errorwin, gs:start(), []), + gs:config(errorwin, [beep]), + case get(error_msg_mode) of + normal -> + tv_utils:notify(errorwin, "TV Notification", ["Mnesia not started!"]); + haiku -> + tv_utils:notify(errorwin, "TV Notification", ["Mnesia is stopped.", + "We wish to reach all data", + "But we never will."]) + end, + gs:destroy(errorwin); +handle_error(nodedown) -> + done; %% Main process handles this! +handle_error({unexpected_error,Cause}) -> + gs:window(errorwin, gs:start(), []), + io:format("Unexpected error: ~p~n", [Cause]), + gs:config(errorwin, [beep]), + gs:destroy(errorwin). + + diff --git a/lib/tv/src/tv_pd.erl b/lib/tv/src/tv_pd.erl new file mode 100644 index 0000000000..ea14bf67b1 --- /dev/null +++ b/lib/tv/src/tv_pd.erl @@ -0,0 +1,1122 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1997-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% +%%%********************************************************************* +%%% +%%% Description: Code for pd, i.e., the data displaying part of the table +%%% tool. +%%% +%%%********************************************************************* + + +-module(tv_pd). + + + +-export([pd/2]). + + + + +-include("tv_int_def.hrl"). +-include("tv_int_msg.hrl"). +-include("tv_pd_int_def.hrl"). +-include("tv_pd_int_msg.hrl"). + + + + + +%%%********************************************************************* +%%% EXTERNAL FUNCTIONS +%%%********************************************************************* + + + + +%%====================================================================== +%% Function: pd. +%% +%% Return Value: None. +%% +%% Description: Process controlling the display part of the window, +%% i.e., showing diagrams and handling the scale used for scrolling. +%% +%% Parameters: None. +%%====================================================================== + + +pd(Master, ErrMsgMode) -> + process_flag(trap_exit, true), + put(error_msg_mode, ErrMsgMode), + PgPid = spawn_link(tv_pg, pg, [self()]), + PbPid = spawn_link(tv_pb, pb, [self()]), + + ProcVars = #process_variables{master_pid = Master, + pg_pid = PgPid, + pb_pid = PbPid}, + blocked(ProcVars). + + + + + + + +%%%******************************************************************** +%%% INTERNAL FUNCTIONS +%%%******************************************************************** + + + + + +%%====================================================================== +%% Function: blocked. +%% +%% Return Value: None. +%% +%% Description: When started or explicitly blocked, pd enters this state, +%% where nothing is performed until the module explicitly is +%% deblocked. +%% +%% Parameters: +%%====================================================================== + + +blocked(ProcVars) -> + receive + Msg -> + case Msg of + + #pd_deblock{} -> + deblock(Msg, ProcVars); + + + {error_msg_mode, Mode} -> + put(error_msg_mode, Mode), + blocked(ProcVars); + + + _Other -> + blocked(ProcVars) + end + end. + + + + + + + + + +%%====================================================================== +%% Function: deblock. +%% +%% Return Value: None. +%% +%% Description: When deblocked, a canvas and scale shall be created according to +%% specification received in pd_deblock message. +%% +%% Parameters: Rec: received pd_deblock message. +%%====================================================================== + + + +deblock(Msg, ProcVars) -> + #pd_deblock{win = WindowId, + win_width = WindowWidth, + win_height = WindowHeight} = Msg, + + NewProcVars = ?DISP_FUNC_FILE:init_display(WindowId, WindowWidth, WindowHeight, + ProcVars), + receive + + #pg_ready{} -> + Sender = Msg#pd_deblock.sender, + Sender ! #pd_deblock_cfm{sender = self()}, + deblocked_loop(NewProcVars) + + end. + + + + + + + + +%%====================================================================== +%% Function: deblocked_loop. +%% +%% Return Value: None. +%% +%% Description: Eternal (well, almost) loop, receiving messages and +%% handling them. +%% +%% Parameters: Master: Pid to the 'pc' process. +%% Win: Id of the window created. +%%====================================================================== + + + +deblocked_loop(ProcVars) -> + receive + Msg -> + case Msg of + + {gs, Id, Event, Data, Args} -> + NewProcVars = gs_messages({Id, Event, Data, Args}, ProcVars), + deblocked_loop(NewProcVars); + + _Other -> + NewProcVars = tv_messages(Msg, ProcVars), + deblocked_loop(NewProcVars) + end + end. + + + + + +tv_messages(Msg, ProcVars) -> + WinId = ProcVars#process_variables.window_id, + + case Msg of + #pg_cell_marked{} -> + mark_busy(WinId), + NewProcVars = handle_cell_marked(Msg, ProcVars), + mark_nonbusy(WinId), + NewProcVars; + + #pc_data{} -> + mark_busy(WinId), + NewProcVars = show_data(Msg, ProcVars), + mark_nonbusy(WinId), + NewProcVars; + + #pc_list_info{} -> + handle_list_info(Msg, ProcVars); + + #pb_col_marked{} -> + mark_busy(WinId), + NewProcVars = handle_col_marked(Msg, ProcVars), + mark_nonbusy(WinId), + NewProcVars; + + #pb_row_marked{} -> + mark_busy(WinId), + NewProcVars = handle_row_marked(Msg, ProcVars), + mark_nonbusy(WinId), + NewProcVars; + + #pb_new_colwidth{} -> + mark_busy(WinId), + NewProcVars = resize_column(Msg, ProcVars), + mark_nonbusy(WinId), + NewProcVars; + + #pd_get_sort_settings{sorting = Sorting, reverse = Reverse} -> + mark_busy(WinId), + NewProcVars = + case send_sort_info_signal(Sorting, Reverse, ProcVars) of + ignore -> + ProcVars; + TempNewProcVars -> + set_sort_col(Sorting, TempNewProcVars) + end, + mark_nonbusy(WinId), + NewProcVars; + + #pd_new_table{table_type=TabType,table_name=TabName, + record_name=RecName,writable=Writable} -> + mark_busy(WinId), + ToolP = ProcVars#process_variables.toolbar_params, + ?DISP_FUNC_FILE:update_toolbar_label(notext, ToolP, undefined, undefined, Writable), + mark_nonbusy(WinId), + ProcVars#process_variables{table_type = TabType, + table_name = TabName, + record_name = RecName, + writable = Writable}; + + #pd_win_conf{} -> + mark_busy(WinId), + NewProcVars = resize_window(Msg, ProcVars), + mark_nonbusy(WinId), + NewProcVars; + + #pd_rec_edit{} -> + mark_busy(WinId), + NewProcVars = open_rec_edit(Msg, ProcVars), + mark_nonbusy(WinId), + NewProcVars; + + + {updated_object, UpdObj} -> + get_updated_elem2(true, UpdObj, ProcVars), + ProcVars; + + {new_object, NewObj} -> + get_updated_elem2(true, NewObj, ProcVars), + ProcVars; + + {error_msg_mode, Mode} -> + put(error_msg_mode, Mode), + ProcVars; + + {'EXIT', Pid, Reason} -> + exit_signals({Pid, Reason}, ProcVars); + + _Other -> + ProcVars + end. + + + + + + +exit_signals(ExitInfo, ProcVars) -> + #process_variables{master_pid = MasterPid, + pg_pid = PgPid, + pb_pid = PbPid, + rec_pid = RecPid} = ProcVars, + + case ExitInfo of + {MasterPid, _Reason} -> + exit(normal); + {PgPid, _Reason} -> + exit(normal); + {PbPid, _Reason} -> + exit(normal); + {RecPid, _Reason} -> + ProcVars#process_variables{rec_pid = undefined}; + _Other -> + ProcVars + end. + + + + +open_rec_edit(Msg, ProcVars) -> + #pd_rec_edit{attributes = AttrList} = Msg, + + #process_variables{rec_pid = RecPid, + table_type = TabType, + table_name = TabName, + record_name = RecordName, + lists_as_strings = ListsAsStr, + mark_params = MarkP} = ProcVars, + + #mark_params{marked_object = MarkedObject} = MarkP, + + TabOrRecName = + case TabType of + mnesia -> + RecordName; + ets -> + TabName + end, + + case RecPid of + undefined -> + NewRecPid = + case MarkedObject of + undefined -> + tv_rec_edit:start(TabType, TabOrRecName, AttrList, ListsAsStr, + get(error_msg_mode)); + _Other -> + AttrVals = + case TabType of + mnesia -> + tl(tuple_to_list(MarkedObject)); + ets -> + [MarkedObject] + end, + tv_rec_edit:start(TabType, TabOrRecName, AttrList, AttrVals, ListsAsStr, + get(error_msg_mode)) + end, + ProcVars#process_variables{rec_pid = NewRecPid}; + _AnyPid -> + RecPid ! raise, + ProcVars + end. + + + + + + + +gs_messages(Msg, ProcVars) -> + + case Msg of + + {editentry, keypress, _Data, ['Tab' | _T]} -> + gs:config(editentry, [{select, {0,100000000}}]), + ProcVars; + + {editentry, keypress, _Data, ['Return' | _T]} -> + get_updated_elem(ProcVars), + ProcVars; + + {Id, enter, {toolbar, Btn, Str}, _} -> + gs:config(Id, [{motion, true}]), + NewProcVars = handle_toolbar_buttons(Id, Btn, Str, false, 0, 0, + ProcVars), + NewProcVars; + + + {_Id, buttonpress, _Data, [3 | _Rest]} -> + ProcVars; + + + {_Id, buttonpress, vscale, [MouseBtn | _Tail]} -> + WinId = ProcVars#process_variables.window_id, + mark_busy(WinId), + NewProcVars = ?DISP_FUNC_FILE:scroll_vertically(MouseBtn, ProcVars), + mark_nonbusy(WinId), + NewProcVars; + + + % The order of messages from gs ought to be + % 1. 'buttonpress' + % 2. 'click' and + % 3. 'buttonrelease' + % However, quite often the 'click' message comes last, meaning we have + % to check for this. :-( + + {_Id, click, vscale, [NewScalePos | _Tail]} -> + WinId = ProcVars#process_variables.window_id, + mark_busy(WinId), + NewProcVars = ?DISP_FUNC_FILE:perform_vertical_scroll(NewScalePos, + ProcVars), + mark_nonbusy(WinId), + NewProcVars; + + + {_Id, buttonpress, hscale, [MouseBtn | _Tail]} -> + WinId = ProcVars#process_variables.window_id, + mark_busy(WinId), + NewProcVars = ?DISP_FUNC_FILE:scroll_horizontally(MouseBtn, ProcVars), + mark_nonbusy(WinId), + NewProcVars; + + + {_Id, click, hscale, [NewScalePos | _Tail]} -> + WinId = ProcVars#process_variables.window_id, + mark_busy(WinId), + NewProcVars = ?DISP_FUNC_FILE:perform_horizontal_scroll(NewScalePos, + ProcVars), + mark_nonbusy(WinId), + NewProcVars; + + + {_Id, click, {toolbar, poll_table, _Str}, _Arg} -> + WinId = ProcVars#process_variables.window_id, + mark_busy(WinId), + PcPid = ProcVars#process_variables.master_pid, + PcPid ! #pc_poll_table{sender = self()}, + mark_nonbusy(WinId), + ProcVars; + + + {_Id, click, {toolbar, select_browser, _Str}, _Arg} -> + PcPid = ProcVars#process_variables.master_pid, + PcPid ! #pc_select{sender = self()}, + ProcVars; + + + {_Id, click, {toolbar, help_button, _Str}, _Arg} -> + PcPid = ProcVars#process_variables.master_pid, + PcPid ! #pc_help{sender = self()}, + ProcVars; + + + + {_Id, click, {toolbar, insert_object, _Str}, _Arg} -> + WinId = ProcVars#process_variables.window_id, + mark_busy(WinId), + PcPid = ProcVars#process_variables.master_pid, + PcPid ! {pc_edit_object, self()}, + mark_nonbusy(WinId), + ProcVars; + + + {_Id, click, {toolbar, search_object, _Str}, _Arg} -> + WinId = ProcVars#process_variables.window_id, + mark_busy(WinId), + PcPid = ProcVars#process_variables.master_pid, + PcPid ! #pc_search_req{sender = self()}, + mark_nonbusy(WinId), + ProcVars; + + + {_Id, click, {toolbar, sort_rising_order, _Str}, _Arg} -> + WinId = ProcVars#process_variables.window_id, + mark_busy(WinId), + NewProcVars = case send_sort_info_signal(true, false, ProcVars) of + ignore -> + ProcVars; + TempNewProcVars -> + set_sort_col(true, TempNewProcVars) + end, + mark_nonbusy(WinId), + NewProcVars; + + + {_Id, click, {toolbar, sort_falling_order, _Str}, _Arg} -> + WinId = ProcVars#process_variables.window_id, + mark_busy(WinId), + NewProcVars = case send_sort_info_signal(true, true, ProcVars) of + ignore -> + ProcVars; + TempNewProcVars -> + set_sort_col(true, TempNewProcVars) + end, + mark_nonbusy(WinId), + NewProcVars; + + + {_Id, click, {toolbar, no_sorting, _Str}, _Arg} -> + NewProcVars = case send_sort_info_signal(false, false, ProcVars) of + ignore -> + ProcVars; + TempNewProcVars -> + set_sort_col(false, TempNewProcVars) + end, + NewProcVars; + + + {Id, click, {toolbar, table_info, _Str}, _Arg} -> + ToolP = ProcVars#process_variables.toolbar_params, + F = ToolP#toolbar_params.pop_up_frame_id, + gs:config(F, [{y, -30}]), + gs:config(Id, [{motion, false}]), + PcPid = ProcVars#process_variables.master_pid, + PcPid ! #pc_show_table_info{sender = self()}, + ProcVars; + + + {Id, click, {labelbtn, pop_up}, _Arg} -> + gs:config(Id, [{data, {labelbtn, pop_down}}]), + NewProcVars = ?DISP_FUNC_FILE:show_toolbar_editor(ProcVars), + NewProcVars; + + + {Id, click, {labelbtn, pop_down}, _Arg} -> + gs:config(Id, [{data, {labelbtn, pop_up}}]), + NewProcVars = ?DISP_FUNC_FILE:hide_toolbar_editor(ProcVars), + NewProcVars; + + + _OtherMessage -> + ProcVars + + end. + + + + + +get_updated_elem(ProcVars) -> + EditedStr = gs:read(editentry, text), + case tv_db_search:string_to_term(EditedStr) of + {error, {_Reason, Msg}} -> + gs:config(editentry, [beep]), + gs:window(pdwin, gs:start(), []), + tv_utils:notify(pdwin, "TV Notification", Msg), + gs:destroy(pdwin), + ProcVars; + {ok, NewTerm} -> + get_updated_elem2(false, NewTerm, ProcVars) + end. + + + + + +get_updated_elem2(FromRecEdit, NewTerm, ProcVars) -> + #process_variables{table_type = TableType, + record_name = RecordName, + mark_params = MarkP, + master_pid = PcPid} = ProcVars, + + #mark_params{marked_object = ObjToUpdate, + marked_color = ObjColor, + virtual_row_no = VirtualRow, + cell_col_no = VirtualCol} = MarkP, + + case ObjToUpdate of + undefined -> + case new_object_ok(TableType, RecordName, NewTerm) of + true -> + PcPid ! #pd_new_object{sender = self(), + object = NewTerm}, + ProcVars; + {false, Msg} -> + gs:window(pdwin, gs:start(), []), + tv_utils:notify(pdwin, "TV Notification", Msg), + gs:destroy(pdwin), + ProcVars + end; + _AnyObj -> + %% We need to know if the object has been deleted! + NewObj = + case VirtualCol of + undefined -> + NewTerm; + _AnyCol when FromRecEdit -> + NewTerm; + _AnyCol -> + if + is_tuple(ObjToUpdate) -> + erlang:setelement(VirtualCol, ObjToUpdate, NewTerm); + true -> + NewTerm + end + end, + %% Is the update OK? + case update_ok(TableType, ObjToUpdate, NewObj) of + true -> + PcPid ! #pd_updated_object{sender = self(), + object = NewObj, + old_object = ObjToUpdate, + old_color = ObjColor, + obj_no = VirtualRow}, + ProcVars; + false -> + gs:window(pdwin, gs:start(), []), + case get(error_msg_mode) of + normal -> + tv_utils:notify(pdwin, "TV Notification", + ["The record name cannot be changed!"]); + haiku -> + tv_utils:notify(pdwin, "TV Notification", + ["The attempt to change", + "The permanent record name", + "Is simply ignored."]) + end, + gs:destroy(pdwin), + ProcVars + end + end. + + + + +new_object_ok(ets, _RecordName, NewTerm) when is_tuple(NewTerm) -> + true; +new_object_ok(ets, _RecordName, _NewTerm) -> + Msg = case get(error_msg_mode) of + normal -> + ["Object is not a tuple!"]; + haiku -> + ["Yes, it is a term.", + "It is pretty, but it's not", + "A proper tuple."] + end, + {false, Msg}; +new_object_ok(mnesia, RecordName, NewTerm) when is_tuple(NewTerm) -> + NewRecName = element(1, NewTerm), + case NewRecName of + RecordName -> + true; + _OtherName -> + Msg = case get(error_msg_mode) of + normal -> + ["Erroneous record name!"]; + haiku -> + ["The attempt to use", + "An invalid record name", + "Is simply ignored."] + end, + {false, Msg} + end; +new_object_ok(mnesia, _RecordName, _NewTerm) -> + Msg = case get(error_msg_mode) of + normal -> + ["Object is not a record!"]; + haiku -> + ["Yes, it is a term.", + "It is pretty, but it's not", + "The proper record."] + end, + {false, Msg}. + + + + +update_ok(ets, _ObjectToUpdate, _NewObject) -> + true; +update_ok(mnesia, ObjectToUpdate, NewObject) -> + OldRecName = element(1, ObjectToUpdate), + NewRecName = element(1, NewObject), + case NewRecName of + OldRecName -> + true; + _Other -> + false + end. + + + + +handle_toolbar_buttons(Id, Btn, Str, LabelShown, X, Y, ProcVars) -> + WinId = ProcVars#process_variables.window_id, + ToolP = ProcVars#process_variables.toolbar_params, + F = ToolP#toolbar_params.pop_up_frame_id, + + receive + + {gs, Id, motion, _Data, [NewX, NewY | _]} -> + handle_toolbar_buttons(Id, Btn, Str, LabelShown, NewX, NewY, + ProcVars); + + {gs, editentry, keypress, _Data, ['Tab' | _T]} -> + gs:config(editentry, [{select, {0,100000000}}]), + handle_toolbar_buttons(Id, Btn, Str, LabelShown, X, Y, ProcVars); + + {gs, editentry, keypress, _Data, ['Return' | _T]} -> + get_updated_elem(ProcVars), + handle_toolbar_buttons(Id, Btn, Str, LabelShown, X, Y, ProcVars); + + {gs, Id, leave, {toolbar, Btn, Str}, _Arg} -> + gs:config(F, [{y, -30}]), + gs:config(Id, [{motion, false}]), + ProcVars; + + {gs, Id, click, {toolbar, poll_table, _Str}, _Arg} -> + mark_busy(WinId), + gs:config(F, [{y, -30}]), + gs:config(Id, [{motion, false}]), + PcPid = ProcVars#process_variables.master_pid, + PcPid ! #pc_poll_table{sender = self()}, + mark_nonbusy(WinId), + ProcVars; + + {gs, Id, click, {toolbar, select_browser, _Str}, _Arg} -> + gs:config(F, [{y, -30}]), + gs:config(Id, [{motion, false}]), + PcPid = ProcVars#process_variables.master_pid, + PcPid ! #pc_select{sender = self()}, + ProcVars; + + {gs, Id, click, {toolbar, help_button, _Str}, _Arg} -> + gs:config(F, [{y, -30}]), + gs:config(Id, [{motion, false}]), + PcPid = ProcVars#process_variables.master_pid, + PcPid ! #pc_help{sender = self()}, + ProcVars; + + {gs, Id, click, {toolbar, insert_object, _Str}, _Arg} -> + mark_busy(WinId), + gs:config(F, [{y, -30}]), + gs:config(Id, [{motion, false}]), + PcPid = ProcVars#process_variables.master_pid, + PcPid ! {pc_edit_object, self()}, + mark_nonbusy(WinId), + ProcVars; + + + {gs, Id, click, {toolbar, search_object, _Str}, _Arg} -> + mark_busy(WinId), + gs:config(F, [{y, -30}]), + gs:config(Id, [{motion, false}]), + PcPid = ProcVars#process_variables.master_pid, + PcPid ! #pc_search_req{sender = self()}, + mark_nonbusy(WinId), + ProcVars; + + {gs, Id, click, {toolbar, sort_rising_order, _Str}, _Arg} -> + mark_busy(WinId), + gs:config(F, [{y, -30}]), + gs:config(Id, [{motion, false}]), + NewProcVars = + case send_sort_info_signal(true, false, ProcVars) of + ignore -> + ProcVars; + TempNewProcVars -> + set_sort_col(true, TempNewProcVars) + end, + mark_nonbusy(WinId), + NewProcVars; + + {gs, Id, click, {toolbar, sort_falling_order, _Str}, _Arg} -> + mark_busy(WinId), + gs:config(F, [{y, -30}]), + gs:config(Id, [{motion, false}]), + NewProcVars = + case send_sort_info_signal(true, true, ProcVars) of + ignore -> + ProcVars; + TempNewProcVars -> + set_sort_col(true, TempNewProcVars) + end, + mark_nonbusy(WinId), + NewProcVars; + + {gs, Id, click, {toolbar, no_sorting, _Str}, _Arg} -> + gs:config(F, [{y, -30}]), + gs:config(Id, [{motion, false}]), + NewProcVars = + case send_sort_info_signal(false, false, ProcVars) of + ignore -> + ProcVars; + TempNewProcVars -> + set_sort_col(false, TempNewProcVars) + end, + NewProcVars; + + {gs, Id, click, {toolbar, table_info, _Str}, _Arg} -> + gs:config(F, [{y, -30}]), + gs:config(Id, [{motion, false}]), + PcPid = ProcVars#process_variables.master_pid, + PcPid ! #pc_show_table_info{sender = self()}, + ProcVars; + + {'EXIT', Pid, Reason} -> + exit_signals({Pid, Reason}, ProcVars), + handle_toolbar_buttons(Id, Btn, Str, LabelShown, X, Y, ProcVars); + + OtherMsg -> + NewProcVars = tv_messages(OtherMsg, ProcVars), + handle_toolbar_buttons(Id, Btn, Str, LabelShown, X, Y, NewProcVars) + + after 600 -> + case LabelShown of + false -> + FrameP = ProcVars#process_variables.frame_params, + L = ToolP#toolbar_params.pop_up_label_id, + + #frame_params{toolbar_frame_width = TWidth, + toolbar_frame_height = THeight} = FrameP, + + BtnHeight = gs:read(Id, height), + BtnXpos = gs:read(Id, x), + BtnYpos = gs:read(Id, y), + FrameHeight = gs:read(F, height), + FontUsed = gs:read(L, font), + {StringWidth, _H} = gs:read(L, {font_wh, {FontUsed, Str}}), + + Width = StringWidth + 6, + Xpos = BtnXpos + X, + LblXpos = if + Xpos + Width > TWidth -> + Xpos - Width; + true -> + Xpos + end, + % Ypos = BtnYpos + Y + 15, + Ypos = BtnYpos + BtnHeight + 6, + LblYpos = if + Ypos + FrameHeight > THeight -> + Ypos - FrameHeight - 25; + true -> + Ypos + end, + gs:config(L, [{width, Width - 2}, + {label, {text, Str}}]), + gs:config(F, [{width, Width}, + {x, LblXpos}, + {y, LblYpos} + ]); + true -> + done + end, + handle_toolbar_buttons(Id, Btn, Str, true, X, Y, ProcVars) + end. + + + + + + +set_sort_col(SortingOn, ProcVars) -> + #process_variables{pb_pid = PbPid, + mark_params = MarkP} = ProcVars, + + SortCol = case SortingOn of + true -> + MarkP#mark_params.col_no; + false -> + undefined + end, + PbPid ! #pb_set_sort_col{sender = self(), + virtual_col = SortCol + }, + remove_all_marks(SortCol, ProcVars). + + + + + +send_sort_info_signal(Sorting, Reverse, ProcVars) -> + #process_variables{master_pid = PcPid, + mark_params = MarkP} = ProcVars, + + SortColNo = MarkP#mark_params.col_no, + + PcPid ! #pc_set_sorting_mode{sender = self(), + sorting = Sorting, + reverse = Reverse, + sort_key_no = SortColNo + }, + receive + #pc_set_sorting_mode_cfm{sort_key_no = FinalSortColNo} -> + NewMarkP = MarkP#mark_params{col_no = FinalSortColNo}, + ProcVars#process_variables{mark_params = NewMarkP}; + + #pd_ignore{} -> + ignore + + end. + + + + + +show_data(Msg, ProcVars) -> + #pc_data{scale_pos = Pos, + scale_range = Range, + list_range = MaxValue, + elementlist = List, + list_of_keys = KeyList, + max_elem_size = MaxElemSize, + marked_row = MarkedRowData} = Msg, + + ?DISP_FUNC_FILE:display_data(Pos, Range, MaxValue, List, KeyList, MaxElemSize, + MarkedRowData, ProcVars). + + + + + + +handle_list_info(Msg, ProcVars) -> + ListAsStr = Msg#pc_list_info.lists_as_strings, + PgPid = ProcVars#process_variables.pg_pid, + PgPid ! #pg_list_info{sender = self(), + lists_as_strings = ListAsStr}, + ProcVars#process_variables{lists_as_strings = ListAsStr}. + + + + + +handle_col_marked(Msg, ProcVars) -> + #pb_col_marked{col_marked = ColMarked, + virtual_col = VirtualCol} = Msg, + + #process_variables{master_pid = MasterPid, + pg_pid = PgPid, + rec_pid = RecPid, + writable = Writable, + toolbar_params = ToolP, + mark_params = MarkP} = ProcVars, + SortCol = MarkP#mark_params.sort_col_no, + + PgPid ! #pg_remove_marks{sender = self()}, + + case ColMarked of + true -> + PgPid ! #pg_col_marked{sender = self(), + virtual_col = VirtualCol}; + false -> + done + end, + + MasterPid ! #pc_marked_row{sender = self(), + row_no = undefined, + object = undefined, + color = undefined + }, + + ?DISP_FUNC_FILE:update_toolbar_label(notext, ToolP, undefined, undefined, Writable), + send_to_rec_edit(RecPid, insert_mode), + + NewMarkP = + if + ColMarked -> + MarkP#mark_params{col_no = VirtualCol}; + true -> + if + SortCol =:= undefined -> + MarkP; + true -> + MarkP#mark_params{col_no = SortCol} + end + end, + ProcVars#process_variables{mark_params = NewMarkP}. + + + + + + +remove_all_marks(SortCol, ProcVars) -> + #process_variables{master_pid = MasterPid, + pb_pid = PbPid, + pg_pid = PgPid, + toolbar_params = ToolP} = ProcVars, + + PgPid ! #pg_remove_marks{sender = self()}, + PbPid ! #pb_remove_marks{sender = self()}, + MasterPid ! #pc_marked_row{sender = self(), + row_no = undefined, + object = undefined, + color = undefined + }, +%% ?DISP_FUNC_FILE:update_toolbar_label(notext, ToolP, undefined, undefined, Writable), + ?DISP_FUNC_FILE:update_toolbar_editor(ToolP#toolbar_params.editor_id, notext), +%% send_to_rec_edit(RecPid, insert_mode), + ProcVars#process_variables{mark_params = #mark_params{sort_col_no = SortCol, + cell_col_no = undefined, + row_no = undefined, + virtual_row_no = undefined, + marked_object = undefined, + marked_color = undefined} + }. + + + + + + +handle_row_marked(Msg, ProcVars) -> + #pb_row_marked{row_marked = RowMarked, + virtual_row = VirtualRow, + real_row = RealRow} = Msg, + + #process_variables{master_pid = MasterPid, + rec_pid = RecPid, + pg_pid = PgPid, + data_list = DataList, + color_list = ColorList, + writable = Writable, + toolbar_params = ToolP, + mark_params = MarkP} = ProcVars, + + PgPid ! #pg_remove_marks{sender = self()}, + + case RowMarked of + true -> + PgPid ! #pg_row_marked{sender = self(), + virtual_row = VirtualRow}; + false -> + done + end, + + {DataElement, NewMarkP} = + if + RowMarked -> + {MarkedRowOrCol, RowObj} = + ?DISP_FUNC_FILE:get_data_element(row, DataList, RealRow, undefined), + + MarkedRowColor = + case MarkedRowOrCol of + notext -> + undefined; + _OtherObject -> + lists:nth(RealRow, ColorList) + end, + MasterPid ! #pc_marked_row{sender = self(), + row_no = VirtualRow, + object = RowObj, + color = MarkedRowColor + }, + send_to_rec_edit(RecPid, {update_mode,RowObj}), + {MarkedRowOrCol, MarkP#mark_params{virtual_row_no = VirtualRow, + row_no = RealRow, + cell_col_no = undefined, + col_no = undefined, + marked_object = RowObj, + marked_color = MarkedRowColor}}; + true -> + MasterPid ! #pc_marked_row{sender = self(), + row_no = undefined, + object = undefined, + color = undefined + }, + send_to_rec_edit(RecPid, insert_mode), + {notext, MarkP#mark_params{virtual_row_no = undefined, + row_no = undefined, + cell_col_no = undefined, + col_no = undefined, + marked_object = undefined, + marked_color = undefined}} + end, + + ?DISP_FUNC_FILE:update_toolbar_label(DataElement, ToolP, VirtualRow, + undefined, Writable), + ProcVars#process_variables{mark_params = NewMarkP}. + + + + + +handle_cell_marked(Msg, ProcVars) -> + #pg_cell_marked{cell_marked = CellMarked, + virtual_col = VirtualCol, + real_row = RealRow, + virtual_row = VirtualRow} = Msg, + + % We are interested in the real row number, since we only have a sublist + % stored in pd. + ?DISP_FUNC_FILE:marked_cell(CellMarked, VirtualCol, RealRow, VirtualRow, + ProcVars). + + + + +resize_window(Msg, ProcVars) -> + #pd_win_conf{width = NewWindowWidth, + height = NewWindowHeight} = Msg, + + ?DISP_FUNC_FILE:resize_display(NewWindowWidth, NewWindowHeight, ProcVars). + + + + +resize_column(Msg, ProcVars) -> + #pb_new_colwidth{real_col = RealCol, + virtual_col = VirtualCol, + xdiff = Xdiff} = Msg, + + ?DISP_FUNC_FILE:resize_column(RealCol, VirtualCol, Xdiff, ProcVars). + + + + +mark_busy(Id) -> + gs:config(Id, [{cursor, busy}]). + + + + +mark_nonbusy(Id) -> + gs:config(Id, [{cursor, arrow}]). + + + + +send_to_rec_edit(undefined, _Msg) -> + done; +send_to_rec_edit(RecPid, Msg) -> + RecPid ! Msg. + diff --git a/lib/tv/src/tv_pd_display.erl b/lib/tv/src/tv_pd_display.erl new file mode 100644 index 0000000000..f5a30cb640 --- /dev/null +++ b/lib/tv/src/tv_pd_display.erl @@ -0,0 +1,1059 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1997-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% +%%%********************************************************************* +%%% +%%% Description: Part of pd controlling the graphics. +%%% +%%%********************************************************************* + +-module(tv_pd_display). + + + + +-export([init_display/4, + display_data/8, + resize_display/3, + resize_column/4, + scroll_horizontally/2, + scroll_vertically/2, + perform_horizontal_scroll/2, + perform_vertical_scroll/2, + marked_cell/5, + update_toolbar_label/5, + update_toolbar_editor/2, + get_data_element/4, + hide_toolbar_editor/1, + show_toolbar_editor/1]). + + + + + +-include("tv_int_def.hrl"). +-include("tv_int_msg.hrl"). +-include("tv_pd_int_def.hrl"). +-include("tv_pd_int_msg.hrl"). + + + + + + + +%%%********************************************************************* +%%% EXTERNAL FUNCTIONS +%%%********************************************************************* + + + +%%====================================================================== +%% Function: init_display. +%% +%% Return Value: Id of the display (here:canvas) created. +%% +%% Description: Creates the canvas and the scale. +%% +%% Parameters: Id of the window the display shall be created in. +%%====================================================================== + + +init_display(WindowId, WindowWidth, WindowHeight, ProcVars) -> + % Get all necessary window parameters! + #process_variables{pg_pid = PgPid, + pb_pid = PbPid, + frame_params = FrameP, + scale_params = ScaleP, + toolbar_params = ToolP} = ProcVars, + + NewFrameP = tv_pd_frames:create_display_frames(WindowId, WindowWidth, + WindowHeight, FrameP), + + #frame_params{grid_frame_id = GridParentId, + grid_frame_width = GridParentWidth, + grid_frame_height = GridParentHeight} = NewFrameP, + + PgPid ! #pg_init_grid{sender = self(), + parent_id = GridParentId, + width = GridParentWidth, + height = GridParentHeight, + xpos = ?VBTN_WIDTH - 1, + ypos = ?KEY_MARK_AREA_HEIGHT + ?HBTN_HEIGHT - 1, + nof_rows = ?NOF_GRIDROWS, + row_height = ?ROW_HEIGHT + }, + + + receive + #pg_col_info{first_col_shown = FirstColShown, + width_of_cols_shown = ColsShown, + nof_rows_shown = NofRowsShown} -> + + PbPid ! #pb_init_btns{sender = self(), + parent_id = GridParentId, + parent_width = GridParentWidth, + parent_height = GridParentHeight, + ypos = ?KEY_MARK_AREA_HEIGHT, + hbtn_height = ?HBTN_HEIGHT, + resbtn_width = ?RESBTN_WIDTH, + vbtn_width = ?VBTN_WIDTH, + nof_rows = ?NOF_GRIDROWS, + row_height = ?ROW_HEIGHT, + first_col_shown = FirstColShown, + cols_shown = ColsShown + }, + + NewScaleP = tv_pd_scale:init_scale(NewFrameP, ScaleP), + + NewToolP = init_toolbar(NewFrameP, ToolP), + + ProcVars#process_variables{window_id = WindowId, + window_width = WindowWidth, + window_height = WindowHeight, + first_col_shown = FirstColShown, + nof_rows_shown = NofRowsShown, + cols_shown = ColsShown, + frame_params = NewFrameP, + scale_params = NewScaleP, + toolbar_params = NewToolP + } + end. + + + + + +resize_display(NewWinW, NewWinH, ProcVars) -> + #process_variables{pg_pid = PgPid, + pb_pid = PbPid, + color_list = ColorList, + first_row_shown = FirstRowShown, + frame_params = FrameP, + scale_params = ScaleP, + toolbar_params = ToolP} = ProcVars, + + NewFrameP = tv_pd_frames:resize_display_frames(NewWinW, NewWinH, FrameP), + + #frame_params{grid_frame_width = GridParentWidth, + grid_frame_height = GridParentHeight} = NewFrameP, + + PgPid ! #pg_resize_grid{sender = self(), + width = GridParentWidth, + height = GridParentHeight + }, + + receive + #pg_col_info{first_col_shown = FirstColShown, + width_of_cols_shown = ColsShown, + nof_rows_shown = NofRowsShown} -> + + PbPid ! #pb_update_hbtns{sender = self(), + parent_width = GridParentWidth, + parent_height = GridParentHeight, + first_col_shown = FirstColShown, + cols_shown = ColsShown + }, + + PbPid ! #pb_update_vbtns{sender = self(), + color_list = ColorList, + first_row_shown = FirstRowShown, + nof_rows_shown = NofRowsShown, + blinking_enabled = false + }, + + NewScaleP = tv_pd_scale:resize_scale(NewFrameP, ScaleP), + + NewToolP = resize_toolbar(NewFrameP, ToolP), + + ProcVars#process_variables{window_width = NewWinW, + window_height = NewWinH, + first_col_shown = FirstColShown, + nof_rows_shown = NofRowsShown, + cols_shown = ColsShown, + frame_params = NewFrameP, + scale_params = NewScaleP, + toolbar_params = NewToolP + } + end. + + + + + + + +resize_column(RealCol, VirtualCol, Xdiff, ProcVars) -> + #process_variables{pg_pid = PgPid, + pb_pid = PbPid, + frame_params = FrameP} = ProcVars, + + PgPid ! #pg_resize_grid_col{sender = self(), + real_col_no = RealCol, + virtual_col_no = VirtualCol, + xdiff = Xdiff + }, + + #frame_params{grid_frame_width = GridFrameWidth, + grid_frame_height = GridFrameHeight} = FrameP, + receive + #pg_col_info{first_col_shown = FirstColShown, + width_of_cols_shown = ColsShown, + nof_rows_shown = NofRowsShown} -> + + PbPid ! #pb_update_hbtns{parent_width = GridFrameWidth, + parent_height = GridFrameHeight, + first_col_shown = FirstColShown, + cols_shown = ColsShown + }, + + ProcVars#process_variables{first_col_shown = FirstColShown, + nof_rows_shown = NofRowsShown, + cols_shown = ColsShown + } + end. + + + + + + + + +display_data(Pos, Range, _MaxValue, List, KeyList, MaxElemSize, MarkedRowData,ProcVars) -> + #process_variables{master_pid = PcPid, + rec_pid = RecPid, + pg_pid = PgPid, + pb_pid = PbPid, + writable = Writable, + sorting_on = SortingOn, + nof_rows_shown = NofRowsShown, + scale_params = ScaleP, + toolbar_params = ToolP, + mark_params = MarkP} = ProcVars, + + {DataList, ColorList} = split_dblist(List, [], []), + + NewMarkP = update_marks(SortingOn, DataList, ColorList, MarkedRowData, Pos, NofRowsShown, + Writable, Range, PcPid, PgPid, RecPid, ToolP, MarkP), + + PgPid ! #pg_data{sender = self(), + data = DataList, + first_row_shown = Pos + }, + + PbPid ! #pb_update_vbtns{sender = self(), + color_list = ColorList, + first_row_shown = Pos, + nof_rows_shown = NofRowsShown, + blinking_enabled = false + }, + + PbPid ! #pb_key_info{sender = self(), + list_of_keys = KeyList + }, + + % May be new number of elements in the total list! + ?SCALE_FUNC_FILE:set_scale_range(vscale, Range, ScaleP), + % May be new vertical scale position required! + NewScaleP = ?SCALE_FUNC_FILE:set_scale_pos(vscale, Pos, ScaleP), + % May be new maximum size of elements! + ?SCALE_FUNC_FILE:set_scale_range(hscale, {1, MaxElemSize}, NewScaleP), + + ProcVars#process_variables{data_list = DataList, + color_list = ColorList, + first_row_shown = Pos, + initialising = false, + scale_params = NewScaleP, + mark_params = NewMarkP + }. + + + + + + + +scroll_vertically(MouseBtn, ProcVars) -> + #process_variables{scale_params = ScaleP} = ProcVars, + + OldScalePos = ScaleP#scale_params.vscale_pos, + NewScalePos = get_new_scalepos(MouseBtn, OldScalePos), + + case NewScalePos of + OldScalePos -> + ProcVars; + NewValue -> + perform_vertical_scroll(NewValue, ProcVars) + end. + + + + + + + +scroll_horizontally(MouseBtn, ProcVars) -> + #process_variables{scale_params = ScaleP} = ProcVars, + + OldScalePos = ScaleP#scale_params.hscale_pos, + NewScalePos = get_new_scalepos(MouseBtn, OldScalePos), + + case NewScalePos of + OldScalePos -> + ProcVars; + NewValue -> + perform_horizontal_scroll(NewValue, ProcVars) + end. + + + + + + + + +perform_vertical_scroll(NewScalePos, ProcVars) -> + #process_variables{master_pid = MasterPid, + initialising = Init, + scale_params = ScaleP} = ProcVars, + + %% To avoid erroneous scrollbar signals during creation of the display. + case Init of + true -> + done; + false -> + MasterPid ! #pc_data_req{sender = self(), + element = NewScalePos, + nof_elements = ?NOF_GRIDROWS} + end, + + % Since the order of click/buttonrelease messages isn't + % precise, set the scale to the returned pos (may otherwise + % differ one unit). + NewScaleP = ?SCALE_FUNC_FILE:set_scale_pos(vscale, + NewScalePos, + ScaleP), + + ProcVars#process_variables{scale_params = NewScaleP}. + + + + + + + +perform_horizontal_scroll(NewScalePos, ProcVars) -> + #process_variables{pg_pid = PgPid, + pb_pid = PbPid, + frame_params = FrameP, + scale_params = ScaleP} = ProcVars, + + % Since the order of click/buttonrelease messages isn't + % precise, set the scale to the returned pos (may otherwise + % differ one unit). + NewScaleP = ?SCALE_FUNC_FILE:set_scale_pos(hscale, + NewScalePos, + ScaleP), + + PgPid ! #pg_horizontal_scroll{sender = self(), + leftmost_virtual_col = NewScalePos + }, + + #frame_params{grid_frame_width = GridFrameWidth, + grid_frame_height = GridFrameHeight} = FrameP, + receive + #pg_col_info{first_col_shown = FirstColShown, + width_of_cols_shown = ColsShown, + nof_rows_shown = NofRowsShown} -> + + PbPid ! #pb_update_hbtns{parent_width = GridFrameWidth, + parent_height = GridFrameHeight, + first_col_shown = FirstColShown, + cols_shown = ColsShown + }, + + ProcVars#process_variables{first_col_shown = FirstColShown, + cols_shown = ColsShown, + nof_rows_shown = NofRowsShown, + scale_params = NewScaleP + } + end. + + + + + + + + +marked_cell(true, VirtualCol, RealRow, VirtualRow, ProcVars) -> + #process_variables{master_pid = MasterPid, + rec_pid = RecPid, + data_list = DataList, + color_list = ColorList, + writable = Writable, + mark_params = MarkP, + toolbar_params = ToolP} = ProcVars, + + {DataElement, MarkedRowObject} = get_data_element(cell, DataList, RealRow, VirtualCol), + update_toolbar_label(DataElement, ToolP, VirtualRow, VirtualCol, Writable), + send_to_rec_edit(RecPid, {update_mode,MarkedRowObject}), + + MarkedRowColor = lists:nth(RealRow, ColorList), + + MasterPid ! #pc_marked_row{sender = self(), + row_no = VirtualRow, + object = MarkedRowObject, + color = MarkedRowColor + }, + NewMarkP = MarkP#mark_params{cell_col_no = VirtualCol, + row_no = RealRow, + virtual_row_no = VirtualRow, + marked_object = MarkedRowObject, + marked_color = MarkedRowColor + }, + ProcVars#process_variables{mark_params = NewMarkP + }; +marked_cell(false, VirtualCol, _RealRow, VirtualRow, ProcVars) -> + #process_variables{master_pid = MasterPid, + rec_pid = RecPid, + pb_pid = PbPid, + writable = Writable, + mark_params = MarkP} = ProcVars, + + PbPid ! #pb_remove_marks{sender = self()}, + + case VirtualRow of + undefined -> + done; + _AnyRow -> + update_toolbar_label(notext, ProcVars#process_variables.toolbar_params, + VirtualRow, VirtualCol, Writable), + send_to_rec_edit(RecPid, insert_mode) + end, + MasterPid ! #pc_marked_row{sender = self(), + %% row_no = VirtualRow + row_no = undefined, + object = undefined, + color = undefined + }, + NewMarkP = MarkP#mark_params{cell_col_no = undefined, + row_no = undefined, + virtual_row_no = undefined, + marked_object = undefined, + marked_color = undefined + }, + ProcVars#process_variables{mark_params = NewMarkP + }. + + + + + + + + +update_toolbar_label(notext, ToolP, _VirtualRowNo, _VirtualColNo, Writable) -> + #toolbar_params{row_col_label_id = RowColLblId, + fg_label_id = FgLblId, + editor_id = EdId} = ToolP, + gs:config(RowColLblId, [{label, {text,""}}]), + gs:config(FgLblId, [{enable,true}]), + gs:config(FgLblId, [{delete, {0,1000000000}}]), + gs:config(FgLblId, [{insert, {0, ""}}]), + case Writable of + true -> + gs:config(FgLblId, [{cursor, text}, + {setfocus, true}]); + false -> + gs:config(FgLblId, [{enable, false}, + {cursor, arrow}, + {setfocus, false}]) + end, + update_toolbar_editor(EdId, notext); +update_toolbar_label({DataToShow}, ToolP, VirtualRowNo, VirtualColNo, Writable) -> + #toolbar_params{row_col_label_id = RowColLblId, + fg_label_id = FgLblId, + editor_id = EdId} = ToolP, + + case VirtualRowNo of + undefined -> + %% No row - nothing can possibly be marked! + case Writable of + true -> + gs:config(FgLblId, [{setfocus,true}, + {cursor, text}]); + false -> + gs:config(FgLblId, [{enable,false}, + {setfocus, false}, + {cursor, arrow}]) + end; + _AnyRow -> + RowStr = "R" ++ integer_to_list(VirtualRowNo), + ColStr = case VirtualColNo of + undefined -> + ""; + _AnyCol -> + " x C" ++ integer_to_list(VirtualColNo) + end, + DataStr = lists:flatten(tv_io_lib:format("~p", [DataToShow])), + gs:config(RowColLblId, [{label, {text,RowStr++ColStr}}]), + gs:config(FgLblId, [{enable,true}]), + gs:config(FgLblId, [{delete, {0,10000000}}]), + gs:config(FgLblId, [{insert, {0,DataStr}}]), + case Writable of + true -> + gs:config(FgLblId, [{setfocus,true}, + {cursor, text}]); + false -> + gs:config(FgLblId, [{enable,false}, + {setfocus, false}, + {cursor, arrow}]) + end, + update_toolbar_editor(EdId, {DataToShow}) + end. + + + + + + + + +get_data_element(row, DataList, RowNo, _VirtualCol) -> + if + length(DataList) < RowNo -> + {notext, undefined}; + true -> + RowObj = lists:nth(RowNo, DataList), + {{RowObj}, RowObj} + end; +get_data_element(cell, DataList, RowNo, ColNo) -> + %% It's the responsibility of pg to ensure that there is a data item + %% for the cell marked, meaning we don't *have* to check the length of + %% the data items. However, since we in the future may want to edit + %% even empty cells, we check it! + if + length(DataList) < RowNo -> + {notext, undefined}; + true -> + DataItem = lists:nth(RowNo, DataList), + if + is_tuple(DataItem) -> + if size(DataItem) < ColNo -> + {notext, DataItem}; + true -> + {{element(ColNo, DataItem)}, DataItem} + end; + true -> + {{DataItem}, DataItem} + end + end. + + + + + + + + +show_toolbar_editor(ProcVars) -> + #process_variables{frame_params = FrameP, + toolbar_params = ToolP} = ProcVars, + + #frame_params{toolbar_frame_height = THeight} = FrameP, + + #toolbar_params{editor_frame_id = EdFrameId} = ToolP, + + Xpos = 0, + Ypos = THeight - 8 - ?ROW_COL_LBL_HEIGHT + 1, + gs:config(EdFrameId, [{x, Xpos}, + {y, Ypos} + ]), + ProcVars. + + + + + + + + +hide_toolbar_editor(ProcVars) -> + #process_variables{toolbar_params = ToolP} = ProcVars, + + #toolbar_params{editor_frame_id = EdFrameId} = ToolP, + + Xpos = 0, + Ypos = (-1) * gs:read(EdFrameId, height) - 50, + gs:config(EdFrameId, [{x, Xpos}, + {y, Ypos} + ]), + ProcVars. + + + + + + +%%%******************************************************************** +%%% INTERNAL FUNCTIONS +%%%******************************************************************** + + + + + +update_toolbar_editor(EdId, notext) -> + gs:config(EdId, [{enable, true}]), + gs:config(EdId, [clear]), + gs:config(EdId, [{enable, false}]); +update_toolbar_editor(EdId, {DataToShow}) -> + Str = io_lib:format("~n~p~n", [DataToShow]), + gs:config(EdId, [{enable, true}]), + gs:config(EdId, [clear]), + gs:config(EdId, [{overwrite, {insert, Str}}]), + gs:config(EdId, [{enable, false}]). + + + + + + +update_marks(true, _DataList, _ColorList, _MarkedRowData, + _Pos, _NofRowsShown, _Writable, _Range, PcPid, PgPid, RecPid, ToolP, MarkP) -> + PgPid ! #pg_remove_marks{sender = self()}, + %% Too much trouble trying to find the marked object again! + %% On the other hand, is the mark based on the row number + %% or the row content? Probably different strategies now, depending + %% on where in the code we are... :-( + %% update_toolbar_label(notext, ToolP, undefined, undefined, Writable), + update_toolbar_editor(ToolP#toolbar_params.editor_id, notext), + send_to_rec_edit(RecPid, insert_mode), + PcPid ! #pc_marked_row{sender = self(), + row_no = undefined, + object = undefined, + color = undefined + }, + MarkP#mark_params{cell_col_no = undefined, + row_no = undefined, + virtual_row_no = undefined, + marked_object = undefined, + marked_color = undefined + }; +update_marks(false, DataList, ColorList, MarkedRowData, + Pos, NofRowsShown, Writable, Range, PcPid, PgPid, RecPid, ToolP, MarkP) -> + #mark_params{cell_col_no = CellColNo, + virtual_row_no = VirtualRowNo} = MarkP, + + % Marked row data contains the color also! + {RowData, RowColors} = split_dblist(MarkedRowData, [], []), + + case VirtualRowNo of + undefined -> + MarkP; + _AnyRow -> + if + VirtualRowNo > element(2, Range) -> + %% Mark outside the existing list! Uh-uh, remove the mark immediately! 8-0 + update_marks(true, DataList, ColorList, MarkedRowData, Pos, NofRowsShown, + Writable, Range, PcPid, PgPid, RecPid, ToolP, MarkP); + true -> + {DataElement, RowObj} = choose_data_to_show(VirtualRowNo, CellColNo, RowData, + DataList, Pos), + {_, RowObjColor} = choose_data_to_show(VirtualRowNo, CellColNo, RowColors, + ColorList, Pos), + case DataElement of + notext -> + %% send_to_rec_edit(RecPid, insert_mode); + done; + _OtherElement -> + %% send_to_rec_edit(RecPid, {update_mode, RowObj}) + send_to_rec_edit(RecPid, {reset_info, RowObj}) + end, + + %% case RowObj of + %% OldMarkedObj -> + %% done; + %% _NewObj -> + %% update_toolbar_label(DataElement, ToolP, VirtualRowNo, + %% CellColNo, Writable) + %% end, + + %% update_toolbar_label(DataElement,ToolP,VirtualRowNo,CellColNo,Writable), + + update_toolbar_editor(ToolP#toolbar_params.editor_id, DataElement), + MarkP#mark_params{marked_object = RowObj, + marked_color = RowObjColor} + end + end. + + + + + +choose_data_to_show(VirtualRowNo, undefined, _RowData, DataList, Pos) when VirtualRowNo >= Pos, VirtualRowNo =< (Pos + length(DataList) - 1) -> + get_data_element(row, DataList, VirtualRowNo - Pos + 1, undefined); +choose_data_to_show(_VirtualRowNo, undefined, RowData, _DataList, _Pos) -> + get_data_element(row, RowData, 1, undefined); +choose_data_to_show(VirtualRowNo, CellColNo, _RowData, DataList, Pos) + when VirtualRowNo >= Pos, VirtualRowNo =< (Pos + length(DataList) - 1) -> + get_data_element(cell, DataList, VirtualRowNo - Pos + 1, CellColNo); +choose_data_to_show(_VirtualRowNo, CellColNo, RowData, _DataList, _Pos) -> + get_data_element(cell, RowData, 1, CellColNo). + + + + + + +get_new_scalepos(Btn, LastScalePos) -> + receive + {gs, _Id, click, _Data, [NewScalePos | _T]} -> + get_new_scalepos(Btn, NewScalePos); + + {gs, _Id, buttonrelease, _Data, [Btn | _T]} -> + LastScalePos; + + {gs, _Id, buttonrelease, _Data, _Args} -> + get_new_scalepos(Btn, LastScalePos); + + {gs, _Id, buttonpress, _Data, _Args} -> + get_new_scalepos(Btn, LastScalePos) + + end. + + + + + + + +split_dblist([], DataAcc, ColorAcc) -> + {lists:reverse(DataAcc), lists:reverse(ColorAcc)}; +split_dblist([{Data, Color} | Tail], DataAcc, ColorAcc) -> + split_dblist(Tail, [Data | DataAcc], [Color | ColorAcc]). + + + + + + + + +init_toolbar(FrameP, ToolP) -> + #frame_params{display_id = DispId, + toolbar_frame_id = TId, + toolbar_frame_width = TWidth, + toolbar_frame_height = THeight, + grid_frame_width = GWidth} = FrameP, + + NewToolP = init_toolbar_btns(TId, ToolP), + {RowColLblId, BgLabelId, FgLabelId, BtnId} = + init_toolbar_label(TId, TWidth, THeight, GWidth), + + PopUpFrame = gs:frame(TId, [{width, 80}, + {height, 20}, + {x, 0}, + {y, -30}, + {bg, {0, 0, 0}} + ]), + + PopUpLabel = gs:label(PopUpFrame, [{width, 78}, + {height, 18}, + {bg, {255,255,190}}, + {x,1}, + {y,1}, + {align, center}, + {label, {text,""}}, + {font,{screen,12}}]), + + {EditorFrameId, EditorId} = init_toolbar_editor(DispId, TWidth, THeight), + + NewToolP#toolbar_params{parent_id = TId, + row_col_label_id = RowColLblId, + bg_label_id = BgLabelId, + fg_label_id = FgLabelId, + label_btn_id = BtnId, + pop_up_frame_id = PopUpFrame, + pop_up_label_id = PopUpLabel, + editor_frame_id = EditorFrameId, + editor_id = EditorId + }. + + + + + + +init_toolbar_btns(TId, ToolP) -> + PicDir = code:priv_dir(tv), +% PicDir = "../priv", + % Toolbar btns are 25x25, the bitmaps are 20x20. + create_one_toolbar_btn(TId, 1, PicDir ++ "/edit1.xbm", + {toolbar, insert_object, "Edit Object"}), + create_one_toolbar_btn(TId, 3, PicDir ++ "/search.xbm", + {toolbar, search_object, "Search Object"}), + create_one_toolbar_btn(TId, 5, PicDir ++ "/sort.xbm", + {toolbar, sort_rising_order, "Sort Ascending"}), + create_one_toolbar_btn(TId, 6, PicDir ++ "/no_sort.xbm", + {toolbar, no_sorting,"No Sorting"}), + create_one_toolbar_btn(TId, 7, PicDir ++ "/sort_reverse.xbm", + {toolbar, sort_falling_order,"Sort Descending"}), + create_one_toolbar_btn(TId, 9, PicDir ++ "/poll.xbm", + {toolbar, poll_table,"Poll Table"}), + create_one_toolbar_btn(TId, 11, PicDir ++ "/info.xbm", + {toolbar, table_info,"Table Info"}), + create_one_toolbar_btn(TId, 13, PicDir ++ "/help.xbm", + {toolbar, help_button, "Help"}), + ToolP. + + + + + + + + +create_one_toolbar_btn(ParentId, N, Image, Data) -> + BtnWidth = 25, + BtnHeight = 25, + StartXpos = 0, + BtnXpos = StartXpos + ((N - 1) * BtnWidth), + BtnYpos = 2, + BgColor = ?DEFAULT_BG_COLOR, + FgColor = {178,34,34}, % Firebrick + + gs:button(ParentId, [{width, BtnWidth}, + {height, BtnHeight}, + {x, BtnXpos}, + {y, BtnYpos}, + {enter, true}, + {leave, true}, + {label, {image, Image}}, + {data, Data}, + {fg, FgColor}, + {bg, BgColor} + ]). + + + + + +resize_toolbar(FrameP, ToolP) -> + #frame_params{toolbar_frame_width = TWidth, + toolbar_frame_height = THeight, + grid_frame_width = GWidth} = FrameP, + + #toolbar_params{bg_label_id = BgId, + fg_label_id = FgId, + row_col_label_id = RowColId, + label_btn_id = BtnId, + editor_frame_id = FrId, + editor_id = EdId} = ToolP, + + resize_toolbar_label(BgId, FgId, RowColId, BtnId, TWidth, THeight, GWidth), + resize_toolbar_editor(FrId, EdId, TWidth, THeight), + ToolP. + + + + + + + + +init_toolbar_label(ParentId, ParentWidth, ParentHeight, GWidth) -> + {BgWidth, BgHeight, BgXpos, BgYpos, FgWidth, FgHeight, FgXpos, FgYpos, BtnWidth, + BtnHeight, BtnXpos, BtnYpos} = + get_toolbar_label_coords(ParentWidth, ParentHeight), + + BgId = gs:label(ParentId, [{width, BgWidth}, + {height, BgHeight}, + {x, BgXpos}, + {y, BgYpos}, + {bg, {0, 0, 0}}, + {fg, {0, 0, 0}} + ]), + + + RowColLblHeight = ?ROW_COL_LBL_HEIGHT, + RowColLblWidth = GWidth - ?VBTN_WIDTH, + RowColLblYpos = BgYpos + RowColLblHeight + 18, + + RowColLblId = gs:label(ParentId, [{width, RowColLblWidth}, + {height, RowColLblHeight}, + {x, ?VBTN_WIDTH}, + {y, RowColLblYpos}, + {bg, ?DEFAULT_BG_COLOR}, + {fg, {178,34,34}}, + {align,center}, + {font,{screen,12}}, + {label, {text,""}} + ]), + + FgId = gs:entry(editentry, ParentId, [{width, FgWidth}, + {height, FgHeight}, + {x, FgXpos}, + {y, FgYpos}, + {bg, {255,255,255}}, + {fg, {0,0,0}}, + {bw, 1}, + {font,{screen,12}}, + {justify, left}, + {cursor, arrow}, + {setfocus, false}, + {enable, false}, + {keypress,true} + ]), + + PicDir = code:priv_dir(tv), + BtnId = gs:button(ParentId, [{width, BtnWidth}, + {height, BtnHeight}, + {x, BtnXpos}, + {y, BtnYpos}, + {bg, ?DEFAULT_BG_COLOR}, + {fg, {0, 0, 0}}, + {label, {image, PicDir ++ "/more.xbm"}}, + {data, {labelbtn, pop_up}} + ]), + + {RowColLblId, BgId, FgId, BtnId}. + + + + + + + +init_toolbar_editor(DispId, TWidth, THeight) -> + {BgWidth, BgHeight, BgXpos, BgYpos, Width, Height, Xpos, Ypos} = + get_toolbar_editor_coords(TWidth, THeight), + + EditorFrame = gs:frame(DispId, [{width, BgWidth}, + {height, BgHeight}, + {x, BgXpos}, + {y, BgYpos}, + {bg, {0, 0, 0}} + ]), + + Editor = gs:editor(EditorFrame, [{width, Width}, + {height, Height}, + {x, Xpos}, + {y, Ypos}, + {vscroll, right}, + {wrap, word}, + {bg, {255, 255, 255}}, + {fg, {0, 0, 0}}, + {enable, false} + ]), + + {EditorFrame, Editor}. + + + + + + + +get_toolbar_editor_coords(TWidth, _THeight) -> + BgWidth = TWidth, + BgHeight = 200, + BgXpos = 0, + BgYpos = (-1) * BgHeight - 50, + FgWidth = BgWidth - 2, + FgHeight = BgHeight - 2, + FgXpos = 1, + FgYpos = 1, + + {BgWidth, BgHeight, BgXpos, BgYpos, FgWidth, FgHeight, FgXpos, FgYpos}. + + + + + + +resize_toolbar_editor(FrId, EdId, TWidth, THeight) -> + {BgWidth, BgHeight, _BgXpos, _BgYpos, FgWidth, FgHeight, _FgXpos, _FgYpos} = + get_toolbar_editor_coords(TWidth, THeight), + gs:config(FrId, [{width, BgWidth}, + {height, BgHeight} + ]), + + gs:config(EdId, [{width, FgWidth}, + {height, FgHeight} + ]). + + + + + + +resize_toolbar_label(BgId, FgId, RowColId, BtnId, ParentWidth, ParentHeight, GWidth) -> + {BgWidth, BgHeight, _BgXpos, _BgYpos, FgWidth, FgHeight, _FgXpos, _FgYpos, _BtnWidth, + _BtnHeight, BtnXpos, BtnYpos} = + get_toolbar_label_coords(ParentWidth, ParentHeight), + + gs:config(RowColId, [{width, GWidth - ?VBTN_WIDTH}]), + + gs:config(BgId, [{width, BgWidth}, + {height, BgHeight} + ]), + + gs:config(BtnId, [{x, BtnXpos}, + {y, BtnYpos} + ]), + + gs:config(FgId, [{width, FgWidth}, + {height, FgHeight} + ]). + + + + + +get_toolbar_label_coords(ParentWidth, ParentHeight) -> + BtnWidth = 19, + BgWidth = ParentWidth, + BgHeight = 26, + BgXpos = 0, + BgYpos = ParentHeight - BgHeight - 8 - ?ROW_COL_LBL_HEIGHT + 2, + FgHeight = BgHeight - 2, + FgWidth = BgWidth - BtnWidth - 3, + FgXpos = BgXpos + 1, + FgYpos = BgYpos + 1, + BtnHeight = BgHeight - 2, + BtnXpos = FgWidth + 2, + BtnYpos = BgYpos + 1, + + {BgWidth, BgHeight, BgXpos, BgYpos, FgWidth, FgHeight, FgXpos, FgYpos, BtnWidth, + BtnHeight, BtnXpos, BtnYpos}. + + + + + + +send_to_rec_edit(undefined, _Msg) -> + done; +send_to_rec_edit(RecPid, Msg) -> + RecPid ! Msg. + + + + diff --git a/lib/tv/src/tv_pd_frames.erl b/lib/tv/src/tv_pd_frames.erl new file mode 100644 index 0000000000..4e091ac9f0 --- /dev/null +++ b/lib/tv/src/tv_pd_frames.erl @@ -0,0 +1,480 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1997-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% +-module(tv_pd_frames). + + + +-export([create_display_frames/4, resize_display_frames/3]). + + + + +-include("tv_int_def.hrl"). +-include("tv_pd_int_def.hrl"). + + + + + + + +%%%********************************************************************* +%%% EXTERNAL FUNCTIONS +%%%********************************************************************* + + + + +%%====================================================================== +%% Function: +%% +%% Return Value: +%% +%% Description: +%% +%% Parameters: +%%====================================================================== + + +create_display_frames(WindowId, WindowWidth, WindowHeight, FrameP) -> + {DisplayId, DisplayWidth, DisplayHeight} = + create_frame(WindowId, + get_display_coords(WindowWidth, WindowHeight), + ?DEFAULT_BG_COLOR, + 0), + + {ToolbarId, ToolbarWidth, ToolbarHeight} = create_toolbar_frame(DisplayId, + DisplayWidth), + + {SheetFrameId, SheetBgFrameId, SheetFrameWidth, SheetFrameHeight} = + create_sheet_frames(DisplayId, + DisplayWidth, + DisplayHeight), + + {GridFrameId, GridBgFrameId, GridFrameWidth, GridFrameHeight} = + create_grid_frames(SheetFrameId, + SheetFrameWidth, + SheetFrameHeight), + + + FrameP#frame_params{display_id = DisplayId, + toolbar_frame_id = ToolbarId, + toolbar_frame_width = ToolbarWidth, + toolbar_frame_height = ToolbarHeight, + sheet_frame_id = SheetFrameId, + sheet_frame_width = SheetFrameWidth, + sheet_frame_height = SheetFrameHeight, + sheet_bgframe_id = SheetBgFrameId, + grid_frame_id = GridFrameId, + grid_frame_width = GridFrameWidth, + grid_frame_height = GridFrameHeight, + grid_bgframe_id = GridBgFrameId + }. + + + + + + + +%%====================================================================== +%% Function: +%% +%% Return Value: +%% +%% Description: +%% +%% Parameters: +%%====================================================================== + + +resize_display_frames(NewW, NewH, FrameP) -> + #frame_params{display_id = DispId, + toolbar_frame_id = ToolbarId, + sheet_frame_id = SheetFgId, + sheet_bgframe_id = SheetBgId, + grid_frame_id = GridFgId, + grid_bgframe_id = GridBgId} = FrameP, + + {NewDispW, NewDispH} = config_frame(DispId, get_display_coords(NewW, NewH)), + {NewToolW, NewToolH} = resize_toolbar(ToolbarId, NewDispW), + {NewSheetFgW, NewSheetFgH} = resize_sheet_frames(SheetFgId, SheetBgId, NewDispW, + NewDispH), + + {NewGridFgW, NewGridFgH} = resize_grid_frames(GridFgId, GridBgId, NewSheetFgW, + NewSheetFgH), + + FrameP#frame_params{toolbar_frame_width = NewToolW, + toolbar_frame_height = NewToolH, + sheet_frame_width = NewSheetFgW, + sheet_frame_height = NewSheetFgH, + grid_frame_width = NewGridFgW, + grid_frame_height = NewGridFgH + }. + + + + + + + + +%%%******************************************************************** +%%% INTERNAL FUNCTIONS +%%%******************************************************************** + + + + + +%%====================================================================== +%% Function: +%% +%% Return Value: +%% +%% Description: +%% +%% Parameters: +%%====================================================================== + + +config_frame(Id, {Width, Height, Xpos, Ypos}) -> + gs:config(Id, [{width, Width}, + {height, Height}, + {x, Xpos}, + {y, Ypos} + ]), + {Width, Height}. + + + + + + + +%%====================================================================== +%% Function: +%% +%% Return Value: +%% +%% Description: +%% +%% Parameters: +%%====================================================================== + + +create_frame(ParentId, {Width, Height, Xpos, Ypos}, Color, BorderWidth) -> + Id = gs:frame(ParentId, [{width, Width}, + {height, Height}, + {x, Xpos}, + {y, Ypos}, + {bw, BorderWidth}, + {bg, Color} + ]), + {Id, Width, Height}. + + + + + + + + + +%%====================================================================== +%% Function: +%% +%% Return Value: +%% +%% Description: +%% +%% Parameters: +%%====================================================================== + + +create_grid_frames(SheetFrameId, SheetFrameWidth, SheetFrameHeight) -> + {BgId, _W, _H} = + create_frame(SheetFrameId, + get_grid_frame_coords(bg, SheetFrameWidth, SheetFrameHeight), + ?BLACK, + 0), + {FgId, FgWidth, FgHeight} = + create_frame(SheetFrameId, + get_grid_frame_coords(fg, SheetFrameWidth, SheetFrameHeight), + ?DEFAULT_BG_COLOR, + 0), + {FgId, BgId, FgWidth, FgHeight}. + + + + + + + + +%%====================================================================== +%% Function: +%% +%% Return Value: +%% +%% Description: +%% +%% Parameters: +%%====================================================================== + + +create_sheet_frames(DispId, DispWidth, DispHeight) -> + {BgId, _W, _H} = create_frame(DispId, + get_sheet_frame_coords(bg, DispWidth, DispHeight), + ?BLACK, + 0), + {FgId, FgWidth, FgHeight} = + create_frame(DispId, + get_sheet_frame_coords(fg, DispWidth, DispHeight), + ?DEFAULT_BG_COLOR, + 0), + {FgId, BgId, FgWidth, FgHeight}. + + + + + + + +%%====================================================================== +%% Function: +%% +%% Return Value: +%% +%% Description: +%% +%% Parameters: +%%====================================================================== + + +create_toolbar_frame(DispId, DispWidth) -> + create_frame(DispId, get_toolbar_coords(DispWidth), ?DEFAULT_BG_COLOR, 0). + + + + + + + +%%====================================================================== +%% Function: +%% +%% Return Value: +%% +%% Description: +%% +%% Parameters: +%%====================================================================== + + +get_display_coords(WindowWidth, WindowHeight) -> + Xpos = 4, + {WindowWidth - 2 * Xpos, WindowHeight - ?MENUBAR_HEIGHT - Xpos, Xpos, ?MENUBAR_HEIGHT}. + + + + + + + + +%%====================================================================== +%% Function: +%% +%% Return Value: +%% +%% Description: +%% +%% Parameters: +%%====================================================================== + + +get_grid_frame_coords(bg, FrameWidth, FrameHeight) -> + get_grid_frame_coords2(FrameWidth, FrameHeight, 0); +get_grid_frame_coords(fg, FrameWidth, FrameHeight) -> + get_grid_frame_coords2(FrameWidth, FrameHeight, 1). + + + + + + + + +%%====================================================================== +%% Function: +%% +%% Return Value: +%% +%% Description: +%% +%% Parameters: +%%====================================================================== + + +get_grid_frame_coords2(FrameWidth, FrameHeight, BorderWidth) -> + Xpos = 0, + Ypos = 0, + Width = FrameWidth - ?VSCALE_WIDTH - Xpos - BorderWidth, + Height = FrameHeight - ?HSCALE_HEIGHT - Ypos - BorderWidth, + {Width, Height, Xpos, Ypos}. + + + + + + +%%====================================================================== +%% Function: +%% +%% Return Value: +%% +%% Description: +%% +%% Parameters: +%%====================================================================== + + +get_sheet_frame_coords(bg, FrameWidth, FrameHeight) -> + get_sheet_frame_coords2(FrameWidth, FrameHeight, 0); +get_sheet_frame_coords(fg, FrameWidth, FrameHeight) -> + get_sheet_frame_coords2(FrameWidth, FrameHeight, 1). + + + + + + + + +%%====================================================================== +%% Function: +%% +%% Return Value: +%% +%% Description: +%% +%% Parameters: +%%====================================================================== + + +get_sheet_frame_coords2(FrameWidth, FrameHeight, BorderWidth) -> + Xpos = BorderWidth, + Ypos = ?TOOLBAR_HEIGHT + BorderWidth, + Width = FrameWidth - 2 * BorderWidth, + Height = FrameHeight - Ypos - ?MISC_AREA_HEIGHT - BorderWidth, + {Width, Height, Xpos, Ypos}. + + + + + + + + +%%====================================================================== +%% Function: +%% +%% Return Value: +%% +%% Description: +%% +%% Parameters: +%%====================================================================== + + +get_toolbar_coords(DispWidth) -> + Xpos = 0, + {DispWidth - 2 * Xpos, ?TOOLBAR_HEIGHT, Xpos, 0}. + + + + + + + + + +%%====================================================================== +%% Function: +%% +%% Return Value: +%% +%% Description: +%% +%% Parameters: +%%====================================================================== + + +resize_grid_frames(FgId, BgId, ParentWidth, ParentHeight) -> + config_frame(BgId, get_grid_frame_coords(bg, ParentWidth, ParentHeight)), + config_frame(FgId, get_grid_frame_coords(fg, ParentWidth, ParentHeight)). + + + + + + + + + + +%%====================================================================== +%% Function: +%% +%% Return Value: +%% +%% Description: +%% +%% Parameters: +%%====================================================================== + + +resize_sheet_frames(FgId, BgId, ParentWidth, ParentHeight) -> + config_frame(BgId, get_sheet_frame_coords(bg, ParentWidth, ParentHeight)), + config_frame(FgId, get_sheet_frame_coords(fg, ParentWidth, ParentHeight)). + + + + + + + + + +%%====================================================================== +%% Function: +%% +%% Return Value: +%% +%% Description: +%% +%% Parameters: +%%====================================================================== + + +resize_toolbar(Id, DispWidth) -> + config_frame(Id, get_toolbar_coords(DispWidth)). + + + diff --git a/lib/tv/src/tv_pd_int_def.hrl b/lib/tv/src/tv_pd_int_def.hrl new file mode 100644 index 0000000000..2c76bef892 --- /dev/null +++ b/lib/tv/src/tv_pd_int_def.hrl @@ -0,0 +1,139 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1997-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% +%%%********************************************************************* +%%% +%%% Description: Internal definitions for the pd part of the table tool. +%%% +%%%********************************************************************* + +-define(SCALE_FUNC_FILE, tv_pd_scale). +-define(DISP_FUNC_FILE, tv_pd_display). + + +-define(SCALE_WIDTH, 75). +-define(VSCALE_WIDTH, 75). +-define(HSCALE_HEIGHT, 75). +-define(MENUBAR_HEIGHT, 30). +-define(TOOLBAR_HEIGHT, 84). %% 97 +-define(DISPLAY_HEIGHT, 849). +-define(MISC_AREA_HEIGHT, 0). +-define(GRID_HEIGHT, 849). +-define(NOF_GRIDROWS, 35). %% 29 +-define(NOF_GRIDCOLS, 10). +-define(DEFAULT_COLWIDTH, 100). +-define(ROW_HEIGHT, 20). %% 24 +-define(VBTN_WIDTH, 55). %% 18 +-define(HBTN_HEIGHT, 20). +-define(RESBTN_WIDTH, 5). +-define(DEFAULT_GRID_BGCOLOR, {255,255,255}). +-define(DEFAULT_GRID_FGCOLOR, {0,0,0}). +-define(GRID_MARK_COLOR, {0,255,255}). +-define(GRID_FONT, {courier,12}). + +-define(ROW_COL_LBL_WIDTH, 140). +-define(ROW_COL_LBL_HEIGHT, 14). + + + +-define(KEY_MARK_AREA_HEIGHT, 21). + + +-define(DEFAULT_BG_COLOR, {217,217,217}). +-define(DEFAULT_ROW_COLOR, {178,34,34}). % Firebrick! +-define(DEFAULT_GRID_COLOR, {0,0,0}). +-define(LIGHT_GRAY, {226,226,226}). +-define(DARK_VIOLET, {148,0,211}). +-define(FIREBRICK, {178,34,34}). +-define(ANTIQUE_WHITE, {255,255,235}). + + +-record(frame_params, {display_id, + toolbar_frame_id, + toolbar_frame_width, + toolbar_frame_height, + sheet_frame_id, + sheet_frame_width, + sheet_frame_height, + sheet_bgframe_id, + grid_frame_id, + grid_frame_width, + grid_frame_height, + grid_bgframe_id + }). + + + + +-record(scale_params, {vscale_id, + vscale_pos = 0, + hscale_id, + hscale_pos = 0 + }). + + + + +-record(mark_params, {cell_id, + cell_col_no, % Virtual number! + row_no, % Real number! + virtual_row_no, + col_no, % Virtual number! + sort_col_no, + marked_object, + marked_color + }). + + + +-record(toolbar_params, {parent_id, + row_col_label_id, + bg_label_id, + fg_label_id, + label_btn_id, + pop_up_frame_id, + pop_up_label_id, + editor_frame_id, + editor_id + }). + + +-record(process_variables, {master_pid, + pg_pid, + pb_pid, + rec_pid, + window_id, + window_width, + window_height, + initialising = true, + table_type, + table_name, + record_name, + writable = false, + lists_as_strings = true, + sorting_on = false, + first_col_shown = 1, + first_row_shown = 1, + nof_rows_shown, + cols_shown = [], + data_list = [], + color_list = [], + frame_params = #frame_params{}, + scale_params = #scale_params{}, + mark_params = #mark_params{}, + toolbar_params = #toolbar_params{} + }). diff --git a/lib/tv/src/tv_pd_int_msg.hrl b/lib/tv/src/tv_pd_int_msg.hrl new file mode 100644 index 0000000000..faf23a9376 --- /dev/null +++ b/lib/tv/src/tv_pd_int_msg.hrl @@ -0,0 +1,433 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1997-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% + + +%%%********************************************************************* +%%% MESSAGES OWNED BY PG +%%%********************************************************************* + + + +%%====================================================================== +%% Message: +%% +%% Function: +%% +%% Data: +%%====================================================================== + + +-record(pg_init_grid, {sender, + parent_id, + width, + height, + xpos, + ypos, + nof_rows, + row_height + }). + + + +-record(pg_list_info, {sender, + lists_as_strings}). + + +%%====================================================================== +%% Message: +%% +%% Function: +%% +%% Data: +%%====================================================================== + + +-record(pg_col_info, {sender, + first_col_shown, + width_of_cols_shown, + nof_rows_shown + }). + + + + + +%%====================================================================== +%% Message: +%% +%% Function: +%% +%% Data: +%%====================================================================== + + +-record(pg_col_marked, {sender, + virtual_col + }). + + + + + + +%%====================================================================== +%% Message: +%% +%% Function: +%% +%% Data: +%%====================================================================== + + +-record(pg_row_marked, {sender, + virtual_row + }). + + + + + + + +%%====================================================================== +%% Message: +%% +%% Function: +%% +%% Data: +%%====================================================================== + +-record(pg_data, {sender, + data, + first_row_shown + }). + + + + + + +%%====================================================================== +%% Message: +%% +%% Function: +%% +%% Data: +%%====================================================================== + +-record(pg_cell_marked, {sender, + cell_marked, % true or false + real_col, + real_row, + virtual_col, + virtual_row, + cell_text + }). + + + + +%%====================================================================== +%% Message: +%% +%% Function: +%% +%% Data: +%%====================================================================== + +-record(pg_resize_grid, {sender, + width, + height + }). + + + + +%%====================================================================== +%% Message: +%% +%% Function: +%% +%% Data: +%%====================================================================== + +-record(pg_resize_grid_col, {sender, + real_col_no, + virtual_col_no, + xdiff + }). + + + + + +%%====================================================================== +%% Message: +%% +%% Function: +%% +%% Data: +%%====================================================================== + +-record(pg_horizontal_scroll, {sender, + leftmost_virtual_col + }). + + + + + +%%====================================================================== +%% Message: +%% +%% Function: +%% +%% Data: +%%====================================================================== + + +-record(pg_ready, {sender}). + + + + + +%%====================================================================== +%% Message: +%% +%% Function: +%% +%% Data: +%%====================================================================== + + +-record(pg_remove_marks, {sender}). + + + + + +%%====================================================================== +%% Message: +%% +%% Function: +%% +%% Data: +%%====================================================================== + + +-record(pg_mark_col, {sender, + virtual_col, + real_col + }). + + + + + +%%====================================================================== +%% Message: +%% +%% Function: +%% +%% Data: +%%====================================================================== + + +-record(pg_mark_row, {sender, + virtual_row, + real_row + }). + + + + + + +%%%********************************************************************* +%%% MESSAGES OWNED BY PB +%%%********************************************************************* + + + +%%====================================================================== +%% Message: +%% +%% Function: +%% +%% Data: +%%====================================================================== + +-record(pb_init_btns, {sender, + parent_id, + parent_width, + parent_height, + ypos, + hbtn_height, + resbtn_width, + vbtn_width, + nof_rows, + row_height, + first_col_shown, + cols_shown + }). + + + + +%%====================================================================== +%% Message: +%% +%% Function: +%% +%% Data: +%%====================================================================== + + +-record(pb_remove_marks, {sender}). + + + + + +%%====================================================================== +%% Message: +%% +%% Function: +%% +%% Data: +%%====================================================================== + + +-record(pb_update_hbtns, {sender, + parent_width, + parent_height, + first_col_shown, + cols_shown + }). + + + + +%%====================================================================== +%% Message: +%% +%% Function: +%% +%% Data: +%%====================================================================== + + +-record(pb_update_vbtns, {sender, + color_list, + first_row_shown, + nof_rows_shown, + blinking_enabled + }). + + + + + +%%====================================================================== +%% Message: +%% +%% Function: +%% +%% Data: +%%====================================================================== + + +-record(pb_key_info, {sender, + list_of_keys + }). + + + + +%%====================================================================== +%% Message: +%% +%% Function: +%% +%% Data: +%%====================================================================== + + +-record(pb_new_colwidth, {sender, + real_col, + virtual_col, + xdiff + }). + + + + + +%%====================================================================== +%% Message: +%% +%% Function: +%% +%% Data: +%%====================================================================== + + +-record(pb_col_marked, {sender, + col_marked, % 'true' or 'false' + real_col, + virtual_col + }). + + + + +%%====================================================================== +%% Message: +%% +%% Function: +%% +%% Data: +%%====================================================================== + + +-record(pb_row_marked, {sender, + row_marked, % 'true' or 'false' + real_row, + virtual_row + }). + + + + +%%====================================================================== +%% Message: +%% +%% Function: +%% +%% Data: +%%====================================================================== + + +-record(pb_set_sort_col, {sender, + virtual_col + }). + + + + diff --git a/lib/tv/src/tv_pd_scale.erl b/lib/tv/src/tv_pd_scale.erl new file mode 100644 index 0000000000..c94e57f468 --- /dev/null +++ b/lib/tv/src/tv_pd_scale.erl @@ -0,0 +1,303 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1997-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% +%%%********************************************************************* +%%% +%%% Description: Part of pd controlling the scale, i.e., the scrollbar +%%% imitation. +%%% +%%%********************************************************************* + + +-module(tv_pd_scale). + + + +-export([init_scale/2, + resize_scale/2, + set_scale_range/3, + set_scale_pos/3]). + + + +-include("tv_int_def.hrl"). +-include("tv_pd_int_def.hrl"). + + + + + + +%%%********************************************************************* +%%% EXTERNAL FUNCTIONS +%%%********************************************************************* + + + + +%%====================================================================== +%% Function: +%% +%% Return Value: +%% +%% Description: +%% +%% Parameters: +%%====================================================================== + + +init_scale(FrameP, ScaleP) -> + #frame_params{sheet_frame_id = SheetFrameId, + sheet_frame_width = SheetFrameWidth, + sheet_frame_height = SheetFrameHeight, + grid_frame_width = GridFrameWidth, + grid_frame_height = GridFrameHeight} = FrameP, + + VScaleId = create_scale(vscale, SheetFrameId, SheetFrameWidth, GridFrameHeight), + HScaleId = create_scale(hscale, SheetFrameId, GridFrameWidth, SheetFrameHeight), + + ScaleP#scale_params{vscale_id = VScaleId, + vscale_pos = 0, + hscale_id = HScaleId, + hscale_pos = 0 + }. + + + + + + + +%%====================================================================== +%% Function: +%% +%% Return Value: +%% +%% Description: +%% +%% Parameters: +%%====================================================================== + + +resize_scale(FrameP, ScaleP) -> + #frame_params{sheet_frame_width = SheetFrameWidth, + sheet_frame_height = SheetFrameHeight, + grid_frame_width = GridFrameWidth, + grid_frame_height = GridFrameHeight} = FrameP, + + #scale_params{vscale_id = VScaleId, + hscale_id = HScaleId} = ScaleP, + + config_scale(vscale, VScaleId, SheetFrameWidth, GridFrameHeight), + config_scale(hscale, HScaleId, GridFrameWidth, SheetFrameHeight), + ScaleP. + + + + + + + + + +%%====================================================================== +%% Function: +%% +%% Return Value: +%% +%% Description: +%% +%% Parameters: +%%====================================================================== + + +set_scale_range(vscale, Range, ScaleP) -> + {Lo, Hi} = Range, + NewRange = if + Lo > Hi -> + {Hi, Hi}; + true -> + Range + end, + VScaleId = ScaleP#scale_params.vscale_id, + gs:config(VScaleId, [{range, NewRange}]); +set_scale_range(hscale, Range, ScaleP) -> + {Lo, Hi} = Range, + NewRange = if + Lo > Hi -> + {Hi, Hi}; + true -> + Range + end, + HScaleId = ScaleP#scale_params.hscale_id, + gs:config(HScaleId, [{range, NewRange}]). + + + + + + + + +%%====================================================================== +%% Function: +%% +%% Return Value: +%% +%% Description: +%% +%% Parameters: +%%====================================================================== + + +set_scale_pos(_ScaleName, undefined, ScaleP) -> + ScaleP; +set_scale_pos(vscale, NewPos, ScaleP) -> + ScaleId = ScaleP#scale_params.vscale_id, + gs:config(ScaleId, [{pos, NewPos}]), + ScaleP#scale_params{vscale_pos = NewPos}; +set_scale_pos(hscale, NewPos, ScaleP) -> + ScaleId = ScaleP#scale_params.hscale_id, + gs:config(ScaleId, [{pos, NewPos}]), + ScaleP#scale_params{hscale_pos = NewPos}. + + + + + + + +%%%******************************************************************** +%%% INTERNAL FUNCTIONS +%%%******************************************************************** + + + + + + +%%====================================================================== +%% Function: +%% +%% Return Value: +%% +%% Description: +%% +%% Parameters: +%%====================================================================== + + +config_scale(ScaleName, ScaleId, FrameWidth, FrameHeight) -> + {Width, Height, Xpos, Ypos} = get_scale_coords(ScaleName, + FrameWidth, + FrameHeight), + gs:config(ScaleId, [{height, Height}, + {width, Width}, + {x, Xpos}, + {y, Ypos} + ]). + + + + + + + + + +%%====================================================================== +%% Function: +%% +%% Return Value: +%% +%% Description: +%% +%% Parameters: +%%====================================================================== + + +create_scale(ScaleName, FrameId, FrameWidth, FrameHeight) -> + {Width, Height, Xpos, Ypos} = get_scale_coords(ScaleName, + FrameWidth, + FrameHeight), + {Orientation, Range} = case ScaleName of + vscale -> + {vertical, {1, 1}}; + hscale -> + {horizontal, {1, 1}} + end, + gs:scale(FrameId, [{data, ScaleName}, + {orient, Orientation}, + {buttonpress, true}, + {buttonrelease, true}, + {height, Height}, + {width, Width}, + {x, Xpos}, + {y, Ypos}, + {bg, ?DEFAULT_BG_COLOR}, + {fg, {0, 0, 0}}, + {range, Range} + ]). + + + + + + + +%%====================================================================== +%% Function: +%% +%% Return Value: +%% +%% Description: +%% +%% Parameters: +%%====================================================================== + + +get_scale_coords(hscale, FrameWidth, FrameHeight) -> + Height = ?HSCALE_HEIGHT, + Xpos = ?VBTN_WIDTH - 3, % Subtracting 3 makes it look better! + Ypos = FrameHeight - Height, + Width = FrameWidth - Xpos + 5, % Adding 5 for better look! + {Width, Height, Xpos, Ypos}; +get_scale_coords(vscale, FrameWidth, FrameHeight) -> + Width = ?VSCALE_WIDTH, + Xpos = (FrameWidth - Width), + Ypos = ?HBTN_HEIGHT - 3, % Subtracting 3 makes it look better! + Height = FrameHeight - Ypos + 5, % Adding 5 for better look! + {Width, Height, Xpos, Ypos}. + + + + + + + + + + + + + + + + + + + diff --git a/lib/tv/src/tv_pg.erl b/lib/tv/src/tv_pg.erl new file mode 100644 index 0000000000..ba8782392b --- /dev/null +++ b/lib/tv/src/tv_pg.erl @@ -0,0 +1,429 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1997-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% +-module(tv_pg). + + + +-export([pg/1]). + + +-include("tv_int_def.hrl"). +-include("tv_pg_int_def.hrl"). +-include("tv_pd_int_msg.hrl"). + + + + + + + + +%%%********************************************************************* +%%% EXTERNAL FUNCTIONS +%%%********************************************************************* + + + + +%%====================================================================== +%% Function: pg. +%% +%% Return Value: None. +%% +%% Description: Process controlling the grid part of the display. +%% +%% Parameters: None. +%%====================================================================== + + +pg(ParentPid) -> + process_flag(trap_exit, true), + ProcVars = #process_variables{parent_pid = ParentPid}, + loop(ProcVars). + + + + + + + +%%%******************************************************************** +%%% INTERNAL FUNCTIONS +%%%******************************************************************** + + + + + +%%====================================================================== +%% Function: loop. +%% +%% Return Value: None. +%% +%% Description: Eternal (well, almost) loop, receiving messages and +%% handling them. +%% +%% Parameters: +%%====================================================================== + + + +loop(ProcVars) -> + receive + Msg -> + case Msg of + + + #pg_data{} -> + GridId = mark_busy(ProcVars), + NewProcVars = update_grid_data(Msg, ProcVars), + mark_nonbusy(GridId), + loop(NewProcVars); + + #pg_list_info{lists_as_strings=ListAsStr} -> + NewProcVars = tv_pg_gridfcns:handle_list_info(ListAsStr, ProcVars), + loop(NewProcVars); + + #pg_horizontal_scroll{} -> + GridId = mark_busy(ProcVars), + NewProcVars = scroll_grid_horizontally(Msg, ProcVars), + mark_nonbusy(GridId), + loop(NewProcVars); + + #pg_remove_marks{} -> + GridId = mark_busy(ProcVars), + NewProcVars = tv_pg_gridfcns:remove_marks(ProcVars), + mark_nonbusy(GridId), + loop(NewProcVars); + + #pg_col_marked{} -> + GridId = mark_busy(ProcVars), + NewProcVars = mark_grid_col(Msg, ProcVars), + mark_nonbusy(GridId), + loop(NewProcVars); + + #pg_row_marked{} -> + GridId = mark_busy(ProcVars), + NewProcVars = mark_grid_row(Msg, ProcVars), + mark_nonbusy(GridId), + loop(NewProcVars); + + #pg_resize_grid_col{} -> + GridId = mark_busy(ProcVars), + NewProcVars = resize_grid_column(Msg, ProcVars), + mark_nonbusy(GridId), + loop(NewProcVars); + + #pg_resize_grid{} -> + GridId = mark_busy(ProcVars), + NewProcVars = resize_grid(Msg, ProcVars), + mark_nonbusy(GridId), + loop(NewProcVars); + + #pg_init_grid{} -> + GridId = mark_busy(ProcVars), + NewProcVars = init_grid(Msg, ProcVars), + mark_nonbusy(GridId), + PdPid = ProcVars#process_variables.parent_pid, + PdPid ! #pg_ready{sender = self()}, + loop(NewProcVars); + + {gs, Id, Event, Data, Args} -> + GridId = mark_busy(ProcVars), + NewProcVars = gs_messages({Id, Event, Data, Args}, ProcVars), + mark_nonbusy(GridId), + loop(NewProcVars); + + + {'EXIT', Pid, Reason} -> + ParentPid = ProcVars#process_variables.parent_pid, + exit_signals({Pid, Reason}, ParentPid, ProcVars), + loop(ProcVars); + + _Other -> + loop(ProcVars) + end + end. + + + + + + + + +%%====================================================================== +%% Function: +%% +%% Return Value: +%% +%% Description: +%% +%% Parameters: +%%====================================================================== + + +exit_signals(ExitInfo, ParentPid, _ProcVars) -> + case ExitInfo of + {ParentPid, _Reason} -> + exit(normal); + _Other -> + done + end. + + + + + + + + + +%%====================================================================== +%% Function: +%% +%% Return Value: +%% +%% Description: +%% +%% Parameters: +%%====================================================================== + + +gs_messages(Msg, ProcVars) -> + + case Msg of + + {Id, buttonpress, {gridcell, RealCol, RealRow, _FrameId}, [1 | _]} -> + NewProcVars = tv_pg_gridfcns:mark_cell_and_notify(Id, RealCol, + RealRow, ProcVars), + NewProcVars; + + + _OtherMessage -> + ProcVars + + end. + + + + + + + +%%====================================================================== +%% Function: +%% +%% Return Value: +%% +%% Description: +%% +%% Parameters: +%%====================================================================== + + +init_grid(Msg, ProcVars) -> + #pg_init_grid{parent_id = ParentId, + width = Width, + height = Height, + xpos = Xpos, + ypos = Ypos, + nof_rows = NofRows, + row_height = RowHeight} = Msg, + tv_pg_gridfcns:init_grid(ParentId, Width, Height, Xpos, Ypos, NofRows, + RowHeight, ProcVars). + + + + + + + + + +%%====================================================================== +%% Function: +%% +%% Return Value: +%% +%% Description: +%% +%% Parameters: +%%====================================================================== + + +resize_grid(Msg, ProcVars) -> + #pg_resize_grid{width = Width, + height = Height} = Msg, + tv_pg_gridfcns:resize_grid(Width, Height, ProcVars). + + + + + + + + + + +%%====================================================================== +%% Function: +%% +%% Return Value: +%% +%% Description: +%% +%% Parameters: +%%====================================================================== + + +resize_grid_column(Msg, ProcVars) -> + #pg_resize_grid_col{real_col_no = RealCol, + virtual_col_no = VirtualCol, + xdiff = Xdiff} = Msg, + tv_pg_gridfcns:resize_grid_column(RealCol, VirtualCol, Xdiff, ProcVars). + + + + + + + +%%====================================================================== +%% Function: +%% +%% Return Value: +%% +%% Description: +%% +%% Parameters: +%%====================================================================== + + +scroll_grid_horizontally(Msg, ProcVars) -> + FirstColShown = ?COMM_FUNC_FILE:max(1, Msg#pg_horizontal_scroll.leftmost_virtual_col), + tv_pg_gridfcns:scroll_grid_horizontally(FirstColShown, ProcVars). + + + + + +%%====================================================================== +%% Function: +%% +%% Return Value: +%% +%% Description: +%% +%% Parameters: +%%====================================================================== + + +update_grid_data(Msg, ProcVars) -> + #pg_data{data = Data, + first_row_shown = FirstRowShown} = Msg, + tv_pg_gridfcns:update_grid_data(Data, FirstRowShown, ProcVars). + + + + + + + + + + +%%====================================================================== +%% Function: +%% +%% Return Value: +%% +%% Description: +%% +%% Parameters: +%%====================================================================== + + +mark_grid_col(Msg, ProcVars) -> + #pg_col_marked{virtual_col = VirtualCol} = Msg, + tv_pg_gridfcns:mark_col(VirtualCol, ProcVars). + + + + + + + +%%====================================================================== +%% Function: +%% +%% Return Value: +%% +%% Description: +%% +%% Parameters: +%%====================================================================== + + +mark_grid_row(Msg, ProcVars) -> + #pg_row_marked{virtual_row = VirtualRow} = Msg, + tv_pg_gridfcns:mark_row(VirtualRow, ProcVars). + + + + + + + +%%====================================================================== +%% Function: +%% +%% Return Value: +%% +%% Description: +%% +%% Parameters: +%%====================================================================== + + +mark_busy(ProcVars) -> + GridP = ProcVars#process_variables.grid_params, + GridId = GridP#grid_params.fg_frame, + gs:config(GridId, [{cursor, busy}]), + GridId. + + + + + + + +%%====================================================================== +%% Function: +%% +%% Return Value: +%% +%% Description: +%% +%% Parameters: +%%====================================================================== + + +mark_nonbusy(GridId) -> + gs:config(GridId, [{cursor, arrow}]). + diff --git a/lib/tv/src/tv_pg_gridfcns.erl b/lib/tv/src/tv_pg_gridfcns.erl new file mode 100644 index 0000000000..809403fd96 --- /dev/null +++ b/lib/tv/src/tv_pg_gridfcns.erl @@ -0,0 +1,1939 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1997-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% +-module(tv_pg_gridfcns). + + + + +-export([init_grid/8, + resize_grid/3, + resize_grid_column/4, + update_grid_data/3, + scroll_grid_horizontally/2, + mark_cell_and_notify/4, + remove_marks/1, + mark_col/2, + mark_row/2, + handle_list_info/2 + ]). + + + + + +-include("tv_pd_int_msg.hrl"). +-include("tv_pg_int_def.hrl"). + + + + + + + +%%%********************************************************************* +%%% EXTERNAL FUNCTIONS +%%%********************************************************************* + + + + +%%====================================================================== +%% Function: +%% +%% Return Value: +%% +%% Description: +%% +%% Parameters: +%%====================================================================== + + +init_grid(GridParentId, GridWidth, + GridHeight, GridXpos, GridYpos, NofRows, RowHeight, ProcVars) -> + + % Get the size and ID of the grid-parent frame, i.e., the + % grid-frame! Do not confuse the base-frames below with + % the grid-frame! + + #process_variables{parent_pid = ParentPid, + grid_params = GridP} = ProcVars, + + #grid_params{fg_color = GridFgColor, + nof_cols = NofCols, + col_width = DefaultColWidth, + first_col_shown = FirstColShown, + col_widths = ColWidths} = GridP, + + % Create the two frames the column frames are placed on! + % These two frames defines the size of the grid. + BgFrame = create_base_frame(GridParentId, GridWidth, GridHeight, + GridXpos, GridYpos, GridFgColor), + FgFrame = create_base_frame(BgFrame, GridWidth - 1, GridHeight - 1, + 0, 0, GridFgColor), + + % Compute the the colwidths necessary to cover the grid. + ColsShown = compute_cols_shown(FirstColShown, ColWidths, GridWidth, NofCols, + DefaultColWidth), + NofRowsShown = compute_rows_shown(GridHeight, RowHeight), + + % Tell parent about the width of columns shown! + ParentPid ! #pg_col_info{sender = self(), + first_col_shown = FirstColShown, + width_of_cols_shown = ColsShown, + nof_rows_shown = NofRowsShown + }, + + NewNofCols = max(length(ColsShown), NofCols), + + % The GridColWidths list shall contain the current width of each frame. + NewColWidths = update_col_widths(ColsShown, ColWidths, FirstColShown, + DefaultColWidth), + + % Create column frames, one for each column, and rows (labels) on each frame. + {FrameIdList, ColLabelList} = create_col_frames(NewNofCols, NofRows, RowHeight, + FgFrame, GridP, [], []), + + % Get lists of label-ID's for each row. (When we created the column frames, + % we got the id's of labels placed on each column, i.e., vertically. + % However, most often we want the id's for one row, i.e., label id's + % horisontally.) + RowIdList = get_row_ids(NofRows, ColLabelList, []), + + % Update the grid_params record with the new values! + NewGridP = GridP#grid_params{bg_frame = BgFrame, + fg_frame = FgFrame, + grid_width = GridWidth, + grid_height = GridHeight, + grid_xpos = GridXpos, + grid_ypos = GridYpos, + nof_cols = NewNofCols, + col_widths = NewColWidths, + cols_shown = ColsShown, + nof_rows = NofRows, + row_height = RowHeight, + nof_rows_shown = NofRowsShown, + col_frame_ids = FrameIdList, + col_ids = ColLabelList, + row_ids = RowIdList, + row_data_list = lists:duplicate(NofRows, notext) + }, + + ProcVars#process_variables{grid_parent_id = GridParentId, + grid_params = NewGridP}. + + + + + + + + + + +%%====================================================================== +%% Function: +%% +%% Return Value: +%% +%% Description: +%% +%% Parameters: +%%====================================================================== + + +resize_grid(NewWidth, NewHeight, ProcVars) -> + #process_variables{parent_pid = ParentPid, + grid_params = GridP, + mark_params = MarkP} = ProcVars, + + #grid_params{bg_frame = BgFrame, + fg_frame = FgFrame, + nof_cols = NofCols, + nof_rows = NofRows, + col_width = DefaultColWidth, + first_col_shown = FirstColShown, + col_widths = ColWidths, + row_height = RowHeight, + col_frame_ids = ColFrameIds, + col_ids = ColIds, + row_ids = RowIds, + bg_color = BgColor, + fg_color = FgColor, + row_data_list = RowDataList, + lists_as_strings = ListAsStr} = GridP, + + gs:config(BgFrame, [{width, NewWidth}, + {height, NewHeight} + ]), + gs:config(FgFrame, [{width, NewWidth - 1}, + {height, NewHeight - 1} + ]), + + ColsShown = compute_cols_shown(FirstColShown, ColWidths, NewWidth, NofCols, + DefaultColWidth), + + NofRowsShown = compute_rows_shown(NewHeight, RowHeight), + + + % Tell parent about the width of columns shown! + ParentPid ! #pg_col_info{sender = self(), + first_col_shown = FirstColShown, + width_of_cols_shown = ColsShown, + nof_rows_shown = NofRowsShown + }, + + NewColWidths = update_col_widths(ColsShown, ColWidths, FirstColShown, + DefaultColWidth), + + NofColsShown = length(ColsShown), + {NewNofCols, NewColFrameIds, NewColIds, NewRowIds} = + check_nof_cols(ColsShown, (NofColsShown - NofCols), ColFrameIds, ColIds, + RowIds, NofRows, RowHeight, FgColor, BgColor ), + + clear_fields(lists:nthtail(NofColsShown, NewColIds), + lists:nthtail(NofRowsShown, NewRowIds)), + + RowsToUpdate = lists:sublist(NewRowIds, NofRowsShown), + + refresh_visible_rows(RowsToUpdate, FirstColShown, NofColsShown, RowDataList, ListAsStr), + + NewGridP = GridP#grid_params{grid_width = NewWidth, + grid_height = NewHeight, + nof_cols = NewNofCols, + nof_rows_shown = NofRowsShown, + cols_shown = ColsShown, + col_widths = NewColWidths, + col_frame_ids = NewColFrameIds, + col_ids = NewColIds, + row_ids = NewRowIds + }, + + refresh_marks(NewGridP, MarkP), + + ProcVars#process_variables{grid_params = NewGridP}. + + + + + + + + + +%%====================================================================== +%% Function: +%% +%% Return Value: +%% +%% Description: +%% +%% Parameters: +%%====================================================================== + + +resize_grid_column(RealCol, VirtualCol, Xdiff, ProcVars) -> + #process_variables{parent_pid = ParentPid, + grid_params = GridP, + mark_params = MarkP} = ProcVars, + + #grid_params{grid_width = GridWidth, + first_col_shown = FirstColShown, + nof_cols = NofCols, + col_widths = ColWidths, + col_frame_ids = ColFrameIds, + col_ids = ColIds, + col_width = DefaultColWidth, + row_ids = RowIds, + max_col_width = MaxColWidth, + min_col_width = MinColWidth, + nof_rows = NofRows, + nof_rows_shown = NofRowsShown, + row_height = RowHeight, + bg_color = BgColor, + fg_color = FgColor, + row_data_list = RowDataList, + lists_as_strings = ListAsStr} = GridP, + + % Get new width! + Width = min(MaxColWidth, max((lists:nth(VirtualCol, ColWidths) + Xdiff), + MinColWidth)), + + % Resize the column. + NewWidthOfCol = resize_one_column(RealCol, Width, ColFrameIds, MaxColWidth, + MinColWidth), + + % Update the ColWidths list. + TempColWidths = lists:sublist(ColWidths, VirtualCol - 1) ++ + [NewWidthOfCol | lists:nthtail(VirtualCol, ColWidths)], + + % Check the other columns, whether a new column has to be created. + ColsShown = compute_cols_shown(FirstColShown, TempColWidths, GridWidth, + NofCols, DefaultColWidth), + + % Get the final ColWidths list, after all updates! + NewColWidths = update_col_widths(ColsShown, TempColWidths, FirstColShown, + DefaultColWidth), + + % Tell parent about the width of columns shown! + ParentPid ! #pg_col_info{sender = self(), + first_col_shown = FirstColShown, + width_of_cols_shown = ColsShown, + nof_rows_shown = NofRowsShown + }, + + % Get the new number of columns (may have changed). + NofColsShown = length(ColsShown), + {NewNofCols, NewColFrameIds, NewColIds, NewRowIds} = + check_nof_cols(ColsShown, (NofColsShown - NofCols), ColFrameIds, ColIds, + RowIds, NofRows, RowHeight, FgColor, BgColor ), + + RowsToUpdate = lists:sublist(NewRowIds, NofRowsShown), + refresh_visible_rows(RowsToUpdate, FirstColShown, NofColsShown, RowDataList, ListAsStr), + + NewGridP = GridP#grid_params{nof_cols = NewNofCols, + cols_shown = ColsShown, + col_widths = NewColWidths, + col_frame_ids = NewColFrameIds, + col_ids = NewColIds, + row_ids = NewRowIds + }, + + refresh_marks(NewGridP, MarkP), + + ProcVars#process_variables{grid_params = NewGridP}. + + + + + + + + +%%====================================================================== +%% Function: +%% +%% Return Value: +%% +%% Description: +%% +%% Parameters: +%%====================================================================== + + +handle_list_info(ListAsStr, ProcVars) -> + #process_variables{grid_params = GridP} = ProcVars, + + #grid_params{first_col_shown = FirstColShown, + cols_shown = ColsShown, + nof_rows_shown = NofRowsShown, + row_data_list = RowDataList, + row_ids = RowIds, + lists_as_strings = OldListAsStr} = GridP, + + case ListAsStr of + OldListAsStr -> + ProcVars; + _NewValue -> + NofColsShown = length(ColsShown), + RowsToUpdate = lists:sublist(RowIds, NofRowsShown), + refresh_visible_rows(RowsToUpdate, FirstColShown, NofColsShown, + RowDataList, ListAsStr), + NewGridP = GridP#grid_params{lists_as_strings = ListAsStr}, + ProcVars#process_variables{grid_params = NewGridP} + end. + + + + +update_grid_data(Data, FirstRowShown, ProcVars) -> + #process_variables{grid_params = GridP, + mark_params = MarkP} = ProcVars, + + #grid_params{first_col_shown = FirstColShown, + cols_shown = ColsShown, + nof_rows = NofRows, + nof_rows_shown = NofRowsShown, + row_ids = RowIds, + lists_as_strings = ListAsStr} = GridP, + + NofColsShown = length(ColsShown), + RowsToUpdate = lists:sublist(RowIds, NofRowsShown), + + NewMarkP = move_marks(FirstColShown, FirstRowShown, GridP, MarkP), + + update_visible_rows(RowsToUpdate, FirstColShown, NofColsShown, Data, ListAsStr), + NewRowDataList = make_row_data_list(1, NofRows, Data), + + NewGridP = GridP#grid_params{first_row_shown = FirstRowShown, + row_data_list = NewRowDataList}, + + ProcVars#process_variables{grid_params = NewGridP, + mark_params = NewMarkP}. + + + + + + + + + +%%====================================================================== +%% Function: +%% +%% Return Value: +%% +%% Description: +%% +%% Parameters: +%%====================================================================== + + +scroll_grid_horizontally(NewFirstColShown, ProcVars) -> + #process_variables{parent_pid = ParentPid, + grid_params = GridP, + mark_params = MarkP} = ProcVars, + + #grid_params{grid_width = Width, + nof_cols = NofCols, + nof_rows = NofRows, + nof_rows_shown = NofRowsShown, + first_row_shown = FirstRowShown, + col_width = DefaultColWidth, + max_col_width = MaxColWidth, + min_col_width = MinColWidth, + col_widths = ColWidths, + row_height = RowHeight, + col_frame_ids = ColFrameIds, + col_ids = ColIds, + row_ids = RowIds, + bg_color = BgColor, + fg_color = FgColor, + row_data_list = RowDataList, + lists_as_strings = ListAsStr} = GridP, + + % Probably it is unnecessary to check whether any new columns shall be + % created or not, but what the heck, we don't want to crash... + ColsShown = compute_cols_shown(NewFirstColShown, ColWidths, Width, NofCols, + DefaultColWidth), + NofColsShown = length(ColsShown), + + ParentPid ! #pg_col_info{sender = self(), + first_col_shown = NewFirstColShown, + width_of_cols_shown = ColsShown, + nof_rows_shown = NofRowsShown + }, + + NewMarkP = move_marks(NewFirstColShown, FirstRowShown, GridP, MarkP), + + NewColWidths = update_col_widths(ColsShown, ColWidths, NewFirstColShown, + DefaultColWidth), + + {NewNofCols, NewColFrameIds, NewColIds, NewRowIds} = + check_nof_cols(ColsShown, (NofColsShown - NofCols), ColFrameIds, ColIds, + RowIds, NofRows, RowHeight, FgColor, BgColor ), + + + RowsToUpdate = lists:sublist(NewRowIds, NofRowsShown), + resize_all_grid_columns(1, ColsShown, NewColFrameIds, MaxColWidth, MinColWidth), + + refresh_visible_rows(RowsToUpdate, NewFirstColShown, NofColsShown, RowDataList, ListAsStr), + + % Clear fields currently not visible. + clear_fields(lists:nthtail(NofColsShown, NewColIds), + lists:nthtail(NofRowsShown, NewRowIds)), + + + NewGridP = GridP#grid_params{nof_cols = NewNofCols, + cols_shown = ColsShown, + col_widths = NewColWidths, + col_frame_ids = NewColFrameIds, + col_ids = NewColIds, + row_ids = NewRowIds, + first_col_shown = NewFirstColShown + }, + + ProcVars#process_variables{grid_params = NewGridP, + mark_params = NewMarkP}. + + + + + + + + + +%%====================================================================== +%% Function: +%% +%% Return Value: +%% +%% Description: +%% +%% Parameters: +%%====================================================================== + + +mark_row(VirtualRow, ProcVars) -> + #process_variables{grid_params = GridP, + mark_params = MarkP} = ProcVars, + + #grid_params{first_row_shown = FirstRowShown, + nof_rows_shown = NofRowsShown, + row_ids = RowIds} = GridP, + + mark_row(VirtualRow, FirstRowShown, FirstRowShown + NofRowsShown - 1, RowIds, + ?GRID_MARK_COLOR), + + NewMarkP = MarkP#mark_params{cell_id = undefined, + virtual_col = undefined, + virtual_row = VirtualRow + }, + + ProcVars#process_variables{mark_params = NewMarkP}. + + + + + + + + + + +%%====================================================================== +%% Function: +%% +%% Return Value: +%% +%% Description: +%% +%% Parameters: +%%====================================================================== + + +mark_col(VirtualCol, ProcVars) -> + #process_variables{grid_params = GridP, + mark_params = MarkP} = ProcVars, + + #grid_params{first_col_shown = FirstColShown, + cols_shown = ColsShown, + col_ids = ColIds} = GridP, + + NofColsShown = length(ColsShown), + mark_col(VirtualCol, FirstColShown, FirstColShown + NofColsShown - 1, ColIds, + ?GRID_MARK_COLOR), + + NewMarkP = MarkP#mark_params{cell_id = undefined, + virtual_col = VirtualCol, + virtual_row = undefined + }, + + ProcVars#process_variables{mark_params = NewMarkP}. + + + + + + + + +%%====================================================================== +%% Function: +%% +%% Return Value: +%% +%% Description: +%% +%% Parameters: +%%====================================================================== + + +mark_cell_and_notify(CellId, RealCol, RealRow, ProcVars) -> + #process_variables{parent_pid = ParentPid, + grid_params = GridP, + mark_params = MarkP} = ProcVars, + + #grid_params{first_col_shown = FirstColShown, + first_row_shown = FirstRowShown} = GridP, + + OldCellId = MarkP#mark_params.cell_id, + + VirtualCol = FirstColShown + RealCol - 1, + VirtualRow = FirstRowShown + RealRow - 1, + + %% Right now, when the table tool only is passive, i.e., we cannot edit + %% the table content, we don't want to be able to mark empty cells. + + {text, CellText} = gs:read(CellId, label), + + CellMarked = case CellText of + "" -> false; + _AnyText when CellId=:=OldCellId -> false; + _AnyText -> true + end, + + remove_marks(ProcVars), + update_marked_cells(CellId, OldCellId, CellMarked), + + notify_about_cell_marked(ParentPid, CellMarked, RealCol, RealRow, + VirtualCol, VirtualRow, CellText), + + NewMarkP = case CellMarked of + true -> + MarkP#mark_params{cell_id = CellId, + virtual_col = VirtualCol, + virtual_row = VirtualRow + }; + false -> + MarkP#mark_params{cell_id = undefined, + virtual_col = 0, + virtual_row = undefined + } + end, + + ProcVars#process_variables{mark_params = NewMarkP}. + + + + + + + + +%%====================================================================== +%% Function: +%% +%% Return Value: +%% +%% Description: +%% +%% Parameters: +%%====================================================================== + + +remove_marks(ProcVars) -> + #process_variables{mark_params = MarkP, + grid_params = GridP} = ProcVars, + + #grid_params{first_col_shown = FirstColShown, + cols_shown = ColsShown, + col_ids = ColIds, + first_row_shown = FirstRowShown, + nof_rows_shown = NofRowsShown, + row_ids = RowIds} = GridP, + + + #mark_params{cell_id = CellId, + virtual_col = VirtualCol, + virtual_row = VirtualRow} = MarkP, + + case {VirtualCol, VirtualRow} of + {undefined, undefined} -> + update_marked_cells(CellId, CellId, false); + {_AnyCol, undefined} -> + NofColsShown = length(ColsShown), + unmark_col(VirtualCol, FirstColShown, FirstColShown + NofColsShown - 1, + ColIds); + {undefined, _AnyRow} -> + unmark_row(VirtualRow, FirstRowShown, FirstRowShown + NofRowsShown - 1, + RowIds); + _Other -> + update_marked_cells(CellId, CellId, false) + end, + + NewMarkP = MarkP#mark_params{cell_id = undefined, + virtual_col = 0, + virtual_row = undefined + }, + ProcVars#process_variables{mark_params = NewMarkP}. + + + + + + + + + +%%%********************************************************************* +%%% INTERNAL FUNCTIONS +%%%********************************************************************* + + + + + + +%%====================================================================== +%% Function: +%% +%% Return Value: +%% +%% Description: +%% +%% Parameters: +%%====================================================================== + + +move_marks(FirstCol, FirstRow, GridP, MarkP) -> + #grid_params{first_col_shown = OldFirstCol, + cols_shown = ColsShown, + first_row_shown = OldFirstRow, + nof_rows_shown = NofRowsShown, + col_ids = ColIds, + row_ids = RowIds} = GridP, + + #mark_params{virtual_col = VirtualCol, + virtual_row = VirtualRow} = MarkP, + + + case {VirtualCol, VirtualRow} of + {undefined, undefined} -> + NofColsShown = length(ColsShown), + move_marked_cell(FirstCol, FirstRow, NofColsShown, + NofRowsShown, RowIds, MarkP); + {_AnyCol, undefined} -> + NofColsShown = length(ColsShown), + OldLastCol = OldFirstCol + NofColsShown - 1, + LastCol = FirstCol + NofColsShown - 1, + move_marked_col(VirtualCol, OldFirstCol, OldLastCol, + FirstCol, LastCol, ColIds, MarkP); + {undefined, _AnyRow} -> + OldLastRow = OldFirstRow + NofRowsShown - 1, + LastRow = FirstRow + NofRowsShown - 1, + move_marked_row(VirtualRow, OldFirstRow, OldLastRow, + FirstRow, LastRow, RowIds, MarkP); + {_CellCol, _CellRow} -> + NofColsShown = length(ColsShown), + move_marked_cell(FirstCol, FirstRow, NofColsShown, + NofRowsShown, RowIds, MarkP) + end. + + + + + + + + + +%%====================================================================== +%% Function: +%% +%% Return Value: +%% +%% Description: +%% +%% Parameters: +%%====================================================================== + + +refresh_marks(GridP, MarkP) -> + #grid_params{first_col_shown = FirstCol, + cols_shown = ColsShown, + first_row_shown = FirstRow, + nof_rows_shown = NofRowsShown, + col_ids = ColIds, + row_ids = RowIds} = GridP, + + #mark_params{virtual_col = VirtualCol, + virtual_row = VirtualRow} = MarkP, + + + case {VirtualCol, VirtualRow} of + {undefined, undefined} -> + NofColsShown = length(ColsShown), + move_marked_cell(FirstCol, FirstRow, NofColsShown, NofRowsShown, + RowIds, MarkP); + {_AnyCol, undefined} -> + NofColsShown = length(ColsShown), + LastCol = FirstCol + NofColsShown - 1, + mark_col(VirtualCol, FirstCol, LastCol, ColIds, ?GRID_MARK_COLOR); + {undefined, _AnyRow} -> + LastRow = FirstRow + NofRowsShown - 1, + mark_row(VirtualRow, FirstRow, LastRow, RowIds, ?GRID_MARK_COLOR); + {_CellCol, _CellRow} -> + NofColsShown = length(ColsShown), + move_marked_cell(FirstCol, FirstRow, NofColsShown, NofRowsShown, + RowIds, MarkP) + end. + + + + + + + + +%%====================================================================== +%% Function: +%% +%% Return Value: +%% +%% Description: +%% +%% Parameters: +%%====================================================================== + + +move_marked_col(VirtualCol, + OldFirstCol, OldLastCol, FirstCol, LastCol, ColIds, MarkP) -> + unmark_col(VirtualCol, OldFirstCol, OldLastCol, ColIds), + mark_col(VirtualCol, FirstCol, LastCol, ColIds, ?GRID_MARK_COLOR), + MarkP#mark_params{cell_id = undefined}. + + + + + + + + +%%====================================================================== +%% Function: +%% +%% Return Value: +%% +%% Description: +%% +%% Parameters: +%%====================================================================== + + +mark_col(VirtualCol, FirstCol, _LastCol, _ColIds, _Color) when VirtualCol < FirstCol -> + done; +mark_col(VirtualCol, _FirstCol, LastCol, _ColIds, _Color) when VirtualCol > LastCol -> + done; +mark_col(VirtualCol, FirstCol, _LastCol, ColIds, Color) -> + RealCol = VirtualCol - FirstCol + 1, + MarkedColIds = lists:nth(RealCol, ColIds), + mark_all_cells(MarkedColIds, Color). + + + + + + + + +%%====================================================================== +%% Function: +%% +%% Return Value: +%% +%% Description: +%% +%% Parameters: +%%====================================================================== + + +unmark_col(VirtualCol, FirstCol, LastCol, ColIds) -> + mark_col(VirtualCol, FirstCol, LastCol, ColIds, ?DEFAULT_GRID_BGCOLOR). + + + + + + + + +%%====================================================================== +%% Function: +%% +%% Return Value: +%% +%% Description: +%% +%% Parameters: +%%====================================================================== + + +mark_all_cells([], _Color) -> + done; +mark_all_cells([CellId | T], Color) -> + gs:config(CellId, [{bg, Color}]), + mark_all_cells(T, Color). + + + + + + + + +%%====================================================================== +%% Function: +%% +%% Return Value: +%% +%% Description: +%% +%% Parameters: +%%====================================================================== + + +mark_row(VirtualRow, FirstRow, _LastRow, _RowIds, _Color) when VirtualRow < FirstRow -> + done; +mark_row(VirtualRow, _FirstRow, LastRow, _RowIds, _Color) when VirtualRow > LastRow -> + done; +mark_row(VirtualRow, FirstRow, _LastRow, RowIds, Color) -> + RealRow = VirtualRow - FirstRow + 1, + MarkedRowIds = lists:nth(RealRow, RowIds), + mark_all_cells(MarkedRowIds, Color). + + + + + + + + +%%====================================================================== +%% Function: +%% +%% Return Value: +%% +%% Description: +%% +%% Parameters: +%%====================================================================== + + +unmark_row(VirtualRow, FirstRow, LastRow, RowIds) -> + mark_row(VirtualRow, FirstRow, LastRow, RowIds, ?DEFAULT_GRID_BGCOLOR). + + + + + + + + + + +%%====================================================================== +%% Function: +%% +%% Return Value: +%% +%% Description: +%% +%% Parameters: +%%====================================================================== + + +move_marked_row(VirtualRow, + OldFirstRow, OldLastRow, FirstRow, LastRow, RowIds, MarkP) -> + unmark_row(VirtualRow, OldFirstRow, OldLastRow, RowIds), + mark_row(VirtualRow, FirstRow, LastRow, RowIds, ?GRID_MARK_COLOR), + MarkP#mark_params{cell_id = undefined}. + + + + + + + + + +%%====================================================================== +%% Function: +%% +%% Return Value: +%% +%% Description: +%% +%% Parameters: +%%====================================================================== + + +move_marked_cell(FirstColShown, + FirstRowShown, NofColsShown, NofRowsShown, RowIds, MarkP) -> + #mark_params{cell_id = OldCellId, + virtual_col = VirtualCol, + virtual_row = VirtualRow} = MarkP, + + case OldCellId of + undefined -> + MarkP; + _OtherId -> + NewRealCol = VirtualCol - FirstColShown + 1, + NewRealRow = VirtualRow - FirstRowShown + 1, + update_marked_cells(undefined, OldCellId, false), + case check_if_new_mark_visible(NewRealCol, NewRealRow, + NofColsShown, NofRowsShown) of + false -> + MarkP; + true -> + NewCellId = lists:nth(NewRealCol, + lists:nth(NewRealRow, RowIds)), + update_marked_cells(NewCellId, undefined, true), + MarkP#mark_params{cell_id = NewCellId} + end + end. + + + + + + + + + + +%%====================================================================== +%% Function: +%% +%% Return Value: +%% +%% Description: +%% +%% Parameters: +%%====================================================================== + + +check_if_new_mark_visible(Col, _Row, NofCols, _NofRows) when Col > NofCols -> + false; +check_if_new_mark_visible(Col, _Row, _NofCols, _NofRows) when Col =< 0 -> + false; +check_if_new_mark_visible(_Col, Row, _NofCols, NofRows) when Row > NofRows -> + false; +check_if_new_mark_visible(_Col, Row, _NofCols, _NofRows) when Row =< 0 -> + false; +check_if_new_mark_visible(_Col, _Row, _NofCols, _NofRows) -> + true. + + + + + + + + + + + +%%====================================================================== +%% Function: +%% +%% Return Value: +%% +%% Description: +%% +%% Parameters: +%%====================================================================== + + +update_marked_cells(CellId, OldCellId, _MarkedCell) when CellId =:= OldCellId -> + gs:config(CellId, [{bg, ?DEFAULT_GRID_BGCOLOR}]); +update_marked_cells(_CellId, undefined, false) -> + done; +update_marked_cells(CellId, undefined, true) -> + gs:config(CellId, [{bg, ?GRID_MARK_COLOR}]); +update_marked_cells(CellId, OldCellId, true) -> + gs:config(OldCellId, [{bg, ?DEFAULT_GRID_BGCOLOR}]), + gs:config(CellId, [{bg, ?GRID_MARK_COLOR}]); +update_marked_cells(_CellId, OldCellId, false) -> + gs:config(OldCellId, [{bg, ?DEFAULT_GRID_BGCOLOR}]). + + + + + + + + + + +%%====================================================================== +%% Function: +%% +%% Return Value: +%% +%% Description: +%% +%% Parameters: +%%====================================================================== + + +notify_about_cell_marked(Pid, Marked, RealCol, RealRow, VirtCol, VirtRow, Text) -> + Pid ! #pg_cell_marked{sender = self(), + cell_marked = Marked, + real_col = RealCol, + real_row = RealRow, + virtual_col = VirtCol, + virtual_row = VirtRow, + cell_text = Text + }. + + + + + + + + +%%%--------------------------------------------------------------------- +%%% START of functions used to print data in the grid fields. +%%%--------------------------------------------------------------------- + + + + +%%====================================================================== +%% Function: +%% +%% Return Value: +%% +%% Description: +%% +%% Parameters: +%%====================================================================== + + +refresh_visible_rows([], _FirstColShown, _NofColsShown, _DataList, _ListAsStr) -> + done; +refresh_visible_rows(RowIds, _FirstColShown, _NofColsShown, [], _ListAsStr) -> + clear_cols_or_rows(RowIds); +refresh_visible_rows([OneRowIds | RemRowIds], FirstColShown, NofColsShown, + [DataItemList | RemDataItemLists], ListAsStr) -> + NewDataItemList = get_data_sublist(DataItemList, FirstColShown, NofColsShown), + update_one_row(lists:sublist(OneRowIds, NofColsShown), NewDataItemList, ListAsStr), + refresh_visible_rows(RemRowIds, FirstColShown, NofColsShown, RemDataItemLists, ListAsStr). + + + + + + + + + +%%====================================================================== +%% Function: +%% +%% Return Value: +%% +%% Description: +%% +%% Parameters: +%%====================================================================== + + +update_visible_rows([], _FirstColShown, _NofColsShown, _DataList, _ListAsStr) -> + done; +update_visible_rows(RowIds, _FirstColShown, _NofColsShown, [], _ListAsStr) -> + clear_cols_or_rows(RowIds); +update_visible_rows([OneRowIds | RemRowIds], FirstColShown, NofColsShown, + [DataItem | RemData], ListAsStr) -> + % We convert the received item to a list! This way we know that + % '[notext]' shall be printed as 'notext', while 'notext' shall + % be printed as ''. + TempDataItemList = item_to_list(DataItem), + DataItemList = get_data_sublist(TempDataItemList, FirstColShown, + NofColsShown), + update_one_row(lists:sublist(OneRowIds, NofColsShown), DataItemList, ListAsStr), + update_visible_rows(RemRowIds, FirstColShown, NofColsShown, RemData, ListAsStr). + + + + + + + + + + +%%====================================================================== +%% Function: +%% +%% Return Value: +%% +%% Description: +%% +%% Parameters: +%%====================================================================== + + +update_one_row(OneRowIds, [], _ListAsStr) -> + clear_one_col_or_row(OneRowIds); +update_one_row([], _DataItemList, _ListAsStr) -> + done; +update_one_row([LabelId | RemLabelIds], [notext | T], ListAsStr) -> + gs:config(LabelId, [{label, {text, ""}} + ]), + update_one_row(RemLabelIds, T, ListAsStr); +update_one_row([LabelId | RemLabelIds], [DataElem | T], ListAsStr) -> + Str = case ListAsStr of + true -> + tv_io_lib:format(" ~p", [DataElem]); + false -> + " " ++ lists:flatten(tv_io_lib:write(DataElem)) + end, + gs:config(LabelId, [{label, {text, Str}} + ]), + update_one_row(RemLabelIds, T, ListAsStr). + + + + + + + + + + + +%%====================================================================== +%% Function: +%% +%% Return Value: +%% +%% Description: +%% +%% Parameters: +%%====================================================================== + + +make_row_data_list(N, NofRows, []) when N > NofRows -> + []; +make_row_data_list(N, NofRows, []) -> + % If NofRows == N, we get the empty list here! + lists:duplicate(NofRows- N, notext); +make_row_data_list(N, NofRows, [_DataItem | _RemData]) when N > NofRows -> + []; +make_row_data_list(N, NofRows, [DataItem | RemData]) -> + % We convert the received item to a list! This way we know that + % '[notext]' shall be printed as 'notext', while 'notext' shall + % be printed as ''. + [item_to_list(DataItem) | make_row_data_list(N + 1, NofRows, RemData)]. + + + + + + + + + +%%====================================================================== +%% Function: +%% +%% Return Value: +%% +%% Description: +%% +%% Parameters: +%%====================================================================== + + +item_to_list(Item) when is_tuple(Item) -> + tuple_to_list(Item); +item_to_list(Item) -> + [Item]. + + + + + + + + + + +%%====================================================================== +%% Function: +%% +%% Return Value: +%% +%% Description: +%% +%% Parameters: +%%====================================================================== + + +get_data_sublist(DataList, StartPos, Length) -> + case catch lists:sublist(DataList, StartPos, Length) of + {'EXIT', _Reason} -> + []; + Sublist -> + Sublist + end. + + + + + + + +%%%--------------------------------------------------------------------- +%%% END of functions used to print data in the grid fields. +%%%--------------------------------------------------------------------- + + + + + +%%%--------------------------------------------------------------------- +%%% START of functions used to resize the grid columns. +%%%--------------------------------------------------------------------- + + + + +%%====================================================================== +%% Function: +%% +%% Return Value: +%% +%% Description: +%% +%% Parameters: +%%====================================================================== + + +resize_all_grid_columns(_RealCol, [], _ColFrameIds, _MaxColWidth, _MinColWidth) -> + done; +resize_all_grid_columns(RealCol, [ColWidth | Tail], ColFrameIds, MaxColWidth, MinColWidth) -> + + resize_one_column(RealCol, ColWidth, ColFrameIds, MaxColWidth, MinColWidth), + resize_all_grid_columns(RealCol + 1, Tail, ColFrameIds, MaxColWidth, + MinColWidth). + + + + + + + + +%%====================================================================== +%% Function: +%% +%% Return Value: +%% +%% Description: +%% +%% Parameters: +%%====================================================================== + + +resize_one_column(RealCol, Width, ColFrameIds, MaxW, MinW) -> + NewWidthOfCol = min(MaxW, max(Width, MinW)), + case length(ColFrameIds) of + RealCol -> + done; + _Other -> + FrameId = lists:nth(RealCol + 1, ColFrameIds), + gs:config(FrameId, [{x, NewWidthOfCol + 1}]) + end, + NewWidthOfCol. + + + + +%%%--------------------------------------------------------------------- +%%% END of functions used to resize the grid columns. +%%%--------------------------------------------------------------------- + + + + + + +%%%--------------------------------------------------------------------- +%%% START of functions used to update the grid. +%%%--------------------------------------------------------------------- + + + + +%%====================================================================== +%% Function: +%% +%% Return Value: +%% +%% Description: +%% +%% Parameters: +%%====================================================================== + + +clear_fields(ColIds, RowIds) -> + clear_cols_or_rows(ColIds), + clear_cols_or_rows(RowIds). + + + + + + + + + +%%====================================================================== +%% Function: +%% +%% Return Value: +%% +%% Description: +%% +%% Parameters: +%%====================================================================== + + +clear_cols_or_rows([]) -> + done; +clear_cols_or_rows([IdList | RemIdLists]) -> + clear_one_col_or_row(IdList), + clear_cols_or_rows(RemIdLists). + + + + + + + + +%%====================================================================== +%% Function: +%% +%% Return Value: +%% +%% Description: +%% +%% Parameters: +%%====================================================================== + + +clear_one_col_or_row([]) -> + done; +clear_one_col_or_row([LabelId | RemLabelIds]) -> + gs:config(LabelId, [{label, {text, ""}} + ]), + clear_one_col_or_row(RemLabelIds). + + + + + +%%%--------------------------------------------------------------------- +%%% END of functions used to update the grid. +%%%--------------------------------------------------------------------- + + + + + + +%%%--------------------------------------------------------------------- +%%% START of functions used to compute the part of the grid that has to +%%% be updated, as well as deciding whether a new column has to be added. +%%% Old columns (i.e., columns not visible) are not removed, but they +%%% shall not be updated until they once again becomes visible. +%%%--------------------------------------------------------------------- + + + + + +%%====================================================================== +%% Function: +%% +%% Return Value: +%% +%% Description: +%% +%% Parameters: +%%====================================================================== + + +check_nof_cols(_ColsShown, NofNewCols, ColFrameIds, ColIds, RowIds, + _NofRows, _RowHeight, _FgColor, _BgColor) when NofNewCols =< 0 -> + {length(ColFrameIds), ColFrameIds, ColIds, RowIds}; +check_nof_cols(ColsShown, NofNewCols, ColFrameIds, ColIds, + RowIds, NofRows, RowHeight, FgColor, BgColor) -> + NewColNo = length(ColFrameIds) + 1, + % We don't care about the pathological case where no columns have been + % created. If the gridwidth, or the columnwidth, was set to =< 0 during + % initialisation, then no columns will have been created. The program + % will probably also have crashed. If any smart jackass has set invalid + % values on these important parameters, then he can only blame himself. + ParentId = lists:nth((NewColNo - 1), ColFrameIds), + ParentColWidth = lists:nth((NewColNo - 1), ColsShown), + Xpos = ParentColWidth + 1, + + {ColFrameId, LabelIds} = add_one_col_frame(ParentId, NewColNo, Xpos, FgColor, + BgColor, NofRows, RowHeight), + + NewColFrameIds = ColFrameIds ++ [ColFrameId], + NewColIds = ColIds ++ [LabelIds], + NewRowIds = update_row_ids(RowIds, LabelIds), + + check_nof_cols(ColsShown, NofNewCols - 1, NewColFrameIds, NewColIds, NewRowIds, + NofRows, RowHeight, FgColor, BgColor). + + + + + + + + + + + +%%====================================================================== +%% Function: +%% +%% Return Value: +%% +%% Description: +%% +%% Parameters: +%%====================================================================== + + +update_row_ids([], _LabelIds) -> + []; +update_row_ids([OneRowIds | RemainingRows], [NewElemId | RemainingElemIds]) -> + [OneRowIds ++ [NewElemId] | update_row_ids(RemainingRows, RemainingElemIds)]. + + + + + + + + + + + + + +%%====================================================================== +%% Function: +%% +%% Return Value: +%% +%% Description: +%% +%% Parameters: +%%====================================================================== + + +update_col_widths(ColsShown, ColWidths, FirstColShown, DefaultColWidth) -> + % What we do here is that we first (if necessary) add default + % column widths to the ColWidth list until it reaches to where + % ColsShown starts (vitually seen). + % In the second step we take the appropriate elements from the + % ColsShown list and add them to the ColWidths list, until it is + % of sufficient length. + % Of course this may seem unnecessary - it would suffice to just + % add default widths to the ColWidths list until it is long enough, + % since the compute_cols_shown function right now just adds default + % width columns to the ColsShown list, when the ColWidths list is empty. + % However, this could change (maybe we some other time want the last + % column to carry all remaining width, instead of adding new columns). + % Besides, we don't like hidden dependencies between functions!!! + + NofColsShown = length(ColsShown), + NewColWidths = set_necessary_col_widths_length(FirstColShown, ColWidths, + DefaultColWidth), + % Now NofVirtualCols will always be equal to, or greater + % than, FirstColShown - 1. + + NofVirtualCols = length(NewColWidths), + NecessaryNofVirtualCols = FirstColShown + (NofColsShown - 1), + if + NecessaryNofVirtualCols > NofVirtualCols -> + TailNo = NofVirtualCols - FirstColShown + 1, % Always >= 0 !!! + NewColWidths ++ lists:nthtail(TailNo, ColsShown); + true -> + NewColWidths + end. + + + + + + + + + +%%====================================================================== +%% Function: +%% +%% Return Value: +%% +%% Description: +%% +%% Parameters: +%%====================================================================== + + +set_necessary_col_widths_length(FirstColShown, ColWidths, DefaultColWidth) -> + % First check that (length(ColWidths) - FirstColShown) >= -1. + % If not, add elements so the relation holds true! + MissingDefaultWidthElems = FirstColShown - length(ColWidths), + if + MissingDefaultWidthElems > 1 -> + ColWidths ++ lists:duplicate(MissingDefaultWidthElems - 1, + DefaultColWidth); + true -> + ColWidths + end. + + + + + + + + + + +%%====================================================================== +%% Function: +%% +%% Return Value: +%% +%% Description: +%% +%% Parameters: +%%====================================================================== + + +compute_rows_shown(GridHeight, RowHeight) -> + (GridHeight div RowHeight) + 1. + + + + + + + + + +%%====================================================================== +%% Function: +%% +%% Return Value: +%% +%% Description: +%% +%% Parameters: +%%====================================================================== + + +compute_cols_shown(FirstColShown, ColWidths, GridWidth, _NofCols, DefaultColWidth) -> + ColWidthsLength = length(ColWidths), + % Normally ColWidths shall be long enough, but just to make sure... + % (We could have chosen to update ColWidths here to, but right now + % we do it instead explicitly when resizeing the grid, changing the + % column size(s), and scrolling horizontally.) + UsedColWidths = if + ColWidthsLength < FirstColShown -> + []; + true -> + lists:nthtail(FirstColShown - 1, ColWidths) + end, + compute_cols_shown(UsedColWidths, GridWidth, DefaultColWidth). + + + + + + +compute_cols_shown(_ColWidths, RemainingWidth, _DefColW) when RemainingWidth =< 0 -> + []; +compute_cols_shown([], RemainingWidth, DefaultColWidth) -> + [DefaultColWidth | compute_cols_shown([], RemainingWidth - DefaultColWidth, + DefaultColWidth)]; +compute_cols_shown([VirtualColWidth | T], RemainingWidth, DefaultColWidth) -> + [VirtualColWidth | compute_cols_shown(T, RemainingWidth - VirtualColWidth, + DefaultColWidth)]. + + + + + +%%%--------------------------------------------------------------------- +%%% END of functions used to compute the part of the grid that has to +%%% be updated, as well as deciding whether a new column has to be added. +%%%--------------------------------------------------------------------- + + + + + + + +%%%--------------------------------------------------------------------- +%%% START of functions used to create the grid (baseframes, columns +%%% and rows), as well as sorting the ID's appropriately. +%%%--------------------------------------------------------------------- + + + +%%====================================================================== +%% Function: +%% +%% Return Value: +%% +%% Description: +%% +%% Parameters: +%%====================================================================== + + +create_base_frame(ParentId, Width, Height, Xpos, Ypos, BgColor) -> + gs:frame(ParentId, [{width, Width}, + {height, Height}, + {x, Xpos}, + {y, Ypos}, + {bg, BgColor} + ]). + + + + + +%%====================================================================== +%% Function: +%% +%% Return Value: +%% +%% Description: +%% +%% Parameters: +%%====================================================================== + + +create_col_frames(0, _NofRows, _RowHeight, _ParentId, _GridP, ColFrameAcc, LabelAcc) -> + {lists:reverse(ColFrameAcc), lists:reverse(LabelAcc)}; +create_col_frames(N, NofRows, RowHeight, ParentId, GridP, ColFrameAcc, LabelAcc) -> + % Yes, it *IS* inefficient to copy GridP for each loop. + % However, it is only done once, and for a limited number of times, + % and we avoid having a lot of parameters! + #grid_params{bg_color = BgColor, + fg_color = FgColor, + nof_cols = NofCols, + col_width = ColWidth} = GridP, + Xpos = if + N =:= NofCols -> + 0; + true -> + ColWidth + 1 + end, + + ColNo = NofCols - N + 1, + {ColFrameId, LabelIds} = add_one_col_frame(ParentId, ColNo, Xpos, FgColor, + BgColor, NofRows, RowHeight), + create_col_frames(N - 1, NofRows, RowHeight, ColFrameId, GridP, + [ColFrameId | ColFrameAcc], [LabelIds | LabelAcc]). + + + + + + + +%%====================================================================== +%% Function: +%% +%% Return Value: +%% +%% Description: +%% +%% Parameters: +%%====================================================================== + + +add_one_col_frame(ParentId, ColNo, Xpos, FgColor, BgColor, NofRows, RowHeight) -> + ColFrameId = create_one_col_frame(ParentId, Xpos, FgColor), + FirstRowYpos = 1, + FirstRowNo = 1, + LabelIds = create_rows_on_frame(ColFrameId, FirstRowNo, NofRows, RowHeight, + FirstRowYpos, FgColor, BgColor, ColNo, []), + {ColFrameId, LabelIds}. + + + + + + + + + +%%====================================================================== +%% Function: +%% +%% Return Value: +%% +%% Description: +%% +%% Parameters: +%%====================================================================== + + +create_one_col_frame(ParentId, Xpos, BgColor) -> + ColFrameWidth = 1200, + ColFrameHeight = 900, + Ypos = 0, + gs:frame(ParentId, [{width, ColFrameWidth}, + {height, ColFrameHeight}, + {x, Xpos}, + {y, Ypos}, + {bg, BgColor} + ]). + + + + + + + + +%%====================================================================== +%% Function: +%% +%% Return Value: +%% +%% Description: +%% +%% Parameters: +%%====================================================================== + + +create_rows_on_frame(_FrameId, RowNo, NofRows, _H, _Y, _Fg, _Bg, _ColNo, Acc) when RowNo > NofRows -> + lists:reverse(Acc); +create_rows_on_frame(FrameId, RowNo, NofRows, H, Y, Fg, Bg, ColNo, RAcc) -> + Width = 1200, + R = gs:label(FrameId, [{width, Width}, + {height, H}, + {x, 1}, + {y, Y}, + {bg, Bg}, + {fg, Fg}, + {align, w}, + {buttonpress, true}, + {data, {gridcell, ColNo, RowNo, FrameId}} + ]), + NextRowNo = RowNo + 1, + NextY = Y + H +1, + create_rows_on_frame(FrameId, NextRowNo, NofRows, H, NextY, Fg, Bg, ColNo, + [R | RAcc]). + + + + + + + + + +%%====================================================================== +%% Function: +%% +%% Return Value: +%% +%% Description: +%% +%% Parameters: +%%====================================================================== + + +get_row_ids(0, _Cols, RowAcc) -> + RowAcc; +get_row_ids(RowNo, Cols, RowAcc) -> + Row = extract_ids_for_one_row(RowNo, Cols), + get_row_ids(RowNo - 1, Cols, [Row | RowAcc]). + + + + + + + +%%====================================================================== +%% Function: +%% +%% Return Value: +%% +%% Description: +%% +%% Parameters: +%%====================================================================== + + +extract_ids_for_one_row(_N, []) -> + []; +extract_ids_for_one_row(N, [ColIds | Tail]) -> + [lists:nth(N, ColIds) | extract_ids_for_one_row(N, Tail)]. + + + +%%%--------------------------------------------------------------------- +%%% END of functions used to create the grid. +%%%--------------------------------------------------------------------- + + + + + +%%====================================================================== +%% Function: +%% +%% Return Value: +%% +%% Description: +%% +%% Parameters: +%%====================================================================== + + +max(A, B) when A > B -> + A; +max(_, B) -> + B. + + + + + + + +%%====================================================================== +%% Function: +%% +%% Return Value: +%% +%% Description: +%% +%% Parameters: +%%====================================================================== + + +min(A, B) when A < B -> + A; +min(_, B) -> + B. + diff --git a/lib/tv/src/tv_pg_int_def.hrl b/lib/tv/src/tv_pg_int_def.hrl new file mode 100644 index 0000000000..6f88053d47 --- /dev/null +++ b/lib/tv/src/tv_pg_int_def.hrl @@ -0,0 +1,92 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1997-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% +%%%********************************************************************* +%%% +%%% Description: Internal definitions for the pd part of the table tool. +%%% +%%%********************************************************************* + + +-define(GRIDFUNCS, tv_pg_gridfcns). + + + +-define(DEFAULT_COLFRAME_HEIGHT, 870). +-define(DEFAULT_COLWIDTH, 100). +-define(DEFAULT_GRID_BGCOLOR, {255, 255, 255}). % white +-define(DEFAULT_GRID_FGCOLOR, {0, 0, 0}). % black +-define(GRID_MARK_COLOR, {200, 255, 255}). +-define(GRID_FONT, {courier, 12}). + + + +-define(DEFAULT_BG_COLOR, {217, 217, 217}). +-define(DEFAULT_ROW_COLOR, {178, 34, 34}). % Firebrick! +-define(DEFAULT_GRID_COLOR, {0, 0, 0}). +-define(LIGHT_GRAY, {226, 226, 226}). +-define(DARK_VIOLET, {148, 0, 211}). +-define(FIREBRICK, {178, 34, 34}). +-define(ANTIQUE_WHITE, {255, 255, 235}). + + + + +-record(grid_params, {bg_frame, + fg_frame, + grid_width, + grid_height = ?DEFAULT_COLFRAME_HEIGHT, % Actual height, + % not the height + % shown! + grid_xpos, + grid_ypos, + bg_color = ?DEFAULT_GRID_BGCOLOR, + fg_color = ?DEFAULT_GRID_FGCOLOR, + nof_cols = 10, + nof_rows, + nof_rows_shown, + row_height, + col_width = ?DEFAULT_COLWIDTH, + first_col_shown = 1, + first_row_shown = 1, + max_col_width = 1200, + min_col_width = 5, + col_widths = [], + cols_shown = [], + col_frame_ids = [], + col_ids = [], + row_ids = [], + row_data_list = [], + current_max_value, + lists_as_strings = true + }). + + + +-record(mark_params, {cell_id, + virtual_col, + virtual_row + }). + + + + +-record(process_variables, {parent_pid, + grid_parent_id, + grid_params = #grid_params{}, + mark_params = #mark_params{} + }). diff --git a/lib/tv/src/tv_poll_dialog.erl b/lib/tv/src/tv_poll_dialog.erl new file mode 100644 index 0000000000..8d41251266 --- /dev/null +++ b/lib/tv/src/tv_poll_dialog.erl @@ -0,0 +1,357 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1997-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% +%%%********************************************************************* +%%% +%%% Description: Code for the "set poll interval" dialog with the user. +%%% +%%%********************************************************************* + +-module(tv_poll_dialog). + + + +-export([start/1, init/2]). + + + +-include("tv_int_msg.hrl"). + + + +-define(WINDOW_WIDTH, 305). +-define(WINDOW_HEIGHT, 185). + +-define(DEFAULT_BG_COLOR, {217, 217, 217}). + + + + + + +%%%********************************************************************* +%%% EXTERNAL FUNCTIONS +%%%********************************************************************* + + + +%%====================================================================== +%% Function: +%% +%% Return Value: +%% +%% Description: +%% +%% Parameters: +%%====================================================================== + + +start(Pos) -> + Pid = self(), + ProcPid = spawn_link(?MODULE, init, [Pid, Pos]), + receive_answer(ProcPid). + + + + + + + + +%%====================================================================== +%% Function: +%% +%% Return Value: +%% +%% Description: +%% +%% Parameters: +%%====================================================================== + + +init(Pid, Pos) -> + process_flag(trap_exit, true), + {ScalePos, ScaleRange, Poll, Color} = case Pos of + infinity -> + {0, {20, 20}, false, {255, 255, 255}}; + _Other -> + {Pos, {20, 300}, true, {0, 0, 0}} + end, + S = gs:start(), + Win = gs:window(S, [{width, ?WINDOW_WIDTH}, + {height, ?WINDOW_HEIGHT}, + {bg, ?DEFAULT_BG_COLOR}, + {title, "[TV] Set Poll Interval"}, + {configure, true}, + {destroy, true} + ]), + + NoPollBtn = gs:radiobutton(Win, [{height, 30}, + {width, 143}, + {x, 10}, + {y, 10}, + {bg, ?DEFAULT_BG_COLOR}, + {fg, {0, 0, 0}}, + {value, no_poll}, + {label, {text, "Manual Polling"}}, + {select, not(Poll)} + ]), + + PollBtn = gs:radiobutton(Win, [{height, 30}, + {width, 163}, + {x, 10}, + {y, 60}, + {bg, ?DEFAULT_BG_COLOR}, + {fg, {0, 0, 0}}, + {value, poll}, + {label, {text, "Automatic Polling"}}, + {select, Poll} + ]), + + Lbl = gs:label(Win, [{label, {text, "Poll Interval (seconds):"}}, + {align, center}, + {bg, ?DEFAULT_BG_COLOR}, + {fg, Color}, + {width, 183}, + {height, 30}, + {x, 10}, + {y, 100} + ]), + + Scale = gs:scale(Win, [{bg, ?DEFAULT_BG_COLOR}, + {fg, Color}, + {orient, horizontal}, + {range, ScaleRange}, + {pos, ScalePos}, + {width, 285}, + {height, 50}, + {x, 10}, + {y, 130} + ]), + + OkBtn = gs:button(Win, [{label, {text, "OK"}}, + {bg, ?DEFAULT_BG_COLOR}, + {fg, {0, 0, 0}}, + {align, center}, + {width, 60}, + {height, 30}, + {x, 230}, + {y, 10} + ]), + + CancelBtn = gs:button(Win, [{label, {text, "Cancel"}}, + {bg, ?DEFAULT_BG_COLOR}, + {fg, {0, 0, 0}}, + {align, center}, + {width, 60}, + {height, 30}, + {x, 230}, + {y, 60} + ]), + + gs:config(Win, {map, true}), + browser_loop(Pid, Win, NoPollBtn, PollBtn, Lbl, Scale, OkBtn, CancelBtn, Poll, Pos). + + + + + + + +%%%********************************************************************* +%%% INTERNAL FUNCTIONS +%%%********************************************************************* + + + + +%%====================================================================== +%% Function: +%% +%% Return Value: +%% +%% Description: +%% +%% Parameters: +%%====================================================================== + + +receive_answer(ProcPid) -> + receive_answer(ProcPid, undefined, undefined, undefined, undefined). + + + + + + + + + +%%====================================================================== +%% Function: +%% +%% Return Value: +%% +%% Description: +%% +%% Parameters: +%%====================================================================== + + +receive_answer(ProcPid, DataReqMsg, WinConfMsg, MarkedRowMsg, SubsetMsg) -> + receive Msg -> + case Msg of + + {browser, ProcPid, cancel} -> + PcPid = self(), + PcPid ! DataReqMsg, + PcPid ! WinConfMsg, + PcPid ! MarkedRowMsg, + PcPid ! SubsetMsg, + cancel; + + {browser, ProcPid, {true, PollInterval}} -> + PcPid = self(), + PcPid ! DataReqMsg, + PcPid ! WinConfMsg, + PcPid ! MarkedRowMsg, + PcPid ! SubsetMsg, + PollInterval; + + {browser, ProcPid, {false, _Pollinterval}} -> + PcPid = self(), + PcPid ! DataReqMsg, + PcPid ! WinConfMsg, + PcPid ! MarkedRowMsg, + PcPid ! SubsetMsg, + infinity; + + #pc_data_req{} -> + receive_answer(ProcPid, Msg, WinConfMsg, MarkedRowMsg, SubsetMsg); + + #pc_win_conf{} -> + receive_answer(ProcPid, DataReqMsg, Msg, MarkedRowMsg, SubsetMsg); + + #pc_marked_row{} -> + receive_answer(ProcPid, DataReqMsg, WinConfMsg, Msg, SubsetMsg); + + #dbs_subset{} -> + receive_answer(ProcPid, DataReqMsg, WinConfMsg, MarkedRowMsg, Msg); + + #pc_menu_msg{data = exit_button} -> + self() ! Msg, + cancel; + + #pc_set_sorting_mode{sender = Sender} -> + Sender ! #pd_ignore{sender = self()}, + ProcPid ! raise_and_beep, + receive_answer(ProcPid, DataReqMsg, WinConfMsg, MarkedRowMsg, SubsetMsg); + + {'EXIT', _Sender, _Reason} -> + self() ! Msg, + cancel; + + _Other -> + ProcPid ! raise_and_beep, + receive_answer(ProcPid, DataReqMsg, WinConfMsg, MarkedRowMsg, SubsetMsg) + end + end. + + + + + + + + +%%====================================================================== +%% Function: +%% +%% Return Value: +%% +%% Description: +%% +%% Parameters: +%%====================================================================== + + +browser_loop(Pid, Win, NoPollBtn, PollBtn, Lbl, Scale, OkBtn, CancelBtn, Poll, Pos) -> + receive + {gs, Scale, click, _, [NewPos | _]} -> + browser_loop(Pid, Win, NoPollBtn, PollBtn, Lbl, Scale, OkBtn, + CancelBtn, Poll, NewPos); + + {gs, NoPollBtn, click, _, _} -> + gs:config(Lbl, [{fg, {255, 255, 255}}]), + gs:config(Scale, [{fg, {255, 255, 255}}, {pos, 0}, {range, {20, 20}}]), + receive + {gs, Scale, click, _, _} -> + done + after 500 -> + done + end, + browser_loop(Pid, Win, NoPollBtn, PollBtn, Lbl, Scale, OkBtn, + CancelBtn, false, Pos); + + {gs, PollBtn, click, _, _} -> + gs:config(Lbl, [{fg, {0, 0, 0}}]), + gs:config(Scale, [{fg, {0, 0, 0}}, {pos, Pos}, {range, {20, 300}}]), + receive + {gs, Scale, click, _, _} -> + done + after 500 -> + done + end, + browser_loop(Pid, Win, NoPollBtn, PollBtn, Lbl, Scale, OkBtn, + CancelBtn, true, Pos); + + {gs, OkBtn, click, _, _} -> + Pid ! {browser, self(), {Poll, Pos}}; + + {gs, CancelBtn, click, _, _} -> + Pid ! {browser, self(), cancel}; + + {gs, _, destroy, _, _} -> + Pid ! {browser, self(), cancel}; + + + {gs, Win, configure, _, _} -> + gs:config(Win, [{width, ?WINDOW_WIDTH}, + {height, ?WINDOW_HEIGHT} + ]), + browser_loop(Pid, Win, NoPollBtn, PollBtn, Lbl, Scale, OkBtn, + CancelBtn, Poll, Pos); + + + raise_and_beep -> + gs:config(Win, [raise, + beep]), + browser_loop(Pid, Win, NoPollBtn, PollBtn, Lbl, Scale, OkBtn, + CancelBtn, Poll, Pos); + + + {'EXIT', _Sender, _Reason} -> + Pid ! {browser, self(), cancel}; + + + _Other -> + io:format("Poll dialog received message ~w ~n", [_Other]), + browser_loop(Pid, Win, NoPollBtn, PollBtn, Lbl, Scale, OkBtn, + CancelBtn, Poll, Pos) + + end. + diff --git a/lib/tv/src/tv_pw.erl b/lib/tv/src/tv_pw.erl new file mode 100644 index 0000000000..8b3186e090 --- /dev/null +++ b/lib/tv/src/tv_pw.erl @@ -0,0 +1,327 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1997-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% +%%%********************************************************************* +%%% +%%% Description: Code for pw, the window controlling part of the table tool. +%%% +%%%********************************************************************* + + +-module(tv_pw). + + + +-export([pw/1]). + + + + +-include("tv_int_def.hrl"). +-include("tv_int_msg.hrl"). +-include("tv_pw_int_def.hrl"). + + + + + + + +%%%********************************************************************* +%%% EXTERNAL FUNCTIONS +%%%********************************************************************* + + + + +%%====================================================================== +%% Function: pw. +%% +%% Return Value: None. +%% +%% Description: Process controlling the graphical window, as well as the +%% menubuttons. +%% +%% Parameters: None. +%%====================================================================== + + + +pw(Master) -> + process_flag(trap_exit, true), + ProcVars = #process_variables{master_pid = Master}, + blocked(ProcVars). + + + + + + + + + +%%%******************************************************************** +%%% INTERNAL FUNCTIONS +%%%******************************************************************** + + + + + +%%====================================================================== +%% Function: blocked. +%% +%% Return Value: None. +%% +%% Description: When started or explicitly blocked, pw enters this state, +%% where nothing is performed until the module explicitly is +%% deblocked. +%% +%% Parameters: +%%====================================================================== + + +blocked(ProcVars) -> + receive + Msg -> + case Msg of + #pw_deblock{} -> + deblock(Msg, ProcVars); + _Other -> + blocked(ProcVars) + end + end. + + + + + + + + + +%%====================================================================== +%% Function: deblocked. +%% +%% Return Value: None. +%% +%% Description: When deblocked, a window shall be created according to +%% specification received in pw_deblock message. +%% +%% Parameters: Rec: received pw_deblock message. +%%====================================================================== + + + +deblock(Msg, ProcVars) -> + #process_variables{window_params = WinP, + menu_params = MenuP} = ProcVars, + + NewWinP = ?WIN_FUNC_FILE:create_window(Msg, WinP), + NewMenuP = ?WIN_FUNC_FILE:create_menubar(NewWinP, MenuP), + + Sender = Msg#pw_deblock.sender, + Sender ! #pw_deblock_cfm{sender = self(), + win_id = NewWinP#window_params.window_id + }, + + NewProcVars = ProcVars#process_variables{window_params = NewWinP, + menu_params = NewMenuP + }, + deblocked_loop(NewProcVars). + + + + + + + + + + +%%====================================================================== +%% Function: +%% +%% Return Value: +%% +%% Description: +%% +%% Parameters: +%%====================================================================== + + +deblocked_loop(ProcVars) -> + receive + Msg -> + case Msg of + + {gs, Id, Event, Data, Args} -> + NewProcVars = gs_messages({Id, Event, Data, Args}, ProcVars), + deblocked_loop(NewProcVars); + + % Messages from pc! + #pw_select_menu{menu=Menu} -> + gs:config(Menu, [{select,true}]), + deblocked_loop(ProcVars); + + #pw_create_menu{} -> + NewProcVars = ?WIN_FUNC_FILE:create_menu(Msg, ProcVars), + % Send confirmation... + Sender = Msg#pw_create_menu.sender, + Sender ! #pw_create_menu_cfm{sender = self()}, + deblocked_loop(NewProcVars); + + #pw_set_window_title{win_title = WinTitle} -> + WinP = ProcVars#process_variables.window_params, + gs:config(WinP#window_params.window_id, [{title, "[TV] " ++ WinTitle}]), + NewWinP = WinP#window_params{window_title = WinTitle}, + NewProcVars = ProcVars#process_variables{window_params = NewWinP}, + deblocked_loop(NewProcVars); + + #pw_deblock{} -> + deblock(Msg, ProcVars); + + % Exit signals! + {'EXIT', Pid, Reason} -> + MasterPid = ProcVars#process_variables.master_pid, + exit_signals({Pid, Reason}, MasterPid), + deblocked_loop(ProcVars); + + _Other -> + deblocked_loop(ProcVars) + + end + end. + + + + + + + + + +%%====================================================================== +%% Function: +%% +%% Return Value: +%% +%% Description: +%% +%% Parameters: +%%====================================================================== + + +exit_signals(Exit_info, MasterPid) -> + case Exit_info of + {MasterPid, _Reason} -> % When from master, just quit! + exit(normal); + _Other -> + done + end. + + + + + + + + + + +%%====================================================================== +%% Function: +%% +%% Return Value: +%% +%% Description: +%% +%% Parameters: +%%====================================================================== + + +gs_messages(Msg, ProcVars) -> + MasterPid = ProcVars#process_variables.master_pid, + case Msg of + + {_Id, click, Data, _Args} -> + MasterPid ! #pc_menu_msg{sender = self(), + data = Data}, + ProcVars; + + {_Win, keypress, _Data, [Key, _ , _, 1 | _T]} -> + MenuP = ProcVars#process_variables.menu_params, + ShortcutList = MenuP#menu_params.shortcuts, + send_shortcut_data(Key, ShortcutList, MasterPid), + ProcVars; + + Msg0 = {Win, configure, _, _} -> + {Win, configure, _, [W, H | _T]} = flush_msgs(Msg0), + WinP = ProcVars#process_variables.window_params, + #window_params{window_id = WindowId, + min_window_width = MinAllowedWidth, + min_window_height = MinAllowedHeight} = WinP, + FinalWidth = ?COMM_FUNC_FILE:max(W, MinAllowedWidth), + FinalHeight = ?COMM_FUNC_FILE:max(H, MinAllowedHeight), + ?WIN_FUNC_FILE:resize_window(WindowId, FinalWidth, FinalHeight), + MasterPid ! #pc_win_conf{sender = self(), + width = FinalWidth, + height = FinalHeight}, + NewWinP = WinP#window_params{window_width = FinalWidth, + window_height = FinalHeight + }, + ProcVars#process_variables{window_params = NewWinP}; + + {_Win, destroy, _Data, _Args} -> + exit(normal); + + _Other -> + ProcVars + end. + +flush_msgs(Msg0 = {Win, Op, _, _}) -> + receive {gs, Win,Op,D,P} -> + flush_msgs({Win,Op,D,P}) + after 200 -> + Msg0 + end. + +send_shortcut_data(_Key, [], _MasterPid) -> + done; +send_shortcut_data(Key, ShortcutList, MasterPid) -> + case lists:keysearch(Key, 1, ShortcutList) of + {value, {Key, Data}} -> + MasterPid ! #pc_menu_msg{sender = self(), + data = Data}; + false -> + done + end. + + + + + + + + + + + + + + + diff --git a/lib/tv/src/tv_pw_int_def.hrl b/lib/tv/src/tv_pw_int_def.hrl new file mode 100644 index 0000000000..fabfbc2762 --- /dev/null +++ b/lib/tv/src/tv_pw_int_def.hrl @@ -0,0 +1,55 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1997-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% +%%%********************************************************************* +%%% +%%% Description: Internal definitions for the pw part of the table tool. +%%% +%%%********************************************************************* + +-define(WIN_FUNC_FILE, tv_pw_window). + + + +-define(DEFAULT_WINDOW_WIDTH, 1000). +-define(DEFAULT_WINDOW_HEIGHT, 800). +-define(DEFAULT_MIN_WINDOW_WIDTH, 50). +-define(DEFAULT_MIN_WINDOW_HEIGHT, 50). + + + +-record(window_params, {window_id, + window_title, + window_width, + window_height, + min_window_width, + min_window_height + }). + + +-record(menu_params, {menubar_id, + shortcuts + }). + + + + + +-record(process_variables, {master_pid, + window_params = #window_params{}, + menu_params = #menu_params{} + }). diff --git a/lib/tv/src/tv_pw_window.erl b/lib/tv/src/tv_pw_window.erl new file mode 100644 index 0000000000..9cb5c879c0 --- /dev/null +++ b/lib/tv/src/tv_pw_window.erl @@ -0,0 +1,273 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1997-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% +%%%********************************************************************* +%%% +%%% Description: Part of the pw component controlling the graphics. +%%% +%%%********************************************************************* + + +-module(tv_pw_window). + + + +-export([create_window/2, + resize_window/3, + create_menubar/2, + create_menu/2]). + + + + +-include("tv_int_def.hrl"). +-include("tv_int_msg.hrl"). +-include("tv_pw_int_def.hrl"). + + + +-define(DEFAULT_BG_COLOR, {217, 217, 217}). + + + + +%%%********************************************************************* +%%% EXTERNAL FUNCTIONS +%%%********************************************************************* + + + + +%%====================================================================== +%% Function: create_menu. +%% +%% Return Value: Identifier to the menu created. +%% +%% Description: Creates a menu in the window. +%% +%% Parameters: Win: ID of parent window. +%%====================================================================== + + +create_menu(Msg, ProcVars) -> + MenuP = ProcVars#process_variables.menu_params, + MenubarId = MenuP#menu_params.menubar_id, + ShortcutList = MenuP#menu_params.shortcuts, + + #pw_create_menu{menutitle = MenuTitle, + title_acc_pos = TitleAccPos, + menulist = MenuList} = Msg, + + % Create the menubutton! + Label = def_or_param(MenuTitle, "NoName"), + Mbutt = gs:create(menubutton, MenubarId, [{bg, ?DEFAULT_BG_COLOR}, + {fg, {178, 34, 34}}, % firebrick + % {font, {helvetica, bold, 14}}, + {label, {text, Label}}, + {underline, TitleAccPos} + ]), + + % Create the actual menu! + Menu = gs:create(menu, Mbutt, [{bg, ?DEFAULT_BG_COLOR}, + {fg, {178, 34, 34}} + ]), + + NewMenuP = MenuP#menu_params{shortcuts = ShortcutList ++ create_menulist(MenuList, Menu)}, + + ProcVars#process_variables{menu_params = NewMenuP}. + + + + + + + +create_menubar(WinP, MenuP) -> + WindowId = WinP#window_params.window_id, + MenubarId = gs:create(menubar, WindowId, [{bg, ?DEFAULT_BG_COLOR} + ]), + Mbutt = gs:create(menubutton, MenubarId, [{bg, ?DEFAULT_BG_COLOR}, + {fg, {178, 34, 34}}, % firebrick + % {font, {helvetica, bold, 14}}, + {label, {text, " Help "}}, + {underline, 1}, + {side, right} + ]), + + % Create the actual menu! + Menu = gs:create(menu, Mbutt, [{bg, ?DEFAULT_BG_COLOR}, + {fg, {178, 34, 34}} + ]), + MenuP#menu_params{menubar_id = MenubarId, + shortcuts = create_menulist([{" Help ", normal, help_button, 1, h}, + separator, + {" OTP Documentation ",normal,otp_help_button,1,no_char}], + Menu) ++ [{x,exit_button}, {'X',exit_button}] + }. + + + + + +create_window(Msg, WinP) -> + #pw_deblock{win_title = Title, + win_width = Width, + win_height = Height, + min_win_width = MinWidth} = Msg, + + + S = gs:start(), + WindowTitle = def_or_param(Title, "NoName"), + WindowMinWidth = def_or_param(MinWidth, ?DEFAULT_MIN_WINDOW_WIDTH), + WindowMinHeight = def_or_param(MinWidth, ?DEFAULT_MIN_WINDOW_HEIGHT), + WindowWidth = ?COMM_FUNC_FILE:max(def_or_param(Width, + ?DEFAULT_WINDOW_WIDTH), + WindowMinWidth), + WindowHeight = ?COMM_FUNC_FILE:max(def_or_param(Height, + ?DEFAULT_WINDOW_HEIGHT), + WindowMinHeight), + + + WindowId = gs:create(window, S, [{title, WindowTitle}, + {width, WindowWidth}, + {height, WindowHeight}, + {bg, ?DEFAULT_BG_COLOR}, + {configure, true}, + {destroy, true}, + {keypress, true}, + {cursor, arrow} + ]), + + WinP#window_params{window_id = WindowId, + window_title = WindowTitle, + window_width = WindowWidth, + window_height = WindowHeight, + min_window_width = WindowMinWidth, + min_window_height = WindowMinHeight + }. + + + + + + + +resize_window(WindowId, NewWidth, NewHeight) -> + gs:config(WindowId, [{width, NewWidth}, + {height, NewHeight} + ]). + + + + +%%%******************************************************************** +%%% INTERNAL FUNCTIONS +%%%******************************************************************** + + + +create_menulist([], _Menu) -> + []; +create_menulist(List, Menu) -> + MaxLength = get_length_of_longest_menu_text(List, 0), + create_menulist(List, Menu, MaxLength). + + + + +create_menulist([], _Menu, _MaxLength) -> + []; +create_menulist([{Text, Type, Data, AccCharPos, ShortcutChar} | Rest], Menu, MaxLength) -> + ShortcutCapitalChar = + if + ShortcutChar =:= no_char -> + no_char; + true -> + CharAsciiValue = lists:nth(1, atom_to_list(ShortcutChar)), + CapitalCharValue = CharAsciiValue - ($a - $A), + list_to_atom([CapitalCharValue]) + end, + + FinalText = if + ShortcutChar =:= no_char -> + Text; + true -> + Text ++ lists:duplicate(MaxLength - length(Text), " ") ++ + " Ctrl+" ++ atom_to_list(ShortcutCapitalChar) ++ " " + end, + TypeAndSel = + case Type of + normal -> + [{itemtype, normal}]; + {radio, Selected, Group} -> + [{itemtype, radio}, + {select, Selected}, + {group, Group}]; + {check, Selected} -> + [{itemtype, check}, + {select, Selected}] + end, + gs:menuitem(Data, Menu, [{bg, ?DEFAULT_BG_COLOR}, + {fg, {178, 34, 34}}, + {label, {text, FinalText}}, + {underline, AccCharPos}, + {data, Data} | + TypeAndSel + ]), + [{ShortcutChar, Data}, {ShortcutCapitalChar, Data} | create_menulist(Rest, Menu, MaxLength)]; +create_menulist([separator | Rest], Menu, MaxLength) -> + gs:create(menuitem, Menu, [{itemtype, separator} + ]), + create_menulist(Rest, Menu, MaxLength). + + + + + + + +get_length_of_longest_menu_text([], MaxLength) -> + MaxLength; +get_length_of_longest_menu_text([{Text, _Type, _Data, _APos, _SChar} | Rest], CurrMax) -> + L = length(Text), + if + L > CurrMax -> + get_length_of_longest_menu_text(Rest, L); + true -> + get_length_of_longest_menu_text(Rest, CurrMax) + end; +get_length_of_longest_menu_text([separator | Rest], CurrMax) -> + get_length_of_longest_menu_text(Rest, CurrMax). + + + + + +def_or_param(undefined, DefaultValue) -> + DefaultValue; +def_or_param(Param, _Default) -> + Param. + + + + + + + + + + diff --git a/lib/tv/src/tv_rec_edit.erl b/lib/tv/src/tv_rec_edit.erl new file mode 100644 index 0000000000..e8f663073e --- /dev/null +++ b/lib/tv/src/tv_rec_edit.erl @@ -0,0 +1,744 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1998-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% +-module(tv_rec_edit). + + + +-export([start/5, + start/6, + init/8 + ]). + + +-include("tv_int_def.hrl"). + + + +-define(DEFAULT_BG_COLOR, {217,217,217}). + +-define(WIN_WIDTH, 375). +-define(WIN_HEIGHT, 341). +-define(ETS_WIN_HEIGHT, 154). + +-define(FRAME_WIDTH, 375). +-define(FRAME_HEIGHT, 265). +-define(ETS_FRAME_HEIGHT, 74). + +-define(MAX_LABEL_WIDTH, 165). +-define(X0, 15). +-define(Y0, 20). +-define(LABEL_HEIGHT, 30). +-define(ENTRY_HEIGHT, 30). +-define(FONT, {screen,12}). +-define(NEXT_BTN_WIDTH, 57). +-define(NEXT_BTN_HEIGHT, 22). +-define(NEXT_BTN_FG, {178,34,34}). +-define(INSERT_BTN_WIDTH, 80). +-define(INSERT_BTN_HEIGHT, 30). +-define(INSERT_BTN_DIST_BETWEEN, 23). +-define(INSERT_BTN_DIST_FROM_BOTTOM, 23). + + + + + +start(TableType, TableName, AttributeList, ListsAsStr, ErrMsgMode) -> + AttributeValues = lists:duplicate(length(AttributeList), undefined), + spawn_link(?MODULE, init, [TableType, TableName, AttributeList, + AttributeValues, ListsAsStr, ErrMsgMode, self(), true]). + + + +start(TableType, TableName, AttributeList, AttributeValues, ListsAsStr, ErrMsgMode) -> + spawn_link(?MODULE, init, [TableType, TableName, AttributeList, + AttributeValues, ListsAsStr, ErrMsgMode, self(), false]). + + + + +init(TableType,TableName,AttributeList,AttributeValues,ListsAsStr,ErrMsgMode,MasterPid,Insert) -> + process_flag(trap_exit, true), + put(error_msg_mode, ErrMsgMode), + Frames = create_window(TableType, TableName, AttributeList, AttributeValues, + ListsAsStr, Insert), + loop(TableType, TableName, Frames, AttributeList, AttributeValues, MasterPid, ListsAsStr). + + + + + +loop(TabType, TabName, Frames, AttrList, AttrVals, MPid, ListsAsStr) -> + receive + + {gs, insert, click, Insert, _Args} -> + gs:config(win, [{cursor, busy}]), + case get_record(TabType, TabName, AttrList, AttrList, Frames) of + {ok, NewRec} -> + case Insert of + insert -> + MPid ! {new_object, NewRec}; + change -> + MPid ! {updated_object, NewRec} + end; + error -> + done + end, + gs:config(win, [{cursor, arrow}]), + loop(TabType, TabName, Frames, AttrList, AttrVals, MPid, ListsAsStr); + + + {gs, cancel, click, _Data, _Args} -> + exit(normal); + + + {gs, reset, click, _Data, _Args} -> + gs:config(win, [{cursor, busy}]), + set_entry_values(TabType, AttrList, AttrVals, ListsAsStr), + gs:config(win, [{cursor, arrow}]), + loop(TabType, TabName, Frames, AttrList, AttrVals, MPid, ListsAsStr); + + + + {gs, EntryId, keypress, _Data, ['Tab', _No, 0 | _T]} -> + {_Term, {NextEntry, NextFrame}} = + check_entry_content(EntryId, AttrList, Frames, forward), + case NextEntry of + EntryId -> + gs:config(NextEntry, [{setfocus, true}]); + _OtherId -> + gs:config(NextFrame, [raise]), + gs:config(NextEntry, [{setfocus, true}, + {select, {0,100000000}}]) + end, + loop(TabType, TabName, Frames, AttrList, AttrVals, MPid, ListsAsStr); + + + {gs, EntryId, keypress, _Data, ['Down' | _T]} -> + {_Term, {NextEntry, NextFrame}} = + check_entry_content(EntryId, AttrList, Frames, forward), + case NextEntry of + EntryId -> + gs:config(NextEntry, [{setfocus, true}]); + _OtherId -> + gs:config(NextFrame, [raise]), + gs:config(NextEntry, [{setfocus, true}, + {select, {0,100000000}}]) + end, + loop(TabType, TabName, Frames, AttrList, AttrVals, MPid, ListsAsStr); + + + {gs, EntryId, keypress, _Data, ['Tab', _No, 1 | _T]} -> + {_Term, {NextEntry, NextFrame}} = + check_entry_content(EntryId, AttrList, Frames, backward), + gs:config(NextFrame, [raise]), + case NextEntry of + EntryId -> + gs:config(NextEntry, [{setfocus, true}]); + _OtherId -> + gs:config(NextFrame, [raise]), + gs:config(NextEntry, [{setfocus, true}, + {select, {0,100000000}}]) + end, + loop(TabType, TabName, Frames, AttrList, AttrVals, MPid, ListsAsStr); + + + {gs, EntryId, keypress, _Data, ['Up' | _T]} -> + {_Term, {NextEntry, NextFrame}} = + check_entry_content(EntryId, AttrList, Frames, backward), + gs:config(NextFrame, [raise]), + case NextEntry of + EntryId -> + gs:config(NextEntry, [{setfocus, true}]); + _OtherId -> + gs:config(NextFrame, [raise]), + gs:config(NextEntry, [{setfocus, true}, + {select, {0,100000000}}]) + end, + loop(TabType, TabName, Frames, AttrList, AttrVals, MPid, ListsAsStr); + + + {gs, Id, keypress, _Data, ['Return' | _T]} -> + OldCursor = gs:read(Id, cursor), + gs:config(Id, [{cursor, busy}]), + gs:config(win, [{cursor, busy}]), + Insert = gs:read(insert, data), + case get_record(TabType, TabName, AttrList, AttrList, Frames) of + {ok, NewRec} -> + case Insert of + insert -> + MPid ! {new_object, NewRec}; + change -> + MPid ! {updated_object, NewRec} + end; + error -> + done + end, + gs:config(win, [{cursor, arrow}]), + gs:config(Id, [{cursor, OldCursor}]), + loop(TabType, TabName, Frames, AttrList, AttrVals, MPid, ListsAsStr); + + + + {gs, _Id, click, FrameNo, _Args} -> + gs:config(lists:nth(FrameNo, Frames), [raise]), + loop(TabType, TabName, Frames, AttrList, AttrVals, MPid, ListsAsStr); + + + {gs, win, configure, _Data, [Width | _T]} -> + resize_window(TabType, lists:max([Width, ?WIN_WIDTH]), Frames, AttrList), + loop(TabType, TabName, Frames, AttrList, AttrVals, MPid, ListsAsStr); + + + {gs, win, destroy, _Data, _Args} -> + exit(normal); + + + insert_mode -> + NewAttrVals = lists:duplicate(length(AttrList), undefined), + set_entry_values(TabType, AttrList, NewAttrVals, ListsAsStr), + loop(TabType, TabName, Frames, AttrList, NewAttrVals, MPid, ListsAsStr); + + + {update_mode, Obj} -> + NewAttrVals = + case TabType of + mnesia -> + case Obj of + undefined -> + lists:duplicate(length(AttrList), undefined); + _AnyRec -> + tl(tuple_to_list(Obj)) + end; + ets -> + [Obj] + end, + set_entry_values(TabType, AttrList, NewAttrVals, ListsAsStr), + loop(TabType, TabName, Frames, AttrList, NewAttrVals, MPid, ListsAsStr); + + + {reset_info, Obj} -> + %% Info to use, instead of old info, when reset button is pressed. + NewAttrVals = + case TabType of + mnesia -> + case Obj of + undefined -> + lists:duplicate(length(AttrList), undefined); + _AnyRec -> + tl(tuple_to_list(Obj)) + end; + ets -> + [Obj] + end, + loop(TabType, TabName, Frames, AttrList, NewAttrVals, MPid, ListsAsStr); + + + raise -> + gs:config(win, [raise]), + loop(TabType, TabName, Frames, AttrList,AttrVals, MPid, ListsAsStr); + + + {'EXIT', _Pid, _Reason} -> + exit(normal); + + + _Other -> + loop(TabType, TabName, Frames, AttrList,AttrVals, MPid, ListsAsStr) + end. + + + + +resize_window(TabType, WinWidth, Frames, AttrList) -> + WinHeight = + case TabType of + mnesia -> + get_window_height(length(AttrList)); + ets -> + ?ETS_WIN_HEIGHT + end, + gs:config(win, [{width, WinWidth}, + {height, WinHeight} + ]), + FrameWidth = WinWidth, + LblL = lists:map(fun(H) -> + gs:config(H, [{width, FrameWidth}]), + {LblW, BId, NId} = gs:read(H, data), + XNext = get_next_btn_xpos(FrameWidth), + XBack = XNext - ?NEXT_BTN_WIDTH, + gs:config(BId, [{x, XBack}]), + gs:config(NId, [{x, XNext}]), + LblW + end, + Frames), + LblW = hd(LblL), + EntryW = get_entry_width(TabType, FrameWidth, LblW), + lists:foreach(fun(H) -> + gs:config(H, [{width, EntryW}]) + end, + AttrList), + gs:config(btnframe, [{width, FrameWidth}]), + {XInsert, XCancel, XReset} = get_insert_btn_coords(WinWidth), + gs:config(insert, [{x, XInsert}]), + gs:config(cancel, [{x, XCancel}]), + gs:config(reset, [{x, XReset}]). + + + + +check_entry_content(EntryId, AttributeList, Frames, Direction) -> + EditedStr = gs:read(EntryId, text), + case tv_db_search:string_to_term(EditedStr) of + {error, {_Reason, Msg}} -> + gs:config(EntryId, [beep]), + tv_utils:notify(gs:start(), "TV Notification", Msg), + {error, {EntryId, no_matter}}; + {ok, NewTerm} -> + {{ok,NewTerm}, get_next_entry_id(EntryId, AttributeList, Frames, Direction)} + end. + + + + +get_next_entry_id(EntryId, AttributeList, Frames, Direction) -> + OldPos = get_pos(EntryId, AttributeList), + MaxPos = length(AttributeList), + NewPos = case Direction of + forward when OldPos < MaxPos -> + OldPos + 1; + forward -> + 1; + backward when OldPos > 1 -> + OldPos - 1; + backward -> + MaxPos; + stationary -> + OldPos + end, + FramePos = get_next_frame_id(NewPos), + {lists:nth(NewPos, AttributeList), lists:nth(FramePos, Frames)}. + + + + +get_next_frame_id(Pos) -> + case Pos rem 5 of + 0 -> + Pos div 5; + _Other -> + (Pos div 5) + 1 + end. + + + + +get_record(TabType, TabName, AttrList, AttrList, Frames) -> + case get_record(AttrList, AttrList, Frames, []) of + {ok, RecList} -> + case TabType of + mnesia -> + NewRecList = [TabName | RecList], + {ok, list_to_tuple(NewRecList)}; + ets -> + {ok, hd(RecList)} %% Only one element, a tuple! + end; + error -> + error + end. + + + + +get_record([H | T], AttrList, Frames, Acc) -> + case check_entry_content(H, AttrList, Frames, forward) of + {{ok, NewTerm}, _PosTuple} -> + get_record(T, AttrList, Frames, [NewTerm | Acc]); + {error, _PosTuple} -> + {EntryId, FrameId} = get_next_entry_id(H, AttrList, Frames, stationary), + gs:config(FrameId, [raise]), + gs:config(EntryId, [{setfocus, true}]), + error + end; +get_record([], _AttrList, _Frames, Acc) -> + {ok, lists:reverse(Acc)}. + + + + + + +get_pos(Elem, L) -> + get_pos(Elem, L, 1). + + +get_pos(Elem, [Elem | _T], N) -> + N; +get_pos(Elem, [_H | T], N) -> + get_pos(Elem, T, N + 1). + + + + +create_window(mnesia, TableName, AttrList, AttrValues, ListsAsStr, Insert) -> + NofAttr = length(AttrList), + NofFrames = + case NofAttr rem 5 of + 0 -> + NofAttr div 5; + _Rem -> + (NofAttr div 5) + 1 + end, + + WinHeight = get_window_height(NofAttr), + FrameHeight = get_frame_height(NofAttr), + + Attr = get_longest_attribute_name(AttrList), + LabelWidth = lists:min([?MAX_LABEL_WIDTH, + element(1, gs:read(gs:start(), + {font_wh, {?FONT, atom_to_list(Attr)}}))]), + + gs:window(win, gs:start(), [{width, ?WIN_WIDTH}, + {height, WinHeight}, + {title, "[TV] Record Editor: '" ++ + atom_to_list(TableName) ++ "'"}, + {bg, ?DEFAULT_BG_COLOR}, + {configure, true}, + {destroy, true}, + {cursor, arrow} + ]), + + create_insert_and_cancel_btns(Insert, WinHeight, FrameHeight), + FrameList = create_frames(NofFrames, LabelWidth, AttrList, AttrValues, NofFrames, + ListsAsStr, FrameHeight), + gs:config(hd(FrameList), [raise]), + gs:config(hd(AttrList), [{setfocus, true}, + {select, {0,100000000}}]), + gs:config(win, [{map,true}]), + FrameList; +create_window(ets, TableName, [Attr], [AttrVal], ListsAsStr, Insert) -> + gs:window(win, gs:start(), [{width, ?WIN_WIDTH}, + {height, ?ETS_WIN_HEIGHT}, + {title, "[TV] Tuple Editor, table '" ++ + atom_to_list(TableName) ++ "'"}, + {bg, ?DEFAULT_BG_COLOR}, + {configure, true}, + {destroy, true}, + {cursor, arrow} + ]), + + F = gs:frame(win, [{width, ?FRAME_WIDTH}, + {height, ?ETS_FRAME_HEIGHT}, + {x, 0}, + {y, 0}, + {bg, ?DEFAULT_BG_COLOR}, + {bw,2}, + {data, {0, undefined, undefined}} + ]), + + create_insert_and_cancel_btns(Insert, ?ETS_WIN_HEIGHT, ?ETS_FRAME_HEIGHT), + + EntryW = get_entry_width(ets, ?FRAME_WIDTH, 0), + EntryX = ?X0 - 2, + + EntryText = + case AttrVal of + undefined -> + ""; + _OtherVal -> + case ListsAsStr of + true -> + tv_io_lib:format("~p", [AttrVal]); + false -> + lists:flatten(io_lib:write(AttrVal)) + end + end, + gs:entry(Attr, F, [{width, EntryW}, + {height, ?LABEL_HEIGHT}, + {x, EntryX}, + {y, ?Y0}, + {bg, {255,255,255}}, + {fg, {0,0,0}}, + {bw, 1}, + {font, ?FONT}, + {justify, left}, + {text, EntryText}, + {cursor, text}, + {setfocus, true}, + {enable, true}, + {keypress,true}, + {select, {0,100000000}} + ]), + gs:config(win, [{map,true}]), + [F]. + + + + +get_insert_btn_coords(WinWidth) -> + Middle = round(WinWidth / 2), + XInsert = Middle - round(1.5 * ?INSERT_BTN_WIDTH) - ?INSERT_BTN_DIST_BETWEEN, + XCancel = Middle - round(0.5 * ?INSERT_BTN_WIDTH), + XReset = Middle + round(0.5 * ?INSERT_BTN_WIDTH) + ?INSERT_BTN_DIST_BETWEEN, + {XInsert, XCancel, XReset}. + + + + +create_insert_and_cancel_btns(Insert, WinHeight, FrameHeight) -> + LowerFrameHeight = WinHeight - FrameHeight, + Y = ?INSERT_BTN_DIST_FROM_BOTTOM, + {XInsert, XCancel, XReset} = get_insert_btn_coords(?WIN_WIDTH), + + {InsertBtnText, InsertBtnData} = + case Insert of + true -> + {"Insert", insert}; + false -> + {"Change", change} + end, + + gs:frame(btnframe, win, [{width, ?FRAME_WIDTH}, + {height, LowerFrameHeight}, + {x, 0}, + {y, FrameHeight}, + {bg, ?DEFAULT_BG_COLOR}, + {bw,2} + ]), + gs:button(insert, btnframe, [{width, ?INSERT_BTN_WIDTH}, + {height, ?INSERT_BTN_HEIGHT}, + {x, XInsert}, + {y, Y}, + {bg, ?DEFAULT_BG_COLOR}, + {fg, {0,0,0}}, + {font, ?FONT}, + {label, {text, InsertBtnText}}, + {align, center}, + {data, InsertBtnData} + ]), + gs:button(cancel, btnframe, [{width, ?INSERT_BTN_WIDTH}, + {height, ?INSERT_BTN_HEIGHT}, + {x, XCancel}, + {y, Y}, + {bg, ?DEFAULT_BG_COLOR}, + {fg, {0,0,0}}, + {font, ?FONT}, + {label, {text, "Cancel"}}, + {align, center} + ]), + gs:button(reset, btnframe, [{width, ?INSERT_BTN_WIDTH}, + {height, ?INSERT_BTN_HEIGHT}, + {x, XReset}, + {y, Y}, + {bg, ?DEFAULT_BG_COLOR}, + {fg, {0,0,0}}, + {font, ?FONT}, + {label, {text, "Reset"}}, + {align, center} + ]). + + + + + +create_frames(0, _LblW, _AttrList, _AttrValues, _NofFrames, _ListsAsStr, _FrameHeight) -> + []; +create_frames(N, LblW, AttrList, AttrValues, NofFrames, ListsAsStr, FrameHeight) -> + F = gs:frame(win, [{width, ?FRAME_WIDTH}, + {height, FrameHeight}, + {x, 0}, + {y, 0}, + {bg, ?DEFAULT_BG_COLOR}, + {bw,2} + ]), + {BId, NId} = create_back_and_next_btns(F, 5, N, NofFrames), + gs:config(F, [{data, {LblW, BId, NId}}]), + {RemAttrList, RemAttrValues} = + create_labels_and_entries(5, AttrList, AttrValues, LblW, F, ListsAsStr), + [F | create_frames(N - 1,LblW,RemAttrList,RemAttrValues,NofFrames,ListsAsStr,FrameHeight)]. + + + + + + +create_back_and_next_btns(FrameId, NofEntries, FrameNo, NofFrames) -> + Y = ?Y0 + NofEntries * (?LABEL_HEIGHT + 10) + 8, + XNext = get_next_btn_xpos(?FRAME_WIDTH), + XBack = XNext - ?NEXT_BTN_WIDTH, + DataNext = (NofFrames - FrameNo + 1) + 1, + DataBack = (NofFrames - FrameNo + 1) - 1, + BId = + if + DataBack =< 0 -> + undefined; + true -> + gs:button(FrameId, [{width, ?NEXT_BTN_WIDTH}, + {height, ?NEXT_BTN_HEIGHT}, + {x, XBack}, + {y, Y}, + {bg, ?DEFAULT_BG_COLOR}, + {fg, ?NEXT_BTN_FG}, + {font, ?FONT}, + {align, center}, + {label, {text, "< Back"}}, + %% {underline, 2}, + {data, DataBack} + ]) + end, + NId = + if + DataNext > NofFrames -> + undefined; + true -> + gs:button(FrameId, [{width, ?NEXT_BTN_WIDTH}, + {height, ?NEXT_BTN_HEIGHT}, + {x, XNext}, + {y, Y}, + {bg, ?DEFAULT_BG_COLOR}, + {fg, ?NEXT_BTN_FG}, + {font, ?FONT}, + {align, center}, + {label, {text, " Next >"}}, + %% {underline, 1}, + {data, DataNext} + ]) + end, + {BId, NId}. + + + + +get_next_btn_xpos(FrameWidth) -> + FrameWidth - ?X0 - ?NEXT_BTN_WIDTH. + + + +get_entry_width(TableType, FrameWidth, LblWidth) -> + HorizontalSpacing = + case TableType of + mnesia -> + 10; + ets -> + 0 + end, + FrameWidth - LblWidth - 2 * ?X0 - HorizontalSpacing. + + + +create_labels_and_entries(N, [H | T], [VH | VT], LblW, F, ListsAsStr) when N > 0 -> + Y = ?Y0 + (5 - N) * (?LABEL_HEIGHT + 10), + EntryW = get_entry_width(mnesia, ?FRAME_WIDTH, LblW), + EntryX = ?FRAME_WIDTH - EntryW - ?X0 - 2, + + EntryText = + case ListsAsStr of + true -> + tv_io_lib:format("~p", [VH]); + false -> + lists:flatten(io_lib:write(VH)) + end, + gs:label(F, [{width, LblW}, + {height, ?LABEL_HEIGHT}, + {x, ?X0}, + {y, Y}, + {bg, ?DEFAULT_BG_COLOR}, + {fg, {0,0,0}}, + {align,w}, + {font, ?FONT}, + {label, {text, atom_to_list(H)}} + ]), + gs:entry(H, F, [{width, EntryW}, + {height, ?LABEL_HEIGHT}, + {x, EntryX}, + {y, Y}, + {bg, {255,255,255}}, + {fg, {0,0,0}}, + {bw, 1}, + {font, ?FONT}, + {justify, left}, + {text, EntryText}, + {cursor, text}, + {setfocus, false}, + {enable, true}, + {keypress,true} + ]), + create_labels_and_entries(N - 1, T, VT, LblW, F, ListsAsStr); +create_labels_and_entries(0, RemAttrList, RemAttrValues, _LblW, _F, _ListsAsStr) -> + {RemAttrList, RemAttrValues}; +create_labels_and_entries(_N, [], [], _LblW, _F, _ListsAsStr) -> + {[], []}. + + + + +get_longest_attribute_name(AttrList) -> + get_longest_attribute_name(AttrList, 0, undefined). + + +get_longest_attribute_name([H | T], Max, Attr) -> + CurrLength = length(atom_to_list(H)), + if + CurrLength >= Max -> + get_longest_attribute_name(T, CurrLength, H); + true -> + get_longest_attribute_name(T, Max, Attr) + end; +get_longest_attribute_name([], _Max, Attr) -> + Attr. + + + + +get_window_height(N) -> + if + N >= 5 -> + ?WIN_HEIGHT; + true -> + ?WIN_HEIGHT - ((5 - N) * (?LABEL_HEIGHT + 10) + ?NEXT_BTN_HEIGHT + 8) + end. + + + +get_frame_height(N) -> + if + N >= 5 -> + ?FRAME_HEIGHT; + true -> + ?FRAME_HEIGHT - ((5 - N) * (?LABEL_HEIGHT + 10) + ?NEXT_BTN_HEIGHT + 8) + end. + + + + +set_entry_values(TabType, [H | T], [VH | VT], ListsAsStr) -> + EntryText = + case VH of + undefined when TabType =:= ets -> + ""; + _AnyValue -> + case ListsAsStr of + true -> + tv_io_lib:format("~p", [VH]); + false -> + lists:flatten(io_lib:write(VH)) + end + end, + gs:config(H, [{text, EntryText}]), + set_entry_values(TabType, T, VT, ListsAsStr); +set_entry_values(_TabType, [], [], _ListsAsStr) -> + done. diff --git a/lib/tv/src/tv_table_owner.erl b/lib/tv/src/tv_table_owner.erl new file mode 100644 index 0000000000..bccac6c236 --- /dev/null +++ b/lib/tv/src/tv_table_owner.erl @@ -0,0 +1,122 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1998-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% +-module(tv_table_owner). + + + +-export([create/5 + ]). + + +-export([internal_create/3, + start/0, + init/0 + ]). + + + +-define(REGISTERED_NAME, tv_table_owner). + + + +create(mnesia, _Node, _LocalNode, _TableName, _Options) -> + error; +create(ets, _Node, true, TabName, Options) -> + case catch internal_create(ets, TabName, Options) of + {TabName, Pid} when is_pid(Pid) -> + {ok, {TabName,Pid}}; + {TabNo, Pid} when is_pid(Pid) -> + {ok, {TabNo,Pid}}; + _OtherResult -> + error + end; +create(ets, Node, false, TabName, Options) -> + case catch rpc:block_call(Node, ?MODULE, internal_create, [ets, TabName, Options]) of + {TabName, Pid} when is_pid(Pid) -> + {ok, {TabName,Pid}}; + {TabNo, Pid} when is_pid(Pid) -> + {ok, {TabNo,Pid}}; + _OtherResult -> + error + end. + + + + + +internal_create(ets, TabName, Options) -> + ?MODULE:start(), + ?REGISTERED_NAME ! {create, self(), ets, TabName, Options}, + receive + {?REGISTERED_NAME, Result} -> + Result + after + 5000 -> + error + end. + + + + + + +start() -> + case whereis(?REGISTERED_NAME) of + undefined -> + ServerPid = spawn(?MODULE, init, []), + case catch register(?REGISTERED_NAME, ServerPid) of + true -> + ok; + {'EXIT', _Reason} -> + exit(ServerPid, kill), + timer:sleep(500), + start() + end; + Pid when is_pid(Pid) -> + ok + end. + + + + + + + + +init() -> + %% Currently no initialisations! + loop(). + + + + + + +loop() -> + receive + + {create, Sender, ets, TabName, Options} -> + Sender ! {?REGISTERED_NAME, (catch ets:new(TabName, Options))}, + loop(); + + + _Other -> + loop() + + end. + diff --git a/lib/tv/src/tv_utils.erl b/lib/tv/src/tv_utils.erl new file mode 100644 index 0000000000..fd232bde69 --- /dev/null +++ b/lib/tv/src/tv_utils.erl @@ -0,0 +1,176 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1998-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% +-module(tv_utils). + + + +-export([notify/3]). + + + + %% Minimum size of help windows +-define(wwin, 300). +-define(hwin, 180). + + %% Button sizes +-define(wbut, 60). +-define(hbut, 30). + +-define(pad, 10). + + +%---------------------------------------- +% notify(S,Strings) -> ok +% S = pid() GS +% Strings = string() | [string()] +% A notification window contains a message to the user. +% Will lock the GUI until the user confirms the message by +% pressing the 'Ok' button. +%---------------------------------------- +notify(S,Title,Strings) -> + W = required_width(Strings, ?wwin), + Htop = round(2 * ?hwin / 3), + Hbot = ?hwin - Htop, + + %% Open a new window + Win = gs:create(window,S,[{width, W}, + {height, ?hwin}, + {title, Title}, + {data, notifywin} + ]), + + %% Top frame containing a label + Top = gs:create(frame,Win,[{width, W}, + {height, Htop}, + {x, 0}, + {y, 0}, + {data, notifywin}, + {keypress, true} + ]), + + Lbl = gs:create(label,Top,[{width,W}, + {height, Htop - 2 * ?pad}, + {x, 0}, + {y, ?pad}, + {align, c}, + {justify, center}, + {data, notifywin}, + {keypress, true} + ]), + + gs:config(Lbl, {label, {text, insert_newlines(Strings)}}), + + %% Bottom frame containing an 'Ok' button + Bot = gs:create(frame,Win,[{width, W}, + {height, Hbot}, + {x, 0}, + {y, Htop} + ]), + gs:create(button,Bot,[{width, ?wbut}, + {height, ?hbut}, + {x, W / 2 - ?wbut/2}, + {y, Hbot / 2 - ?hbut / 2}, + {label, {text, "OK"}}, + {data, notifywin}, + {keypress, true}]), + + gs:config(Win, [{map,true}]), + + event_loop(Win,null). + + + + +insert_newlines([String|Rest]) when is_list(String), Rest=/=[]-> + String ++ "\n" ++ insert_newlines(Rest); +insert_newlines([Last]) -> + [Last]; +insert_newlines(Other) -> + Other. + + + + +event_loop(Win,Entry) -> + receive + + %% + %% Notify window + %% + + %% 'Ok' pressed in notify window + {gs,_Obj,_Event,notifywin,["OK"|_]} -> + gs:destroy(Win), + ok; + + %% 'Window manager destroy' received in notify window + {gs,_Obj,destroy,notifywin,_} -> + gs:destroy(Win), + ok; + + %% 'Return' pressed in notify or confirm window + {gs,_Obj,_Event,helpwin,['Return'|_]} -> + gs:destroy(Win), + ok; + + + %% + %% Common or partly common events + %% + + %% 'Window manager destroy' received in notify, + %% confirm,confirm_exit or request window + {gs,_Obj,destroy,_,_} -> + gs:destroy(Win), + cancel; + + %% Flush any other GS events + {gs,_Obj,_Event,_Data,_Arg} -> + event_loop(Win,Entry) + end. + + + + +%---------------------------------------- +% required_width(Strings,Min) -> Req +% Strings = string() | [string()] +% Min = Req = integer() +% Returns the minimum required width in pixels for a help window, +% which is the maximum of Min and the required width for Strings. +% NOTE: Font dependant really! +%---------------------------------------- +required_width([First|Rest],Min) when is_list(First) -> + Req = 7*length(First), % 7 pixels per character + if + Req>Min -> + required_width(Rest,Req); + true -> + required_width(Rest,Min) + end; +required_width([],Min) -> + Min; +required_width(String,Min) -> + Req = 7*length(String), + if + Req>Min -> + Req; + true -> + Min + end. + -- cgit v1.2.3