diff options
Diffstat (limited to 'lib/reltool/src')
| -rw-r--r-- | lib/reltool/src/Makefile | 99 | ||||
| -rw-r--r-- | lib/reltool/src/reltool.app.src | 37 | ||||
| -rw-r--r-- | lib/reltool/src/reltool.erl | 253 | ||||
| -rw-r--r-- | lib/reltool/src/reltool.hrl | 202 | ||||
| -rw-r--r-- | lib/reltool/src/reltool_app_win.erl | 886 | ||||
| -rw-r--r-- | lib/reltool/src/reltool_fgraph.erl | 163 | ||||
| -rw-r--r-- | lib/reltool/src/reltool_fgraph.hrl | 44 | ||||
| -rw-r--r-- | lib/reltool/src/reltool_fgraph_win.erl | 726 | ||||
| -rw-r--r-- | lib/reltool/src/reltool_mod_win.erl | 773 | ||||
| -rw-r--r-- | lib/reltool/src/reltool_server.erl | 1678 | ||||
| -rw-r--r-- | lib/reltool/src/reltool_sys_win.erl | 1292 | ||||
| -rw-r--r-- | lib/reltool/src/reltool_target.erl | 1226 | ||||
| -rw-r--r-- | lib/reltool/src/reltool_utils.erl | 555 |
13 files changed, 7934 insertions, 0 deletions
diff --git a/lib/reltool/src/Makefile b/lib/reltool/src/Makefile new file mode 100644 index 0000000000..fa24efbb8c --- /dev/null +++ b/lib/reltool/src/Makefile @@ -0,0 +1,99 @@ +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 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 = $(RELTOOL_VSN) +APP_VSN = "reltool-$(VSN)" + + +# ---------------------------------------------------- +# Release directory specification +# ---------------------------------------------------- + +RELSYSDIR = $(RELEASE_PATH)/lib/reltool-$(VSN) + +# ---------------------------------------------------- +# Target Specs +# ---------------------------------------------------- + +MODULES = \ + reltool \ + reltool_app_win \ + reltool_fgraph \ + reltool_fgraph_win \ + reltool_mod_win \ + reltool_sys_win \ + reltool_server \ + reltool_target \ + reltool_utils + +HRL_FILES = + +INTERNAL_HRL_FILES = reltool.hrl reltool_fgraph.hrl + +ERL_FILES = $(MODULES:%=%.erl) + +TARGET_FILES= $(MODULES:%=$(EBIN)/%.$(EMULATOR)) + +# ---------------------------------------------------- +# FLAGS +# ---------------------------------------------------- + +ERL_COMPILE_FLAGS += +'{parse_transform,sys_pre_attributes}' \ + +'{attribute,insert,app_vsn,$(APP_VSN)}' + +# ---------------------------------------------------- +# Targets +# ---------------------------------------------------- + +debug opt: $(TARGET_FILES) $(HRL_FILES) + +clean: + rm -f $(TARGET_FILES) + rm -f core + +docs: + +# ---------------------------------------------------- +# Dependencies +# ---------------------------------------------------- + +$(TARGET_FILES): $(HRL_FILES) $(INTERNAL_HRL_FILES) + +# ---------------------------------------------------- +# Release Target +# ---------------------------------------------------- + +include $(ERL_TOP)/make/otp_release_targets.mk + +release_spec: opt + $(INSTALL_DIR) $(RELSYSDIR)/src + $(INSTALL_DATA) $(INTERNAL_HRL_FILES) $(ERL_FILES) $(RELSYSDIR)/src + $(INSTALL_DIR) $(RELSYSDIR)/ebin + $(INSTALL_DATA) $(TARGET_FILES) $(RELSYSDIR)/ebin + +release_docs_spec: + diff --git a/lib/reltool/src/reltool.app.src b/lib/reltool/src/reltool.app.src new file mode 100644 index 0000000000..f83042c157 --- /dev/null +++ b/lib/reltool/src/reltool.app.src @@ -0,0 +1,37 @@ +%% This is an -*- erlang -*- file. +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 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, reltool, + [{description, "Release management tool"}, + {vsn, "%VSN%"}, + {modules, [ + reltool, + reltool_app, + reltool_fgraph, + reltool_fgraph_win, + reltool_gen, + reltool_mod, + reltool_sys, + reltool_server, + reltool_utils + ]}, + {applications, [kernel, stdlib]} + ] +}. diff --git a/lib/reltool/src/reltool.erl b/lib/reltool/src/reltool.erl new file mode 100644 index 0000000000..e6548bfe68 --- /dev/null +++ b/lib/reltool/src/reltool.erl @@ -0,0 +1,253 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 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(reltool). + +%% Public +-export([ + main/1, % Escript + start/0, start/1, start_link/1, debug/0, % GUI + start_server/1, get_server/1, stop/1, + get_config/1, get_config/3, get_rel/2, get_script/2, + create_target/2, get_target_spec/1, eval_target_spec/3, + install/2 + ]). + +-type file() :: string(). +-type dir() :: string(). +-type mod_cond() :: all | app | ebin | derived | none. +-type incl_cond() :: include | exclude | derived. +-type debug_info() :: keep | strip. +-type app_file() :: keep | strip | all. +-type re_regexp() :: string(). +-type regexps() :: [re_regexp()] | {add, [re_regexp()]} | {del, [re_regexp()]} . +-type incl_sys_filters() :: regexps(). +-type excl_sys_filters() :: regexps(). +-type incl_app_filters() :: regexps(). +-type excl_app_filters() :: regexps(). +-type incl_archive_filters() :: regexps(). +-type excl_archive_filters() :: regexps(). +-type archive_opt() :: term(). +-type root_dir() :: dir(). +-type lib_dir() :: dir(). +-type profile() :: development | embedded | standalone. +-type relocatable() :: boolean(). +-type escript_file() :: file(). +-type mod_name() :: atom(). +-type app_name() :: atom(). +-type app_vsn() :: string(). +-type app_type() :: permanent | transient | temporary | load | none. +-type incl_app() :: app_name(). +-type rel_name() :: string(). +-type rel_vsn() :: string(). +-type boot_rel() :: rel_name(). +-type rel_app() :: app_name() + | {app_name(), app_type()} + | {app_name(), [incl_app()]} + | {app_name(), app_type(), [incl_app()]}. +-type mod() :: {incl_cond, incl_cond()} + | {debug_info, debug_info()}. +-type app() :: {vsn, app_vsn()} + | {mod, mod_name(), mod()} + | {mod_cond, mod_cond()} + | {incl_cond, incl_cond()} + | {app_file, app_file()} + | {debug_info, debug_info()} + | {incl_app_filters, incl_app_filters()} + | {excl_app_filters, excl_app_filters()} + | {incl_archive_filters, incl_archive_filters()} + | {excl_archive_filters, excl_archive_filters()}. +-type escript() :: {incl_cond, incl_cond()}. +-type sys() :: {mod_cond, mod_cond()} + | {incl_cond, incl_cond()} + | {debug_info, debug_info()} + | {app_file, app_file()} + | {profile, profile()} + | {incl_sys_filters, incl_sys_filters()} + | {excl_sys_filters, excl_sys_filters()} + | {incl_app_filters, incl_app_filters()} + | {excl_app_filters, excl_app_filters()} + | {incl_archive_filters, incl_archive_filters()} + | {excl_archive_filters, excl_archive_filters()} + | {archive_opts, [archive_opt()]} + | {root_dir, root_dir()} + | {lib_dirs, [lib_dir()]} + | {boot_rel, boot_rel()} + | {rel, rel_name(), rel_vsn(), [rel_app()]} + | {relocatable, relocatable()} + | {erts, app()} + | {escript, escript_file(), [escript()]} + | {app, app_name(), [app()]}. +-type config() :: {sys, [sys()]}. +-type option() :: {wx_debug, term()} | {trap_exit, boolean()} | config() | {config, config() | file()}. +-type options() :: [option()]. +-type server_pid() :: pid(). +-type window_pid() :: pid(). +-type server() :: server_pid() | options(). +-type rel_file() :: term(). +-type script_file() :: term(). +-type reason() :: string(). +-type escript_arg() :: string(). +%%-type base_dir() :: dir(). +%%-type base_file() :: file(). +%%-type top_dir() :: file(). +%%-type top_file() :: file(). +%%-type target_spec() :: [target_spec()] +%% | {create_dir, base_dir(), [target_spec()]} +%% | {create_dir, base_dir(), top_dir(), [target_spec()]} +%% | {archive, base_file(), [archive_opt()], [target_spec()]} +%% | {copy_file, base_file()} +%% | {copy_file, base_file(), top_file()} +%% | {write_file, base_file(), iolist()} +%% | {strip_beam_file, base_file()}. +-type target_spec() :: term(). +-type target_dir() :: dir(). +-type incl_defaults() :: boolean(). +-type incl_derived() :: boolean(). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +%% Main function for escript +-spec main([escript_arg()]) -> ok. +main(_) -> + process_flag(trap_exit, true), + {ok, WinPid} = start_link([]), + receive + {'EXIT', WinPid, shutdown} -> + ok; + {'EXIT', WinPid, normal} -> + ok; + {'EXIT', WinPid, Reason} -> + io:format("EXIT: ~p\n", [Reason]), + erlang:halt(1) + end. + +%% Start main window process +-spec start() -> {ok, window_pid()}. +start() -> + start([]). + +%% Start main window process +-spec start(options()) -> {ok, window_pid() | {error, reason()}}. +start(Options)when is_list(Options) -> + {ok, WinPid} = start_link(Options), + unlink(WinPid), + {ok, WinPid}. + +%% Start main window process with wx debugging enabled +-spec debug() -> {ok, window_pid()}. +debug() -> + {ok, WinPid} = start_link([{wx_debug, 2}]), + unlink(WinPid), + {ok, WinPid}. + +%% Start main window process with options +-spec start_link(options()) -> {ok, window_pid() | {error, reason()}}. +start_link(Options) when is_list(Options) -> + case reltool_sys_win:start_link(Options) of + {ok, WinPid} -> + {ok, WinPid}; + {error, Reason} -> + {error, lists:flatten(io_lib:format("~p", [Reason]))} + end. + +%% Start server process with options +-spec start_server(options()) -> {ok, server_pid()} | {error, reason()}. +start_server(Options) -> + case reltool_server:start_link(Options) of + {ok, ServerPid, _Common, _Sys} -> + {ok, ServerPid}; + {error, Reason} -> + {error, lists:flatten(io_lib:format("~p", [Reason]))} + end. + +%% Start server process with options +-spec get_server(window_pid()) -> {ok, server_pid()} | {error, reason()}. +get_server(WinPid) -> + case reltool_sys_win:get_server(WinPid) of + {ok, ServerPid} -> + {ok, ServerPid}; + {error, Reason} -> + {error, lists:flatten(io_lib:format("~p", [Reason]))} + end. + +%% Stop a server or window process +-spec stop(server_pid() | window_pid()) -> ok | {error, reason()}. +stop(Pid) when is_pid(Pid) -> + Ref = erlang:monitor(process, Pid), + unlink(Pid), + exit(Pid, shutdown), + receive + {'DOWN', Ref, _, _, shutdown} -> + ok; + {'DOWN', Ref, _, _, Reason} -> + {error, lists:flatten(io_lib:format("~p", [Reason]))} + end. + +%% Internal library function +-spec eval_server(server(), fun((server_pid()) -> term())) -> {ok, server_pid()} | {error, reason()}. +eval_server(Pid, Fun) when is_pid(Pid) -> + Fun(Pid); +eval_server(Options, Fun) when is_list(Options), is_function(Fun, 1) -> + case start_server(Options) of + {ok, Pid} -> + Res = Fun(Pid), + stop(Pid), + Res; + {error, Reason} -> + {error, Reason} + end. + +%% Get reltool configuration +-spec get_config(server()) -> {ok, config()} | {error, reason()}. +get_config(PidOrOption) -> + get_config(PidOrOption, false, false). + +-spec get_config(server(), incl_defaults(), incl_derived()) -> {ok, config()} | {error, reason()}. +get_config(PidOrOptions, InclDefaults, InclDerived) when is_pid(PidOrOptions); is_list(PidOrOptions) -> + eval_server(PidOrOptions, fun(Pid) -> reltool_server:get_config(Pid, InclDefaults, InclDerived) end). + +%% Get contents of release file +-spec get_rel(server(), rel_name()) -> {ok, rel_file()} | {error, reason()}. +get_rel(PidOrOptions, RelName) when is_pid(PidOrOptions); is_list(PidOrOptions) -> + eval_server(PidOrOptions, fun(Pid) -> reltool_server:get_rel(Pid, RelName) end). + +%% Get contents of boot script file +-spec get_script(server(), rel_name()) -> {ok, script_file()} | {error, reason()}. +get_script(PidOrOptions, RelName) when is_pid(PidOrOptions); is_list(PidOrOptions) -> + eval_server(PidOrOptions, fun(Pid) -> reltool_server:get_script(Pid, RelName) end). + +%% Generate a target system +-spec create_target(server(), target_dir()) -> ok | {error, reason()}. +create_target(PidOrOptions, TargetDir) when is_pid(PidOrOptions); is_list(PidOrOptions) -> + eval_server(PidOrOptions, fun(Pid) -> reltool_server:gen_target(Pid, TargetDir) end). + +%% Generate a target system +-spec get_target_spec(server()) -> {ok, target_spec()} | {error, reason()}. +get_target_spec(PidOrOptions) when is_pid(PidOrOptions); is_list(PidOrOptions) -> + eval_server(PidOrOptions, fun(Pid) -> reltool_server:gen_spec(Pid) end). + +%% Generate a target system +-spec eval_target_spec(target_spec(), root_dir(), target_dir()) -> ok | {error, reason()}. +eval_target_spec(Spec, SourceDir, TargetDir) when is_list(SourceDir), is_list(TargetDir) -> + reltool_target:eval_spec(Spec, SourceDir, TargetDir). + +%% Install a target system +-spec install(rel_name(), dir()) -> ok | {error, reason()}. +install(RelName, TargetDir) -> + reltool_target:install(RelName, TargetDir). diff --git a/lib/reltool/src/reltool.hrl b/lib/reltool/src/reltool.hrl new file mode 100644 index 0000000000..736daab0f0 --- /dev/null +++ b/lib/reltool/src/reltool.hrl @@ -0,0 +1,202 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 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(APPLICATION, reltool). +-define(MISSING_APP, '*MISSING*'). +-define(MISSING_APP_TEXT, "*MISSING*"). + +-record(common, + { + sys_debug, % term() + wx_debug, % term() + trap_exit, % bool() + app_tab, % ets_tab() + mod_tab, % ets_tab() + mod_used_by_tab % ets_tab() + }). + +-record(sys, + { + %% Sources + root_dir, % directory() + lib_dirs, % [directory()] + escripts, % [file()] + mod_cond, % all | app | ebin | derived | none + incl_cond, % include | exclude | derived + apps, % [#app{}] + + %% Target cond + boot_rel, % string() + rels, % [#rel{}] + emu_name, % string() + profile, % standalone | development | embedded + incl_sys_filters, % [regexp()] + excl_sys_filters, % [regexp()] + incl_app_filters, % [regexp()] + excl_app_filters, % [regexp()] + incl_archive_filters, % [regexp()] + excl_archive_filters, % [regexp()] + archive_opts, % [zip:create()] + relocatable, % bool() + app_type, % permanent | transient | temporary | load | none + app_file, % keep | strip | all + debug_info % keep | strip + }). + +-record(rel, + { + name, % string() + vsn, % string() + rel_apps % [#rel_app{}] + }). + +-record(rel_app, + { + name, % atom() + app_type, % permanent | transient | temporary | load | none + incl_apps % [atom()] + }). + +-record(app, + {%% Static info + name, % atom() + is_escript, % bool() + use_selected_vsn,% bool() | undefined + active_dir, % dir_name() + sorted_dirs, % [dir_name()] + vsn, % string() e.g. "4.7" + label, % string() e.g. "mnesia" or "mnesia-4.7" + info, % #app_info{} | undefined + mods, % [#mod{}] + + %% Static source cond + mod_cond, % all | app | ebin | derived | none | undefined + incl_cond, % include | exclude | derived | undefined + + %% Static target cond + debug_info, % keep | strip | undefined + app_file, % keep | strip | all | undefined + app_type, % permanent | transient | temporary | load | none + incl_app_filters, % [regexp()] + excl_app_filters, % [regexp()] + incl_archive_filters, % [regexp()] + excl_archive_filters, % [regexp()] + archive_opts, % [zip_create_opt()] + + %% Dynamic + status, % missing | ok + uses_mods, % [atom()] + used_by_mods, % [atom()] + uses_apps, % [atom()] + used_by_apps, % [atom()] + is_pre_included, % bool() + is_included % bool() + }). + +-record(mod, + {%% Static + name, % atom() + app_name, % atom() + incl_cond, % include | exclude | derived | undefined + debug_info, % keep | strip | undefined + is_app_mod, % bool(), + is_ebin_mod, % bool(), + uses_mods, % [module()] + exists, % bool() + %% Dynamic + status, % missing | ok + used_by_mods, % [atom()] + is_pre_included, % bool() | undefined + is_included % bool() | undefined + }). + +%% app - Include all modules in app file +%% ebin - Include all modules on ebin directory +%% derived - Include only those modules that others are dependent on + +-record(app_info, + { + description = "", + id = "", + vsn = "", + modules = [], + maxP = infinity, + maxT = infinity, + registered = [], + incl_apps = [], + applications = [], + env = [], + mod = undefined, + start_phases = undefined + }). + +-record(regexp, {source, compiled}). + +-define(ERR_IMAGE, 0). +-define(WARN_IMAGE, 1). +-define(QUEST_IMAGE, 2). +-define(TICK_IMAGE, 3). +-define(CROSS_IMAGE, 4). +-define(SOURCE_IMAGE, 5). + +-define(KEYSEARCH(Key, Pos, List), + reltool_utils:safe_keysearch(Key, Pos, List, ?MODULE, ?LINE)). + +-define(DEFAULT_LIBS, []). +-define(DEFAULT_APPS, []). +-define(DEFAULT_INCL_COND, derived). +-define(DEFAULT_MOD_COND, all). +-define(DEFAULT_REL_NAME, "start_clean"). +-define(DEFAULT_EMU_NAME, "beam"). +-define(DEFAULT_PROFILE, development). +-define(DEFAULT_RELOCATABLE, true). +-define(DEFAULT_APP_TYPE, permanent). +-define(DEFAULT_APP_FILE, keep). +-define(DEFAULT_DEBUG_INFO, keep). + +-define(DEFAULT_INCL_ARCHIVE_FILTERS, [".*"]). +-define(DEFAULT_EXCL_ARCHIVE_FILTERS, ["^include$", "^priv$"]). +-define(DEFAULT_ARCHIVE_OPTS, []). + +-define(DEFAULT_INCL_SYS_FILTERS, [".*"]). +-define(DEFAULT_EXCL_SYS_FILTERS, []). +-define(DEFAULT_INCL_APP_FILTERS, [".*"]). +-define(DEFAULT_EXCL_APP_FILTERS, []). + +-define(EMBEDDED_INCL_SYS_FILTERS, ["^bin", + "^erts", + "^lib", + "^releases"]). +-define(EMBEDDED_EXCL_SYS_FILTERS, ["^bin/(erlc|dialyzer|typer)(|\\.exe)$", + "^erts.*/bin/(erlc|dialyzer|typer)(|\\.exe)$", + "^erts.*/bin/.*(debug|pdb)"]). +-define(EMBEDDED_INCL_APP_FILTERS, ["^ebin", + "^priv", + "^include"]). +-define(EMBEDDED_EXCL_APP_FILTERS, []). + +-define(STANDALONE_INCL_SYS_FILTERS, ["^bin/(erl|epmd)(|\\.exe|\\.ini)$", + "^bin/start(|_clean).boot$", + "^erts.*/bin", + "^lib$"]). +-define(STANDALONE_EXCL_SYS_FILTERS, ["^erts.*/bin/(erlc|dialyzer|typer)(|\\.exe)$", + "^erts.*/bin/(start|escript|to_erl|run_erl)(|\\.exe)$", + "^erts.*/bin/.*(debug|pdb)"]). +-define(STANDALONE_INCL_APP_FILTERS, ["^ebin", + "^priv"]). +-define(STANDALONE_EXCL_APP_FILTERS, ["^ebin/.*\\.appup$"]). diff --git a/lib/reltool/src/reltool_app_win.erl b/lib/reltool/src/reltool_app_win.erl new file mode 100644 index 0000000000..6083493c02 --- /dev/null +++ b/lib/reltool/src/reltool_app_win.erl @@ -0,0 +1,886 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 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(reltool_app_win). + +%% Public +-export([start_link/4, raise/1, refresh/1, open_mod/2]). + +%% Internal +-export([init/5, loop/1]). + +%% sys callback functions +-export([ + system_continue/3, + system_terminate/4, + system_code_change/4 + ]). + +-include_lib("wx/include/wx.hrl"). +-include("reltool.hrl"). + +-record(state, + {parent_pid, + xref_pid, + mod_wins, + sys, + common, + app, + frame, + panel, + book, + status_bar, + %% page, % apps | source | config + config_app_global, config_app_local, config_app_local_box, + config_mod_global, config_mod_local, config_mod_local_box, + config_latest, config_selected, config_source_box, + + app_used_by_ctrl, app_required_ctrl, app_incl_ctrl, app_uses_ctrl, + mods_source_ctrl, mods_white_ctrl, mods_black_ctrl, mods_derived_ctrl, + deps_used_by_ctrl, deps_uses_ctrl, + popup_menu}). +-record(mod_win, {name, pid}). + +-define(WIN_WIDTH, 800). +-define(WIN_HEIGHT, 600). +%% -define(MODS_MOD_COL_WIDTH, 250). +%% -define(MODS_APP_COL_WIDTH, 250). +%% -define(APPS_APP_COL_WIDTH, 250). + +-define(CLOSE_ITEM, ?wxID_EXIT). %% Use OS specific version if available +-define(ABOUT_ITEM, ?wxID_ABOUT). %% Use OS specific +-define(CONTENTS_ITEM, 300). + +-define(MODS_MOD_COL, 0). +-define(MODS_APP_COL, 1). +-define(APPS_APP_COL, 0). + +-define(source, "Available"). +-define(whitelist, "Included"). +-define(blacklist, "Excluded"). +-define(derived, "Derived"). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% Client + +start_link(WxEnv, Xref, Common, AppName) -> + proc_lib:start_link(?MODULE, init, [self(), WxEnv, Xref, Common, AppName], infinity, []). + +raise(Pid) -> + reltool_utils:cast(Pid, raise). + +refresh(Pid) -> + reltool_utils:cast(Pid, refresh). + +open_mod(Pid, ModName) -> + reltool_utils:call(Pid, {open_mod, ModName}). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% Server + +init(Parent, WxEnv, Xref, C, AppName) -> + try + do_init(Parent, WxEnv, Xref, C, AppName) + catch + error:Reason -> + exit({Reason, erlang:get_stacktrace()}) + end. + +do_init(Parent, WxEnv, Xref, C, AppName) -> + process_flag(trap_exit, C#common.trap_exit), + {ok, App} = reltool_server:get_app(Xref, AppName), + {ok, Sys} = reltool_server:get_sys(Xref), + S = #state{parent_pid = Parent, + xref_pid = Xref, + mod_wins = [], + sys = Sys, + common = C, + app = App}, + proc_lib:init_ack(Parent, {ok, self()}), + wx:set_env(WxEnv), + wx:debug(C#common.wx_debug), + S2 = wx:batch(fun() -> create_window(S) end), + loop(S2). + +loop(#state{xref_pid = Xref, common = C, app = App} = S) -> + receive + {system, From, Msg} -> + Dbg = C#common.sys_debug, + sys:handle_system_msg(Msg, From, S#state.parent_pid, ?MODULE, Dbg, S); + {cast, _From, raise} -> + wxFrame:raise(S#state.frame), + wxFrame:setFocus(S#state.frame), + ?MODULE:loop(S); + {cast, _From, refresh} -> + case reltool_server:get_app(Xref, App#app.name) of + {ok, App2} -> + {ok, Sys} = reltool_server:get_sys(Xref), + S2 = redraw_window(S#state{sys = Sys, app = App2}), + [ok = reltool_mod_win:refresh(MW#mod_win.pid) || MW <- S2#state.mod_wins], + ?MODULE:loop(S2); + {error, _Reason} -> + wxFrame:destroy(S#state.frame), + exit(shutdown) + end; + {call, ReplyTo, Ref, {open_mod, ModName}} -> + S2 = create_mod_window(S, ModName), + {value, #mod_win{pid = ModPid}} = lists:keysearch(ModName, #mod_win.name, S2#state.mod_wins), + reltool_utils:reply(ReplyTo, Ref, {ok, ModPid}), + ?MODULE:loop(S2); + #wx{event = #wxSize{}} = Wx -> + Wx2 = reltool_utils:get_latest_resize(Wx), + S2 = handle_event(S, Wx2), + ?MODULE:loop(S2); + #wx{obj = ObjRef, + event = #wxClose{type = close_window}} -> + wxFrame:destroy(ObjRef), + exit(shutdown); + #wx{} = Wx -> + S2 = handle_event(S, Wx), + ?MODULE:loop(S2); + {'EXIT', Pid, Reason} when Pid =:= S#state.parent_pid -> + exit(Reason); + {'EXIT', Pid, _Reason} = Exit -> + exit_warning(Exit), + S2 = S#state{mod_wins = lists:keydelete(Pid, #mod_win.pid, S#state.mod_wins)}, + ?MODULE:loop(S2); + Msg -> + error_logger:format("~p~p got unexpected message:\n\t~p\n", + [?MODULE, self(), Msg]), + ?MODULE:loop(S) + end. + +exit_warning({'EXIT', _Pid, shutdown}) -> + ok; +exit_warning({'EXIT', _Pid, _Reason} = Msg) -> + error_logger:format("~p~p got unexpected message:\n\t~p\n", + [?MODULE, self(), Msg]). + +create_window(#state{app = App} = S) -> + Title = app_title(App), + Frame = wxFrame:new(wx:null(), ?wxID_ANY, Title, []), + %% wxFrame:setSize(Frame, {?WIN_WIDTH, ?WIN_HEIGHT}), + Panel = wxPanel:new(Frame, []), + StatusBar = wxFrame:createStatusBar(Frame,[]), + + Book = wxNotebook:new(Panel, ?wxID_ANY, []), + + S2 = S#state{frame = Frame, + panel = Panel, + book = Book, + status_bar = StatusBar}, + Derived = app_to_mods(S2), + S3 = create_mods_page(S2, Derived), + S4 = create_apps_page(S3, Derived), + S5 = create_deps_page(S4, Derived), + S6 = create_config_page(S5), + Sizer = wxBoxSizer:new(?wxVERTICAL), + wxSizer:add(Sizer, Book, [{flag, ?wxEXPAND}, {proportion, 1}]), + + wxPanel:setSizer(Panel, Sizer), + wxSizer:fit(Sizer, Frame), + wxSizer:setSizeHints(Sizer, Frame), + wxFrame:show(Frame), + + wxFrame:connect(Frame, close_window), + S6. + +app_title(App) -> + lists:concat([?APPLICATION, " - ", App#app.label]). + +create_apps_page(S, Derived) -> + Panel = wxPanel:new(S#state.book, []), + Main = wxBoxSizer:new(?wxVERTICAL), + Upper = wxBoxSizer:new(?wxHORIZONTAL), + Lower = wxBoxSizer:new(?wxHORIZONTAL), + + UsedByCtrl = create_apps_list_ctrl(Panel, Upper, "Used by"), + wxSizer:add(Upper, wxStaticLine:new(Panel, [{style, ?wxLI_VERTICAL}]), [{border, 2}, {flag, ?wxALL bor ?wxEXPAND}]), + + RequiredCtrl = create_apps_list_ctrl(Panel, Upper, "Required"), + wxSizer:add(Upper, wxStaticLine:new(Panel, [{style, ?wxLI_VERTICAL}]), [{border, 2}, {flag, ?wxALL bor ?wxEXPAND}]), + InclCtrl = create_apps_list_ctrl(Panel, Upper, "Included"), + wxSizer:add(Upper, wxStaticLine:new(Panel, [{style, ?wxLI_VERTICAL}]), [{border, 2}, {flag, ?wxALL bor ?wxEXPAND}]), + UsesCtrl = create_apps_list_ctrl(Panel, Upper, "Uses"), + S2 = S#state{app_required_ctrl = RequiredCtrl, + app_used_by_ctrl = UsedByCtrl, + app_incl_ctrl = InclCtrl, + app_uses_ctrl = UsesCtrl}, + redraw_apps(S2, Derived), + wxSizer:add(Main, Upper, + [{border, 2}, + {flag, ?wxALL bor ?wxEXPAND}, + {proportion, 1}]), + + wxSizer:add(Main, Lower, + [{border, 2}, + {flag, ?wxALL bor ?wxEXPAND}]), + wxPanel:setSizer(Panel, Main), + wxNotebook:addPage(S2#state.book, Panel, "Application dependencies", []), + S2. + +create_apps_list_ctrl(Panel, Sizer, Text) -> + Width = lists:max([100, ?WIN_WIDTH - 40]) div 4, + Height = lists:max([100, ?WIN_HEIGHT - 100]), + ListCtrl = wxListCtrl:new(Panel, + [{style, + ?wxLC_REPORT bor + %% ?wxLC_SORT_ASCENDING bor + ?wxLC_SINGLE_SEL bor + ?wxHSCROLL bor + ?wxVSCROLL}, + {size, {Width, Height}} + ]), + + %% Prep images + reltool_utils:assign_image_list(ListCtrl), + + %% Prep column label + ListItem = wxListItem:new(), + wxListItem:setAlign(ListItem, ?wxLIST_FORMAT_LEFT), + wxListItem:setText(ListItem, Text), + wxListCtrl:insertColumn(ListCtrl, ?APPS_APP_COL, ListItem), + %% wxListCtrl:setColumnWidth(ListCtrl, ?APPS_APP_COL, ?APPS_APP_COL_WIDTH), + wxListItem:destroy(ListItem), + + wxSizer:add(Sizer, ListCtrl, + [{border, 2}, + {flag, ?wxALL bor ?wxEXPAND}, + {proportion, 1}]), + wxEvtHandler:connect(ListCtrl, size, [{skip, true}, {userData, apps_list_ctrl}]), + wxListCtrl:connect(ListCtrl, command_list_item_activated, [{userData, open_app}]), + wxWindow:connect(ListCtrl, enter_window), + ListCtrl. + +create_deps_page(S, Derived) -> + Panel = wxPanel:new(S#state.book, []), + Main = wxBoxSizer:new(?wxHORIZONTAL), + + UsedByCtrl = create_mods_list_ctrl(Panel, Main, "Modules used by others", " and their applications", undefined, undefined), + wxSizer:add(Main, wxStaticLine:new(Panel, [{style, ?wxLI_VERTICAL}]), [{border, 2}, {flag, ?wxALL bor ?wxEXPAND}]), + UsesCtrl = create_mods_list_ctrl(Panel, Main, "Used modules", " and their applications", undefined, undefined), + S2 = S#state{deps_used_by_ctrl = UsedByCtrl, + deps_uses_ctrl = UsesCtrl}, + redraw_mods(S2, Derived), + wxPanel:setSizer(Panel, Main), + wxNotebook:addPage(S2#state.book, Panel, "Module dependencies", []), + S2. + +create_mods_page(S, Derived) -> + Panel = wxPanel:new(S#state.book, []), + MainSz = wxBoxSizer:new(?wxHORIZONTAL), + + SourceCtrl = create_mods_list_ctrl(Panel, MainSz, ?source, "", whitelist_add, blacklist_add), + wxSizer:add(MainSz, wxStaticLine:new(Panel, [{style, ?wxLI_VERTICAL}]), [{border, 2}, {flag, ?wxALL bor ?wxEXPAND}]), + WhiteCtrl = create_mods_list_ctrl(Panel, MainSz, ?whitelist, "", whitelist_del, blacklist_add), + wxSizer:add(MainSz, wxStaticLine:new(Panel, [{style, ?wxLI_VERTICAL}]), [{border, 2}, {flag, ?wxALL bor ?wxEXPAND}]), + BlackCtrl = create_mods_list_ctrl(Panel, MainSz, ?blacklist, "", whitelist_add, blacklist_del), + wxSizer:add(MainSz, wxStaticLine:new(Panel, [{style, ?wxLI_VERTICAL}]), [{border, 2}, {flag, ?wxALL bor ?wxEXPAND}]), + DerivedCtrl = create_mods_list_ctrl(Panel, MainSz, ?derived, "", whitelist_add, blacklist_add), + S2 = S#state{mods_source_ctrl = SourceCtrl, + mods_white_ctrl = WhiteCtrl, + mods_black_ctrl = BlackCtrl, + mods_derived_ctrl = DerivedCtrl}, + redraw_mods(S2, Derived), + wxPanel:setSizer(Panel, MainSz), + wxNotebook:addPage(S2#state.book, Panel, "Modules", []), + S2. + +create_mods_list_ctrl(Panel, OuterSz, Title, AppText, Tick, Cross) -> + ListCtrl = wxListCtrl:new(Panel, + [{style, + ?wxLC_REPORT bor + %% ?wxLC_SORT_ASCENDING bor + %% ?wxLC_SINGLE_SEL bor + ?wxHSCROLL bor + ?wxVSCROLL}]), + ToolTip = "Select module(s) or open separate module window with a double click.", + wxListCtrl:setToolTip(ListCtrl, ToolTip), + + %% Prep images + reltool_utils:assign_image_list(ListCtrl), + + %% Prep column label + ListItem = wxListItem:new(), + wxListItem:setAlign(ListItem, ?wxLIST_FORMAT_LEFT), + wxListItem:setText(ListItem, Title), + wxListCtrl:insertColumn(ListCtrl, ?MODS_MOD_COL, ListItem), + %% wxListCtrl:setColumnWidth(ListCtrl, ?MODS_MOD_COL, ?MODS_MOD_COL_WIDTH), + Prop = + case AppText =/= "" of + true -> + wxListItem:setText(ListItem, AppText), + wxListCtrl:insertColumn(ListCtrl, ?MODS_APP_COL, ListItem), + %% wxListCtrl:setColumnWidth(ListCtrl, ?MODS_APP_COL, ?MODS_APP_COL_WIDTH), + 2; + false -> + 1 + end, + wxListItem:destroy(ListItem), + + ButtonSz = wxBoxSizer:new(?wxHORIZONTAL), + create_button(Panel, ButtonSz, ListCtrl, Title, "wxART_TICK_MARK", Tick), + create_button(Panel, ButtonSz, ListCtrl, Title, "wxART_CROSS_MARK", Cross), + wxEvtHandler:connect(ListCtrl, size, [{skip, true}, {userData, mods_list_ctrl}]), + wxListCtrl:connect(ListCtrl, command_list_item_activated, [{userData, open_mod}]), + wxWindow:connect(ListCtrl, enter_window), + InnerSz = wxBoxSizer:new(?wxVERTICAL), + wxSizer:add(InnerSz, ListCtrl, + [{border, 2}, + {flag, ?wxALL bor ?wxEXPAND}, + {proportion, 1}]), + wxSizer:add(InnerSz, ButtonSz, + [{flag, ?wxALL bor ?wxEXPAND}]), + wxSizer:add(OuterSz, InnerSz, + [{flag, ?wxALL bor ?wxEXPAND}, + {proportion, Prop}]), + ListCtrl. + +create_button(_Panel, Sizer, _ListCtrl, _Title, _BitMapName, undefined) -> + wxSizer:addStretchSpacer(Sizer); +create_button(Panel, Sizer, ListCtrl, Title, BitMapName, Action) -> + %% InnerSz = wxBoxSizer:new(?wxVERTICAL), + BitMap = wxArtProvider:getBitmap(BitMapName), + Button = wxBitmapButton:new(Panel, ?wxID_ANY, BitMap, []), + ToolTip = action_to_tool_tip(Title, Action), + wxBitmapButton:setToolTip(Button, ToolTip), + %% wxSizer:add(InnerSz, Button, [{flag, ?wxALIGN_CENTER_HORIZONTAL}]), + Opts = [{userData, {mod_button, Action, ListCtrl}}], + wxEvtHandler:connect(Button, command_button_clicked, Opts), + wxSizer:add(Sizer, Button, + [{border, 2}, + {flag, ?wxALL bor ?wxALIGN_CENTER_HORIZONTAL}, + {proportion, 1}]). + +action_to_tool_tip(Label, Action) -> + case Action of + whitelist_add when Label =:= ?whitelist -> + "Remove selected module(s) from whitelist."; + whitelist_add -> + "Add selected module(s) to whitelist."; + whitelist_del -> + "Remove selected module(s)from whitelist."; + blacklist_add when Label =:= ?blacklist -> + "Remove selected module(s) from blacklist."; + blacklist_add -> + "Add selected module(s) to blacklist."; + blacklist_del -> + "Remove selected module(s) from blacklist." + end. + +create_config_page(#state{app = App} = S) -> + Panel = wxPanel:new(S#state.book, []), + TopSizer = wxBoxSizer:new(?wxVERTICAL), + + %% Source dirs + {LatestRadio, SelectedRadio, SourceBox} = + create_double_box(Panel, + TopSizer, + "Source selection policy", + "Use latest version", + use_latest_vsn, + "Use selected version", + use_selected_vsn, + "Directories", + App#app.sorted_dirs, + version), + + InclSizer = wxBoxSizer:new(?wxHORIZONTAL), + + %% Application inclusion + {AppGlobalRadio, AppLocalRadio, AppLocalBox} = + create_double_box(Panel, + InclSizer, + "Application inclusion policy", + "Use global config", + global_incl_cond, + "Use application specific config", + local_incl_cond, + "Application specific", + reltool_utils:incl_conds(), + incl_cond), + + %% Module inclusion + {ModGlobalRadio, ModLocalRadio, ModLocalBox} = + create_double_box(Panel, + InclSizer, + "Module inclusion policy", + "Use global config", + global_mod_cond, + "Use application specific config", + local_mod_cond, + "Application specific", + reltool_utils:mod_conds(), + mod_cond), + wxSizer:add(TopSizer, InclSizer, + [{border, 2}, {flag, ?wxALL bor ?wxEXPAND}, {proportion, 1}]), + + S2 = S#state{config_app_global = AppGlobalRadio, + config_app_local = AppLocalRadio, + config_app_local_box = AppLocalBox, + config_mod_global = ModGlobalRadio, + config_mod_local = ModLocalRadio, + config_mod_local_box = ModLocalBox, + config_latest = LatestRadio, + config_selected = SelectedRadio, + config_source_box = SourceBox}, + redraw_config(S2), + wxPanel:setSizer(Panel, TopSizer), + wxNotebook:addPage(S2#state.book, Panel, "Application settings", []), + S2. + +create_double_box(Panel, Sizer, TopLabel, + OuterText, OuterData, + InnerText, InnerData, + InternalLabel, InternalChoices, InternalChoiceData) -> + TopSizer = wxStaticBoxSizer:new(?wxVERTICAL, Panel, + [{label, TopLabel}]), + OuterSizer = wxBoxSizer:new(?wxVERTICAL), + OuterRadio = wxRadioButton:new(Panel, ?wxID_ANY, OuterText, + [{style, ?wxRB_GROUP}]), + wxEvtHandler:connect(OuterRadio, command_radiobutton_selected, + [{userData, OuterData}]), + InnerRadio = wxRadioButton:new(Panel, ?wxID_ANY, InnerText), + wxEvtHandler:connect(InnerRadio, command_radiobutton_selected, + [{userData, InnerData}]), + InnerBox = wxRadioBox:new(Panel, + ?wxID_ANY, + InternalLabel, + ?wxDefaultPosition, + ?wxDefaultSize, + InternalChoices, + []), + wxEvtHandler:connect(InnerBox, command_radiobox_selected, + [{userData, InternalChoiceData}]), + wxSizer:add(OuterSizer, OuterRadio, + [{border, 2}, {flag, ?wxALL bor ?wxEXPAND}]), + wxSizer:add(OuterSizer, InnerRadio, + [{border, 2}, {flag, ?wxALL bor ?wxEXPAND}]), + wxSizer:add(TopSizer, OuterSizer, + [{border, 2}, {flag, ?wxALL bor ?wxEXPAND}]), + wxSizer:add(TopSizer, InnerBox, + [{border, 2}, {flag, ?wxALL bor ?wxEXPAND}, {proportion, 1}]), + wxSizer:add(Sizer, TopSizer, + [{border, 2}, {flag, ?wxALL bor ?wxEXPAND}, {proportion, 1}]), + {OuterRadio, InnerRadio, InnerBox}. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +handle_event(#state{sys = Sys, app = App} = S, Wx) -> + %% io:format("wx: ~p\n", [Wx]), + case Wx of + #wx{obj = ObjRef, event = #wxMouse{type = enter_window}} -> + wxWindow:setFocus(ObjRef), + S; + #wx{obj= ListCtrl, userData = mods_list_ctrl, event = #wxSize{type = size, size = {W, _H}}} -> + HasApps = (wxListCtrl:getColumnCount(ListCtrl) > 1), + case HasApps of + false -> + wxListCtrl:setColumnWidth(ListCtrl, ?MODS_MOD_COL, W); + true -> + wxListCtrl:setColumnWidth(ListCtrl, ?MODS_MOD_COL, (2 * W) div 3), + wxListCtrl:setColumnWidth(ListCtrl, ?MODS_APP_COL, W div 3) + end, + S; + #wx{obj= ListCtrl, userData = apps_list_ctrl, event = #wxSize{type = size, size = {W, _H}}} -> + wxListCtrl:setColumnWidth(ListCtrl, ?APPS_APP_COL, W), + S; + #wx{userData = open_app, + obj = ListCtrl, + event = #wxList{type = command_list_item_activated, itemIndex = Pos}} -> + AppBase = wxListCtrl:getItemText(ListCtrl, Pos), + {AppName, _AppVsn} = reltool_utils:split_app_name(AppBase), + {ok, _AppPid} = reltool_sys_win:open_app(S#state.parent_pid, AppName), + S; + #wx{userData = open_mod, + obj = ListCtrl, + event = #wxList{type = command_list_item_activated, itemIndex = Pos}} -> + ModName = list_to_atom(wxListCtrl:getItemText(ListCtrl, Pos)), + create_mod_window(S, ModName); + #wx{userData = global_incl_cond} -> + %% Use global setting + change_incl_cond(S, App, undefined); + #wx{userData = local_incl_cond} -> + %% Use app spec setting + change_incl_cond(S, App, Sys#sys.incl_cond); + #wx{userData = incl_cond, + %% Change app spec setting + event = #wxCommand{type = command_radiobox_selected, + cmdString = Sel}} -> + AppCond = reltool_utils:list_to_incl_cond(Sel), + change_incl_cond(S, App, AppCond); + + #wx{userData = global_mod_cond} -> + %% Use global setting + change_mod_cond(S, App, undefined); + #wx{userData = local_mod_cond} -> + %% Use app spec setting + change_mod_cond(S, App, Sys#sys.mod_cond); + #wx{userData = mod_cond, + %% Change app spec setting + event = #wxCommand{type = command_radiobox_selected, + cmdString = Sel}} -> + ModCond = reltool_utils:list_to_mod_cond(Sel), + change_mod_cond(S, App, ModCond); + + #wx{userData = use_latest_vsn} -> + %% Use latest version + App2 = App#app{use_selected_vsn = undefined}, + S2 = change_version(S, App2, App#app.active_dir), + redraw_window(S2); + #wx{userData = use_selected_vsn} -> + %% Use selected version + App2 = App#app{use_selected_vsn = true}, + {ok, App3} = reltool_sys_win:set_app(S#state.parent_pid, App2), + S2 = S#state{app = App3}, + redraw_window(S2); + #wx{userData = version, + event = #wxCommand{type = command_radiobox_selected, + cmdString = ActiveDir}} -> + %% Change app source + S2 = change_version(S, App, ActiveDir), + redraw_window(S2); + #wx{userData = {mod_button, Action, ListCtrl}, + event = #wxCommand{type = command_button_clicked}} -> + Items = reltool_utils:get_items(ListCtrl), + handle_mod_button(S, Items, Action); + _ -> + error_logger:format("~p~p got unexpected app event from wx:\n\t~p\n", + [?MODULE, self(), Wx]), + S + end. + +create_mod_window(#state{parent_pid = RelPid, xref_pid = Xref, common = C} = S, ModName) -> + case lists:keysearch(ModName, #mod_win.name, S#state.mod_wins) of + false -> + WxEnv = wx:get_env(), + {ok, Pid} = reltool_mod_win:start_link(WxEnv, Xref, RelPid, C, ModName), + MW = #mod_win{name = ModName, pid = Pid}, + S#state{mod_wins = [MW | S#state.mod_wins]}; + {value, MW} -> + reltool_app_win:raise(MW#mod_win.pid), + S + end. + +handle_mod_button(#state{app = App} = S, Items, Action) -> + App2 = lists:foldl(fun(Item, A) -> move_mod(A, Item, Action) end, App, Items), + {ok, App3} = reltool_sys_win:set_app(S#state.parent_pid, App2), + S2 = S#state{app = App3}, + redraw_window(S2). + +move_mod(App, {_ItemNo, ModStr}, Action) -> + ModName = list_to_atom(ModStr), + Mods = App#app.mods, + {value, M} = lists:keysearch(ModName, #mod.name, Mods), + AppCond = + case Action of + whitelist_add -> + case M#mod.incl_cond of + include -> undefined; + exclude -> include; + undefined -> include + end; + whitelist_del -> + undefined; + blacklist_add -> + exclude; + blacklist_del -> + undefined; + _ -> + error_logger:format("~p~p got unexpected mod button event: ~p\n\t ~p\n", + [?MODULE, self(), ModName, Action]), + M#mod.incl_cond + end, + M2 = M#mod{incl_cond = AppCond}, + Mods2 = lists:keystore(ModName, #mod.name, Mods, M2), + App#app{mods = Mods2}. + +change_incl_cond(S, App, NewAppCond) -> + App2 = App#app{incl_cond = NewAppCond}, + {ok, App3} = reltool_sys_win:set_app(S#state.parent_pid, App2), + S2 = S#state{app = App3}, + redraw_window(S2). + +change_mod_cond(S, App, NewModCond) -> + App2 = App#app{mod_cond = NewModCond}, + {ok, App3} = reltool_sys_win:set_app(S#state.parent_pid, App2), + S2 = S#state{app = App3}, + redraw_window(S2). + +change_version(S, App, NewDir) -> + App2 = App#app{active_dir = NewDir, label = undefined, vsn = undefined, info = undefined}, + {ok, App3} = reltool_sys_win:set_app(S#state.parent_pid, App2), + Title = app_title(App3), + wxFrame:setTitle(S#state.frame, Title), + S#state{app = App3}. + +redraw_apps(#state{app = #app{info = AppInfo}, + app_used_by_ctrl = UsedByCtrl, + app_required_ctrl = RequiredCtrl, + app_incl_ctrl = InclCtrl, + app_uses_ctrl = UsesCtrl, + xref_pid = Xref}, + {_SourceMods, _WhiteMods, _BlackMods, _DerivedMods, UsedByMods, UsesMods}) -> + UsedByApps = lists:usort([{M#mod.app_name, Image} || {Image, _, M} <- UsedByMods]), + Select = + fun(AppName) -> + {ok, App} = reltool_server:get_app(Xref, AppName), + case App#app.status of + missing -> {AppName, ?ERR_IMAGE}; + ok -> {AppName, ?TICK_IMAGE} + end + end, + RequiredApps = lists:sort(lists:map(Select, AppInfo#app_info.applications)), + InclApps = lists:map(Select, AppInfo#app_info.incl_apps), + UsesApps = lists:usort([{M#mod.app_name, Image} || {Image, _, M} <- UsesMods]), + do_redraw_apps(UsedByCtrl, UsedByApps), + do_redraw_apps(RequiredCtrl, RequiredApps), + do_redraw_apps(InclCtrl, InclApps), + do_redraw_apps(UsesCtrl, UsesApps), + ok. + +do_redraw_apps(ListCtrl, []) -> + wxListCtrl:deleteAllItems(ListCtrl); + %% wxListCtrl:setColumnWidth(ListCtrl, ?APPS_APP_COL, ?wxLIST_AUTOSIZE_USEHEADER); +do_redraw_apps(ListCtrl, AppImages) -> + wxListCtrl:deleteAllItems(ListCtrl), + Add = + fun({AppName, ImageId}, {Row, Prev}) when AppName =/= Prev -> + wxListCtrl:insertItem(ListCtrl, Row, ""), + if (Row rem 2) =:= 0 -> + wxListCtrl:setItemBackgroundColour(ListCtrl, Row, {240,240,255}); + true -> + ignore + end, + Str = atom_to_list(AppName), + wxListCtrl:setItem(ListCtrl, Row, ?APPS_APP_COL, Str, [{imageId, ImageId}]), + {Row + 1, AppName}; + ({_, _}, Acc) -> + Acc + end, + wx:foldl(Add, {0, undefined}, AppImages). + +%% print(X, X, Format, Args) -> +%% io:format(Format, Args); +%% print(_, _, _, _) -> +%% ok. + +redraw_mods(#state{mods_source_ctrl = SourceCtrl, + mods_white_ctrl = WhiteCtrl, + mods_black_ctrl = BlackCtrl, + mods_derived_ctrl = DerivedCtrl, + deps_used_by_ctrl = UsedByCtrl, + deps_uses_ctrl = UsesCtrl, + app = #app{is_pre_included = IsPre, is_included = IsIncl}, + status_bar = Bar}, + {SourceMods, WhiteMods, BlackMods, DerivedMods, UsedByMods, UsesMods}) -> + InclStatus = + case IsIncl of + true when IsPre =:= true -> "Whitelist - "; + true -> "Derived - "; + false -> "Blacklist - "; + undefined -> "Source - " + end, + Status = lists:concat([InclStatus, + length(WhiteMods), " whitelisted modules and ", + length(DerivedMods), " derived modules."]), + wxStatusBar:setStatusText(Bar, Status), + opt_redraw_mods(SourceCtrl, SourceMods), + opt_redraw_mods(WhiteCtrl, WhiteMods), + opt_redraw_mods(BlackCtrl, BlackMods), + opt_redraw_mods(DerivedCtrl, DerivedMods), + opt_redraw_mods(UsedByCtrl, UsedByMods), + opt_redraw_mods(UsesCtrl, UsesMods). + +app_to_mods(#state{xref_pid = Xref, app = App}) -> + SourceMods = [M || M <- App#app.mods, + M#mod.is_included =/= true, + M#mod.is_pre_included =/= false], + WhiteMods = [M || M <- App#app.mods, + M#mod.is_pre_included =:= true], + BlackMods = [M || M <- App#app.mods, + M#mod.is_pre_included =:= false], + DerivedMods = [M || M <- App#app.mods, + M#mod.is_included =:= true, + M#mod.is_pre_included =/= true], + GetMod = + fun(ModName) when is_atom(ModName) -> + {ok, M} = reltool_server:get_mod(Xref, ModName), + if + M#mod.app_name =:= App#app.name, M#mod.is_included =:= true -> + false; + true -> + {true, M} + end + end, + UsedByMods = lists:zf(GetMod, App#app.used_by_mods), + UsesMods = lists:zf(GetMod, App#app.uses_mods), + { + [select_image(source, M) || M <- SourceMods], + [select_image(whitelist, M) || M <- WhiteMods], + [select_image(blacklist, M) || M <- BlackMods], + [select_image(derived, M) || M <- DerivedMods], + [select_image(used_by, M) || M <- UsedByMods], + [select_image(uses, M) || M <- UsesMods] + }. + +select_image(Kind, M) -> + Image = + case Kind of + blacklist when M#mod.status =:= missing -> + ?WARN_IMAGE; + source when M#mod.status =:= missing -> + ?WARN_IMAGE; + _ when M#mod.status =:= missing -> + ?ERR_IMAGE; + blacklist when M#mod.incl_cond =:= exclude -> + ?CROSS_IMAGE; + blacklist -> + ?SOURCE_IMAGE; + source -> + ?CROSS_IMAGE; + whitelist when M#mod.incl_cond =:= include -> + ?TICK_IMAGE; + whitelist -> + ?SOURCE_IMAGE; + derived -> + ?TICK_IMAGE; + used_by when M#mod.is_included =:= true -> + ?TICK_IMAGE; + used_by when M#mod.is_included =:= false -> + ?WARN_IMAGE; + used_by -> + ?ERR_IMAGE; + uses when M#mod.is_included =:= true -> + ?TICK_IMAGE; + uses when M#mod.is_included =:= false -> + ?WARN_IMAGE; + uses -> + ?ERR_IMAGE + end, + {Image, M#mod.app_name, M}. + +opt_redraw_mods(undefined, _ImageMods) -> + ok; +opt_redraw_mods(ListCtrl, ImageMods) -> + HasApps = (wxListCtrl:getColumnCount(ListCtrl) > 1), + do_redraw_mods(ListCtrl, ImageMods, HasApps). + +do_redraw_mods(ListCtrl, [], _HasApps) -> + wxListCtrl:deleteAllItems(ListCtrl); +do_redraw_mods(ListCtrl, ImageMods, HasApps) -> + wxListCtrl:deleteAllItems(ListCtrl), + Add = + fun({ImageId, AppName, #mod{name = ModName}}, Row) -> + wxListCtrl:insertItem(ListCtrl, Row, ""), + if (Row rem 2) =:= 0 -> + wxListCtrl:setItemBackgroundColour(ListCtrl, Row, {240,240,255}); + true -> + ignore + end, + wxListCtrl:setItem(ListCtrl, Row, ?MODS_MOD_COL, atom_to_list(ModName), [{imageId, ImageId}]), + case HasApps of + false -> + ok; + true -> + wxListCtrl:setItem(ListCtrl, + Row, + ?MODS_APP_COL, + atom_to_list(AppName), + [{imageId, ImageId}]) + end, + Row + 1 + end, + wx:foldl(Add, 0, lists:sort(ImageMods)). + +redraw_config(#state{sys = #sys{incl_cond = GlobalIncl, + mod_cond = GlobalSource}, + app = #app{incl_cond = LocalIncl, + mod_cond = LocalSource, + use_selected_vsn = UseSelected, + active_dir = ActiveDir, + sorted_dirs = SortedDirs}, + config_app_global = AppGlobalRadio, + config_app_local = AppLocalRadio, + config_app_local_box = AppLocalBox, + config_mod_global = ModGlobalRadio, + config_mod_local = ModLocalRadio, + config_mod_local_box = ModLocalBox, + config_latest = LatestRadio, + config_selected = SelectedRadio, + config_source_box = SourceBox}) -> + redraw_double_box(GlobalIncl, + LocalIncl, + AppGlobalRadio, + AppLocalRadio, + AppLocalBox, + fun reltool_utils:incl_cond_to_index/1), + redraw_double_box(GlobalSource, + LocalSource, + ModGlobalRadio, + ModLocalRadio, + ModLocalBox, + fun reltool_utils:mod_cond_to_index/1), + redraw_double_box(false, + UseSelected, + LatestRadio, + SelectedRadio, + SourceBox, + fun(true) -> + reltool_utils:elem_to_index(ActiveDir, SortedDirs) - 1; + (false) -> + 0 + end). + +redraw_double_box(Global, Local, GlobalRadio, LocalRadio, LocalBox, GetChoice) -> + AppCond = + case Local of + undefined -> + wxRadioButton:setValue(GlobalRadio, true), + wxRadioButton:setValue(LocalRadio, false), + wxRadioBox:disable(LocalBox), + Global; + _ -> + wxRadioButton:setValue(GlobalRadio, false), + wxRadioButton:setValue(LocalRadio, true), + wxRadioBox:enable(LocalBox), + Local + end, + Choice = GetChoice(AppCond), + wxRadioBox:setSelection(LocalBox, Choice). + +redraw_window(S) -> + %% wx_misc:beginBusyCursor(), + Derived = app_to_mods(S), + redraw_config(S), + redraw_mods(S, Derived), + redraw_apps(S, Derived), + %% wx_misc:endBusyCursor(), + S. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% sys callbacks + +system_continue(_Parent, _Debug, S) -> + ?MODULE:loop(S). + +system_terminate(Reason, _Parent, _Debug, _S) -> + exit(Reason). + +system_code_change(S,_Module,_OldVsn,_Extra) -> + {ok, S}. diff --git a/lib/reltool/src/reltool_fgraph.erl b/lib/reltool/src/reltool_fgraph.erl new file mode 100644 index 0000000000..09c4f8c8ce --- /dev/null +++ b/lib/reltool/src/reltool_fgraph.erl @@ -0,0 +1,163 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 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(reltool_fgraph). + +-export([ + step/2, + step/3 + ]). + +-export([ + new/0, + + add/3, + set/3, + del/2, + + is_defined/2, + get/2, + size/1, + + foreach/2, + map/2, + foldl/3, + mapfoldl/3 + ]). + +-compile(inline). +-compile({inline_size, 128}). + +-include("reltool_fgraph.hrl"). + +%% KEY-VALUE STORAGE Process dictionary +new() -> []. + +is_defined(Key, _Fg) -> + case get(Key) of + undefined -> false; + _ -> true + end. + +get(K, _Fg) -> + case get(K) of + {_, V} -> V; + _ -> undefined + end. + +add(Key, Value, Fg) -> + put(Key, {Key, Value}), + [Key|Fg]. + +set(Key, Value, Fg) -> + put(Key, {Key, Value}), + Fg. + +size(Fg) -> length(Fg). + +del(Key, Fg) -> + erase(Key), + lists:delete(Key, Fg). + +foreach(Fun, Fg) -> + lists:foreach(fun + (Key) -> Fun(get(Key)) + end, Fg), + Fg. + +map(Fun, Fg) -> + lists:foreach(fun + (Key) -> put(Key,Fun(get(Key))) + end, Fg), + Fg. + +foldl(Fun, I, Fg) -> + lists:foldl(fun + (Key, Out) -> + Fun(get(Key), Out) + end, I, Fg). + +mapfoldl(Fun, I, Fg) -> + Acc = lists:foldl(fun + (Key, Out) -> + {Value, Acc} = Fun(get(Key), Out), + put(Key, Value), + Acc + end, I, Fg), + {Fg, Acc}. + +step(Vs, Es) -> step(Vs, Es, {0,0}). +step(Vs, Es, Pa) -> + ?MODULE:map(fun + (Node = {_, #fg_v{ type = static }}) -> Node; + ({Key, Value = #fg_v{ p = {Px, Py}, v = {Vx, Vy}, type = dynamic}}) when is_float(Px), is_float(Py), is_float(Vx), is_float(Vy) -> + F0 = {0.0,0.0}, + F1 = coulomb_repulsion(Key, Value, Vs, F0), + F2 = hooke_attraction(Key, Value, Vs, Es, F1), + F3 = point_attraction(Key, Value, Pa, F2), + + {Fx, Fy} = F3, + + Vx1 = (Vx + ?fg_th*Fx)*?fg_damp, + Vy1 = (Vy + ?fg_th*Fy)*?fg_damp, + + Px1 = Px + ?fg_th*Vx1, + Py1 = Py + ?fg_th*Vy1, + + {Key, Value#fg_v{ p = {Px1, Py1}, v = {Vx1, Vy1}}}; + (Node) -> Node + end, Vs). + +point_attraction(_, #fg_v{ p = P0 }, Pa, {Fx, Fy}) when is_float(Fx), is_float(Fy) -> + K = 20, + L = 150, + {R, {Cx,Cy}} = composition(P0, Pa), + F = -K*?fg_stretch*(R - L), + {Fx + Cx*F, Fy + Cy*F}. + +coulomb_repulsion(K0, #fg_v{ p = P0, q = Q0}, Vs, {Fx0, Fy0}) when is_float(Fx0), is_float(Fy0) -> + ?MODULE:foldl(fun + ({K1, _}, F) when K1 == K0 -> F; + ({_, #fg_v{ p = P1, q = Q1}}, {Fx, Fy}) -> + {R, {Cx, Cy}} = composition(P0, P1), + F = ?fg_kc*(Q1*Q0)/(R*R+0.0001), + {Fx + Cx*F, Fy + Cy*F}; + (_, F) -> F + end, {Fx0, Fy0}, Vs). + +hooke_attraction(Key0, #fg_v{ p = P0 }, Vs, Es, {Fx0, Fy0}) when is_float(Fx0), is_float(Fy0) -> + ?MODULE:foldl(fun + ({{Key1,Key1}, _}, F) -> F; + ({{Key1,Key2}, #fg_e{ l = L, k = K}}, {Fx, Fy}) when Key1 =:= Key0-> + #fg_v{ p = P1} = ?MODULE:get(Key2, Vs), + {R, {Cx,Cy}} = composition(P0, P1), + F = -K*?fg_stretch*(R - L), + {Fx + Cx*F, Fy + Cy*F}; + ({{Key2,Key1}, #fg_e{ l = L, k = K}}, {Fx, Fy}) when Key1 =:= Key0-> + #fg_v{ p = P1} = ?MODULE:get(Key2, Vs), + {R, {Cx,Cy}} = composition(P0, P1), + F = -K*?fg_stretch*(R - L), + {Fx + Cx*F, Fy + Cy*F}; + (_, F) -> F + end, {Fx0, Fy0}, Es). + +composition({Px1, Py1}, {Px0, Py0}) when is_float(Px1), is_float(Py1), is_float(Px0), is_float(Py0) -> + Dx = Px1 - Px0, + Dy = Py1 - Py0, + R = math:sqrt(Dx*Dx + Dy*Dy + 0.001), + {R, {Dx/R, Dy/R}}. diff --git a/lib/reltool/src/reltool_fgraph.hrl b/lib/reltool/src/reltool_fgraph.hrl new file mode 100644 index 0000000000..3eba93e3a8 --- /dev/null +++ b/lib/reltool/src/reltool_fgraph.hrl @@ -0,0 +1,44 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 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(fg_th, (0.25)). +-define(fg_damp, (0.75)). +-define(fg_kc, (1000.0)). +-define(fg_stretch, (0.005)). +-define(fg_grav, (9.82)). + +%% Ke = 8.854187817e9 [N x M^2 x C^(-2)] +-define(fg_wind, (0.15)). + +-record(fg_e, + { + l = 10.0, + k = 10.0 + }). + +-record(fg_v, + { + p = {0.0,0.0}, + v = {0.0,0.0}, + q = 5.0, + m = 1.0, + type = dynamic, + color = default, + resides = undefined, + selected = false + }). diff --git a/lib/reltool/src/reltool_fgraph_win.erl b/lib/reltool/src/reltool_fgraph_win.erl new file mode 100644 index 0000000000..b063fb94ba --- /dev/null +++ b/lib/reltool/src/reltool_fgraph_win.erl @@ -0,0 +1,726 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 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(reltool_fgraph_win). + +-export([ + new/2, + add_node/2, + add_node/3, + del_node/2, + change_node/3, + add_link/2, + del_link/2, + set_dbl_click/2, + stop/2 + ]). + +-include_lib("wx/include/wx.hrl"). +-include("reltool_fgraph.hrl"). + +-record(state, + { + parent_pid, + frame, + window, + width, + height, + q_slider, + l_slider, + k_slider, + mouse_act, + is_frozen, + ticker + }). + +-record(graph, + { + pen, + brush, + font, + select = none, + offset = {0,0}, + offset_state = false, + ke = 0, + vs = [], + es = [] + }). + +-define(BRD,10). +-define(ARC_R, 10). + +-define(reset, 80). +-define(lock, 81). +-define(unlock, 82). +-define(move, 83). +-define(select, 84). +-define(delete, 85). +-define(freeze, 86). + +-define(q_slider, 90). +-define(l_slider, 91). +-define(k_slider, 92). + +-define(default_q, 20). +-define(default_l, 20). +-define(default_k, 20). + +-define(color_bg, {45,50,95}). +-define(color_fg, {235,245,230}). +-define(color_default, {10,220,20}). +-define(color_default_bg, {20,230,30}). +-define(color_alternate, {220,10,20}). +-define(color_alternate_bg, {230,20,30}). + +add_node(Pid, Key) -> add_node(Pid, Key, default). +add_node(Pid, Key, Color) -> Pid ! {add_node, Key, Color}. +del_node(Pid, Key) -> Pid ! {del_node, Key}. +change_node(Pid, Key, Color) -> Pid ! {change_node, Key, Color}. + +add_link(Pid, {FromKey, ToKey}) -> Pid ! {add_link, {FromKey, ToKey}}. +del_link(Pid, {FromKey, ToKey}) -> Pid ! {del_link, {FromKey, ToKey}}. + +stop(Pid, Reason) -> + Ref = erlang:monitor(process, Pid), + Pid ! {stop, Reason}, + receive + {'DOWN', Ref, _, _, _} -> + ok + end. + +set_dbl_click(Pid, Fun) -> Pid ! {set_dbl_click, Fun}. + +new(Parent, Options) -> + Env = wx:get_env(), + Me = self(), + Pid = spawn_link(fun() -> init([Parent, Me, Env, Options]) end), + receive {Pid, {?MODULE, Panel}} -> {Pid,Panel} end. + +init([ParentWin, Pid, Env, Options]) -> + wx:set_env(Env), + + BReset = wxButton:new(ParentWin, ?reset, [{label,"Reset"}]), + BFreeze = wxButton:new(ParentWin, ?freeze, [{label,"Freeze"}]), + BLock = wxButton:new(ParentWin, ?lock, [{label,"Lock"}]), + BUnlock = wxButton:new(ParentWin, ?unlock, [{label,"Unlock"}]), + BDelete = wxButton:new(ParentWin, ?delete, [{label,"Delete"}]), + + SQ = wxSlider:new(ParentWin, ?q_slider, ?default_q, 1, 500, [{style, ?wxVERTICAL}]), + SL = wxSlider:new(ParentWin, ?l_slider, ?default_l, 1, 500, [{style, ?wxVERTICAL}]), + SK = wxSlider:new(ParentWin, ?k_slider, ?default_k, 1, 500, [{style, ?wxVERTICAL}]), + Win = wxWindow:new(ParentWin, ?wxID_ANY, Options), + + ButtonSizer = wxBoxSizer:new(?wxVERTICAL), + wxSizer:add(ButtonSizer, BReset), + wxSizer:add(ButtonSizer, BFreeze), + wxSizer:add(ButtonSizer, BLock), + wxSizer:add(ButtonSizer, BUnlock), + wxSizer:add(ButtonSizer, BDelete), + + SliderSizer = wxBoxSizer:new(?wxHORIZONTAL), + wxSizer:add(SliderSizer, SQ, [{flag, ?wxEXPAND}, {proportion, 1}]), + wxSizer:add(SliderSizer, SL, [{flag, ?wxEXPAND}, {proportion, 1}]), + wxSizer:add(SliderSizer, SK, [{flag, ?wxEXPAND}, {proportion, 1}]), + wxSizer:add(ButtonSizer, SliderSizer, [{flag, ?wxEXPAND}, {proportion, 1}]), + + WindowSizer = wxBoxSizer:new(?wxHORIZONTAL), + wxSizer:add(WindowSizer, ButtonSizer, [{flag, ?wxEXPAND}, {proportion, 0}]), + wxSizer:add(WindowSizer, Win, [{flag, ?wxEXPAND}, {proportion, 1}]), + + wxButton:setToolTip(BReset, "Remove selection and unlock all nodes."), + wxButton:setToolTip(BFreeze, "Start/stop redraw of screen."), + wxButton:setToolTip(BLock, "Lock all selected nodes."), + wxButton:setToolTip(BUnlock, "Unlock all selected nodes."), + wxButton:setToolTip(BDelete, "Delete all selected nodes."), + + wxButton:setToolTip(SQ, "Control repulsive force. This can also be controlled with the mouse wheel on the canvas."), + wxButton:setToolTip(SL, "Control link length."), + wxButton:setToolTip(SK, "Control attractive force. Use with care."), + wxButton:setToolTip(Win, + "Drag mouse while left mouse button is pressed to perform various operations. " + "Combine with control key to select. Combine with shift key to lock single node."), + + wxButton:connect(BReset, command_button_clicked), + wxButton:connect(BFreeze, command_button_clicked), + wxButton:connect(BLock, command_button_clicked), + wxButton:connect(BUnlock, command_button_clicked), + wxButton:connect(BDelete, command_button_clicked), + + wxWindow:connect(SQ, command_slider_updated), + wxWindow:connect(SL, command_slider_updated), + wxWindow:connect(SK, command_slider_updated), + + wxWindow:connect(Win, enter_window), + wxWindow:connect(Win, move), + wxWindow:connect(Win, motion), + wxWindow:connect(Win, mousewheel), + wxWindow:connect(Win, key_up), + wxWindow:connect(Win, left_down), + wxWindow:connect(Win, left_up), + wxWindow:connect(Win, right_down), + wxWindow:connect(Win, paint, [{skip, true}]), + + Pen = wxPen:new({0,0,0}, [{width, 3}]), + Font = wxFont:new(12, ?wxSWISS, ?wxNORMAL, ?wxNORMAL,[]), + Brush = wxBrush:new({0,0,0}), + + Pid ! {self(), {?MODULE, WindowSizer}}, + + wxWindow:setFocus(Win), %% Get keyboard focus + + Vs = reltool_fgraph:new(), + Es = reltool_fgraph:new(), + + Me = self(), + Ticker = spawn_link(fun() -> ticker_init(Me) end), + + loop( #state{ parent_pid = Pid, + q_slider = SQ, + l_slider = SL, + k_slider = SK, + mouse_act = ?move, + frame = ParentWin, + window = Win, + is_frozen = false, + ticker = Ticker}, + #graph{ vs = Vs, + es = Es, + pen = Pen, + font = Font, + brush = Brush}). + +graph_add_node_unsure(Key, State, G = #graph{ vs = Vs }) -> + case reltool_fgraph:is_defined(Key, Vs) of + true -> G; + false -> graph_add_node(Key, State, G) + end. + +graph_add_node(Key, Color, G = #graph{ vs = Vs}) -> + Q = 20.0, % repulsive force + M = 0.5, % mass + P = {float(450 + random:uniform(100)), + float(450 + random:uniform(100))}, + G#graph{ vs = reltool_fgraph:add(Key, #fg_v{ p = P, m = M, q = Q, color = Color}, Vs)}. + +graph_change_node(Key, Color, G) -> + case reltool_fgraph:get(Key, G#graph.vs) of + undefined -> + G; + V -> + G#graph{ vs = reltool_fgraph:set(Key, V#fg_v{ color = Color }, G#graph.vs)} + end. + +graph_del_node(Key, G = #graph{ vs = Vs0, es = Es0}) -> + Vs = reltool_fgraph:del(Key, Vs0), + Es = delete_edges(Es0, [Key]), + G#graph{ vs = Vs, es = Es }. + +graph_add_link(Key0, Key1, G = #graph{ es = Es}) -> + K = 60.0, % attractive force + L = 5.0, % spring length + G#graph{ es = reltool_fgraph:add({Key0, Key1}, #fg_e{ k = K, l = L}, Es) }. + +graph_del_link(Key0, Key1, G = #graph{ es = Es}) -> + G#graph{ es = reltool_fgraph:del({Key0, Key1}, Es) }. + +ticker_init(Pid) -> + ticker_loop(Pid, 50). +ticker_loop(Pid, Time) -> + receive after Time -> + Pid ! {self(), redraw}, + T0 = now(), + receive {Pid, ok} -> ok end, + T1 = now(), + D = timer:now_diff(T1, T0)/1000, + case round(40 - D) of + Ms when Ms < 0 -> + %io:format("ticker: wait is 0 ms [fg ~7s ms] [fps ~7s]~n", [s(D), s(1000/D)]), + ticker_loop(Pid, 0); + Ms -> + %io:format("ticker: wait is ~3s ms [fg ~7s ms] [fps ~7s]~n", [s(Ms), s(D), s(1000/40)]), + ticker_loop(Pid, Ms) + end + end. + +delete_edges(Es, []) -> + Es; +delete_edges(Es, [Key|Keys]) -> + Edges = reltool_fgraph:foldl(fun + ({{K1, K2}, _}, Out) when K1 =:= Key -> [{K1,K2}|Out]; + ({{K1, K2}, _}, Out) when K2 =:= Key -> [{K1,K2}|Out]; + (_, Out) -> Out + end, [], Es), + Es1 = lists:foldl(fun + (K, Esi) -> reltool_fgraph:del(K, Esi) + end, Es, Edges), + delete_edges(Es1, Keys). + + +set_charge(Q, Vs) -> % Repulsive force + F = fun({Key, Value}) -> {Key, Value#fg_v{ q = Q}} end, + reltool_fgraph:map(F, Vs). + +set_length(L, Es) -> % Spring length + F = fun({Ps, E}) -> {Ps, E#fg_e{ l = L}} end, + reltool_fgraph:map(F, Es). + +set_spring(K, Es) -> % Attractive force + F = fun({Ps, E}) -> {Ps, E#fg_e{ k = K}} end, + reltool_fgraph:map(F, Es). + +loop(S, G) -> + receive + #wx{id = ?reset, event = #wxCommand{type=command_button_clicked}} -> + %% Remove selection and unlock all nodes + Q = ?default_q, + L = ?default_l, + K = ?default_k, + wxSlider:setValue(S#state.q_slider, Q), + wxSlider:setValue(S#state.l_slider, L), + wxSlider:setValue(S#state.k_slider, K), + Es = set_length(L, G#graph.es), + Es2 = set_spring(K, Es), + + Vs2 = reltool_fgraph:map(fun({Key, V}) -> + {Key, V#fg_v{selected = false, type = dynamic, q = Q}} + end, + G#graph.vs), + + {Xs, Ys} = reltool_fgraph:foldl(fun({_Key, #fg_v{p = {X, Y}}}, {Xs, Ys}) -> + {[X| Xs], [Y | Ys]} + end, + {[], []}, + Vs2), + %% io:format("Before: ~p\n", [G#graph.offset]), + Offset = + case length(Xs) of + 0 -> + {0, 0}; + N -> + MeanX = (lists:sum(Xs) / N), + MeanY = (lists:sum(Ys) / N), + {SizeX, SizeY} = wxWindow:getSize(S#state.window), + %% io:format("Min: ~p\n", [{lists:min(Xs), lists:min(Ys)}]), + %% io:format("Mean: ~p\n", [{MeanX, MeanY}]), + %% io:format("Max: ~p\n", [{lists:max(Xs), lists:max(Ys)}]), + %% io:format("Size: ~p\n", [{SizeX, SizeY}]), + %% {XM - (XS / 2), YM - (YS / 2)} + %% {0 - lists:min(Xs) + 20, 0 - lists:min(Ys) + 20} + {0 - MeanX + (SizeX / 2), 0 - MeanY + (SizeY / 2)} + end, + %% io:format("After: ~p\n", [Offset]), + loop(S, G#graph{vs = Vs2, es = Es2, offset = Offset, offset_state = false}); + #wx{id = ?freeze, event = #wxCommand{type=command_button_clicked}} -> + %% Start/stop redraw of screen + IsFrozen = + case S#state.is_frozen of + true -> + S#state.ticker ! {self(), ok}, + false; + false -> + true + end, + loop(S#state{is_frozen = IsFrozen}, G); + #wx{id = ?lock, event = #wxCommand{type=command_button_clicked}} -> + %% Lock all selected nodes + Vs = reltool_fgraph:map(fun + ({Key, V = #fg_v{selected = true}}) -> + {Key, V#fg_v{ type = static }}; + (KV) -> KV + end, G#graph.vs), + loop(S, G#graph{ vs = Vs }); + #wx{id = ?unlock, event = #wxCommand{type=command_button_clicked}} -> + %% Unlock all selected nodes + Vs = reltool_fgraph:map(fun + ({Key, V = #fg_v{selected = true}}) -> + {Key, V#fg_v{ type = dynamic }}; + (KV) -> KV + end, G#graph.vs), + loop(S, G#graph{ vs = Vs }); + #wx{id = ?delete, event = #wxCommand{type=command_button_clicked}} -> + %% Delete all selected nodes + {Vs1, Keys} = reltool_fgraph:foldl(fun + ({Key, #fg_v{ selected = true}}, {Vs, Ks}) -> + {reltool_fgraph:del(Key,Vs), [Key|Ks]}; + (_, {Vs, Ks}) -> {Vs, Ks} + end, {G#graph.vs,[]}, G#graph.vs), + Es = delete_edges(G#graph.es, Keys), + loop(S, G#graph{ vs = Vs1, es = Es}); + + #wx{id = ?select, event = #wxCommand{type=command_button_clicked}} -> + loop(S#state{ mouse_act = ?select }, G); + + #wx{id = ?move, event = #wxCommand{type=command_button_clicked}} -> + loop(S#state{ mouse_act = ?move }, G); + + #wx{id = ?q_slider, event = #wxCommand{type=command_slider_updated, commandInt = Q}} -> + loop(S, G#graph{ vs = set_charge(Q, G#graph.vs)}); + #wx{id = ?l_slider, event = #wxCommand{type=command_slider_updated, commandInt = L}} -> + loop(S, G#graph{ es = set_length(L, G#graph.es)}); + #wx{id = ?k_slider, event = #wxCommand{type=command_slider_updated, commandInt = K}} -> + loop(S, G#graph{ es = set_spring(K, G#graph.es)}); + #wx{event=#wxKey{type=key_up, keyCode = 127}} -> % delete + {Vs1, Keys} = + reltool_fgraph:foldl(fun({Key, #fg_v{ selected = true}}, {Vs, Ks}) -> + {reltool_fgraph:del(Key,Vs), [Key|Ks]}; + (_, {Vs, Ks}) -> + {Vs, Ks} + end, + {G#graph.vs,[]}, G#graph.vs), + Es = delete_edges(G#graph.es, Keys), + loop(S, G#graph{ vs = Vs1, es = Es}); + #wx{event=#wxKey{type=key_up}} -> + loop(S, G); + #wx{event=#wxKey{type=key_down}} -> + loop(S, G); + + %% mouse + #wx{event=#wxMouse{type=left_down, shiftDown=Shift, controlDown=Ctrl, x=X, y=Y}} -> + if + Shift -> + loop(S, mouse_left_down_move(G, {X,Y})); + Ctrl -> + loop(S, mouse_left_down_select(G, {X,Y})); + S#state.mouse_act =:= ?move -> + loop(S, mouse_left_down_move(G, {X,Y})); + S#state.mouse_act =:= ?select -> + loop(S, mouse_left_down_select(G, {X,Y})) + end; + #wx{event=#wxMouse{type=motion, shiftDown=Shift, controlDown=Ctrl, x=X, y=Y}} -> + if + Shift -> + loop(S, mouse_motion_move(G, {X,Y})); + Ctrl -> + loop(S, mouse_motion_select(G, {X,Y})); + S#state.mouse_act =:= ?move -> + loop(S, mouse_motion_move(G, {X,Y})); + S#state.mouse_act =:= ?select -> + loop(S, mouse_motion_select(G, {X,Y})) + end; + #wx{event=#wxMouse{type=left_up, shiftDown=Shift, controlDown=Ctrl, x=X, y=Y}} -> + if + Shift -> + loop(S, mouse_left_up_move(G, {X,Y}, Shift)); + Ctrl -> + loop(S, mouse_left_up_select(G, {X,Y})); + S#state.mouse_act =:= ?move -> + loop(S, mouse_left_up_move(G, {X,Y}, Shift)); + S#state.mouse_act =:= ?select -> + loop(S, mouse_left_up_select(G, {X,Y})) + end; + + #wx{event=#wxMouse{type=right_down,x=_X,y=_Y}} -> + loop(S, G); + %% mouse wheel + #wx{event=#wxMouse{type=mousewheel, wheelRotation=Rotation}} -> + Q = wxSlider:getValue(S#state.q_slider), + if + Rotation > 0, Q > 5 -> + wxSlider:setValue(S#state.q_slider, Q - 4), + loop(S, G#graph{ vs = set_charge(Q - 4, G#graph.vs) }); + Rotation < 0 -> + wxSlider:setValue(S#state.q_slider, Q + 4), + loop(S, G#graph{ vs = set_charge(Q + 4, G#graph.vs) }); + true -> + loop(S, G) + end; + + %% #wx{event=#wxClose{}} -> + %% catch wxWindow:'Destroy'(S#state.frame); + %% #wx{id=?wxID_EXIT, event=#wxCommand{type=command_menu_selected}} -> + %% wxWindow:close(S#state.frame,[]); + #wx{obj=_Win,event=#wxPaint{}} -> + redraw(S, G), + loop(S, G); + #wx{obj=Win,event=#wxMouse{type=enter_window}} -> + wxWindow:setFocus(Win), + loop(S, G); + + %% Graph manipulation + {add_node, Key, State} -> + loop(S, graph_add_node_unsure(Key, State, G)); + {del_node, Key} -> + loop(S, graph_del_node(Key, G)); + {change_node, Key, Color} -> + loop(S, graph_change_node(Key, Color, G)); + {add_link, {K0,K1}} -> + loop(S, graph_add_link(K0, K1, G)); + {del_link, {K0,K1}} -> + loop(S, graph_del_link(K0, K1, G)); + + {Req, redraw} -> + {SizeX, SizeY} = wxWindow:getSize(S#state.window), + Vs = reltool_fgraph:step(G#graph.vs, G#graph.es, {SizeX/2.0 - 20.0, SizeY/2.0}), + case S#state.is_frozen of + false -> + Req ! {self(), ok}; + true -> + ignore + end, + redraw(S, G), + loop(S, G#graph{ vs = Vs} ); + + {stop, Reason} -> + unlink(S#state.parent_pid), + exit(Reason); + + Other -> + error_logger:format("~p~p got unexpected message:\n\t~p\n", + [?MODULE, self(), Other]), + loop(S, G) + end. + +mouse_left_down_select(G, {X0,Y0}) -> + G#graph{ select = {{X0,Y0}, {X0,Y0}} }. + +mouse_left_down_move(#graph{vs = Vs} = G, {X, Y}) -> + % point on node? + case coord_to_key(G, {X, Y}) of + false -> + G#graph{ offset_state = {X,Y}}; + {true, Key} -> + V = #fg_v{ type = Type} = reltool_fgraph:get(Key, Vs), + G#graph{ vs = reltool_fgraph:set(Key, V#fg_v{ type = moving}, Vs), select = {node, Key, Type, X, Y} } + end. + +coord_to_key(#graph{vs = Vs, offset = {Xo, Yo}}, {X, Y}) -> + Xr = X - Xo, + Yr = Y - Yo, + reltool_fgraph:foldl(fun({Key, #fg_v{ p = {Px, Py}}}, _) when abs(Px - Xr) < 10, + abs(Py - Yr) < 10 -> {true, Key}; + (_, Out) -> Out + end, false, Vs). + +mouse_left_up_select(G, {_X,_Y}) -> + case G#graph.select of + {{X0,Y0}, {X1, Y1}} -> + {Xo, Yo} = G#graph.offset, + Xmin = lists:min([X0,X1]) - Xo, + Xmax = lists:max([X1,X0]) - Xo, + Ymin = lists:min([Y0,Y1]) - Yo, + Ymax = lists:max([Y1,Y0]) - Yo, + Vs = reltool_fgraph:map(fun + ({Key, Value = #fg_v{ p = {Px, Py}}}) + when Px > Xmin, Px < Xmax, Py > Ymin, Py < Ymax -> + {Key, Value#fg_v{ selected = true }}; + ({Key, Value}) -> {Key, Value#fg_v{ selected = false }} + end, G#graph.vs), + G#graph{ select = none, vs = Vs}; + _ -> + G#graph{ select = none} + end. + +mouse_left_up_move(G = #graph{ select = Select, vs = Vs} = G, {X,Y}, Shift) -> + case Select of + {node, Key, _, X, Y} -> + io:format("click: ~p\n", [Key]), + G#graph{ select = none, offset_state = false }; + {node, Key, Type, _, _} -> + V = reltool_fgraph:get(Key, Vs), + Type2 = + case Shift of + true -> static; + false -> Type + end, + G#graph{ select = none, + vs = reltool_fgraph:set(Key, V#fg_v{ type = Type2}, Vs), + offset_state = false }; + _ -> + G#graph{ select = none, offset_state = false } + end. + +mouse_motion_select(G, {X,Y}) -> + case G#graph.select of + {P0, _P1} -> G#graph{ select = {P0, {X,Y}}}; + _ -> G + end. + +mouse_motion_move(G = #graph{ select = {node, Key, _, _, _}, vs = Vs}, {X,Y}) -> + {Xo, Yo} = G#graph.offset, + V = reltool_fgraph:get(Key, Vs), + V2 = V#fg_v{ p = {float(X - Xo), float(Y - Yo)}}, + G#graph{ vs = reltool_fgraph:set(Key, V2, Vs) }; +mouse_motion_move(G, {X,Y}) -> + case G#graph.offset_state of + {X1,Y1} -> + {X0, Y0} = G#graph.offset, + G#graph{ offset_state = {X,Y}, + offset = {X0 - (X1 - X), Y0 - (Y1 - Y)} }; + _ -> + G + end. + +redraw(#state{window=Win}, G) -> + DC0 = wxClientDC:new(Win), + DC = wxBufferedDC:new(DC0), + Size = wxWindow:getSize(Win), + redraw(DC, Size, G), + wxBufferedDC:destroy(DC), + wxClientDC:destroy(DC0), + ok. + +redraw(DC, _Size, G) -> + wx:batch(fun() -> + + Pen = G#graph.pen, + Font = G#graph.font, + Brush = G#graph.brush, + wxDC:setTextForeground(DC,?color_fg), + wxBrush:setColour(Brush, ?color_bg), + wxDC:setBrush(DC, Brush), + wxDC:setBackground(DC, Brush), + wxPen:setWidth(Pen, 1), + wxDC:clear(DC), + + % draw vertices and edges + wxPen:setColour(Pen, ?color_fg), + wxDC:setPen(DC,Pen), + + %draw_es(DC, G#graph.es_pts, G#graph.offset), + draw_es(DC, G#graph.vs, G#graph.es, G#graph.offset, Pen, Brush), + draw_vs(DC, G#graph.vs, G#graph.offset, Pen, Brush), + + % draw selection box + wxPen:setColour(Pen, ?color_fg), + wxDC:setPen(DC,Pen), + draw_select_box(DC, G#graph.select), + + % draw information text + wxFont:setWeight(Font,?wxNORMAL), + draw_text(DC, reltool_fgraph:size(G#graph.vs), reltool_fgraph:size(G#graph.es), G#graph.ke), + ok + end). + +draw_select_box(DC, {{X0,Y0}, {X1,Y1}}) -> + draw_line(DC, {X0,Y0}, {X1,Y0}, {0,0}), + draw_line(DC, {X1,Y1}, {X1,Y0}, {0,0}), + draw_line(DC, {X1,Y1}, {X0,Y1}, {0,0}), + draw_line(DC, {X0,Y0}, {X0,Y1}, {0,0}), + ok; +draw_select_box(_DC, _) -> + ok. + +draw_es(DC, Vs, Es, Po, Pen, Brush) -> + reltool_fgraph:foreach(fun + ({{K1, K2}, _}) -> + #fg_v{ p = P1} = reltool_fgraph:get(K1, Vs), + #fg_v{ p = P2} = reltool_fgraph:get(K2, Vs), + draw_arrow(DC, P1, P2, Po, Pen, Brush) + end, Es). + +draw_arrow(DC, {X0,Y0}, {X1, Y1}, {X, Y}, Pen, Brush) -> + Xdiff = (X0 - X1) / 4, + Ydiff = (Y0 - Y1) / 4, + X2 = X1 + Xdiff + X, + Y2 = Y1 + Ydiff + Y, + wxDC:setPen(DC, Pen), + wxDC:setBrush(DC, Brush), + + draw_line(DC, {X0,Y0}, {X1, Y1}, {X, Y}), + + %% Draw arrow head + Radians = calc_angle({X0, Y0}, {X1, Y1}), + Len = 10, + %% Angle = 30, + %% Degrees = radians_to_degrees(Radians), + %% Radians2 = degrees_to_radians(Degrees + Angle + 180), + %% Radians3 = degrees_to_radians(Degrees - Angle + 180), + Radians2 = Radians + 3.665191429188092, + Radians3 = Radians + 2.617993877991494, + {X3, Y3} = calc_point({X2, Y2}, Len, Radians2), + {X4, Y4} = calc_point({X2, Y2}, Len, Radians3), + Points = [{round(X2), round(Y2)}, + {round(X3), round(Y3)}, + {round(X4), round(Y4)}], + wxDC:drawPolygon(DC, Points, []). + +draw_line(DC, {X0,Y0}, {X1, Y1}, {X, Y}) -> + wxDC:drawLine(DC, {round(X0 + X), round(Y0 + Y)}, {round(X1 + X), round(Y1 + Y)}). + +draw_vs(DC, Vs, {Xo, Yo}, Pen, Brush) -> + reltool_fgraph:foreach(fun({Key, #fg_v{ p ={X, Y}, color = Color, selected = Sel}}) -> + String = s(Key), + case Sel of + true -> + wxPen:setColour(Pen, ?color_fg), + wxBrush:setColour(Brush, ?color_bg), + wxDC:setPen(DC,Pen), + wxDC:setBrush(DC, Brush), + SelProps = {round(X-12 + Xo), round(Y-12 + Yo), 24, 24}, + wxDC:drawRoundedRectangle(DC, SelProps, float(?ARC_R)), + ok; + false -> + ok + end, + case Color of + default -> + wxPen:setColour(Pen, ?color_default), + wxBrush:setColour(Brush, ?color_default_bg); + alternate -> + wxPen:setColour(Pen, ?color_alternate), + wxBrush:setColour(Brush, ?color_alternate_bg); + {FgColor, BgColor} -> + wxPen:setColour(Pen, FgColor), + wxBrush:setColour(Brush, BgColor); + Color -> + wxPen:setColour(Pen, Color), + wxBrush:setColour(Brush, Color) + end, + wxDC:setPen(DC,Pen), + wxDC:setBrush(DC, Brush), + NodeProps = {round(X-8 + Xo),round(Y-8 + Yo),17,17}, + wxDC:drawRoundedRectangle(DC, NodeProps, float(?ARC_R)), + wxDC:drawText(DC, String, {round(X + Xo), round(Y + Yo)}), + ok; + (_) -> + ok + end, + Vs). + +draw_text(DC, Nvs, Nes, _KE) -> + VsString = "#nodes: " ++ integer_to_list(Nvs), + EsString = "#links: " ++ integer_to_list(Nes), + %% KEString = " ke: " ++ s(KE), + wxDC:drawText(DC, VsString, {10,10}), + wxDC:drawText(DC, EsString, {10,25}), + %% wxDC:drawText(DC, KEString, {10,40}), + ok. + +s(Format, Terms) -> lists:flatten(io_lib:format(Format, Terms)). +s(Term) when is_float(Term) -> s("~.2f", [Term]); +s(Term) when is_integer(Term) -> integer_to_list(Term); +s(Term) when is_atom(Term) -> atom_to_list(Term); +s(Term) -> s("~p", [Term]). + +%% Calclulate angle in radians for a line between two points +calc_angle({X1, Y1}, {X2, Y2}) -> + math:atan2((Y2 - Y1), (X2 - X1)). + +%% Calc new point at a given distance and angle from another point +calc_point({X, Y}, Length, Radians) -> + X2 = round(X + Length * math:cos(Radians)), + Y2 = round(Y + Length * math:sin(Radians)), + {X2, Y2}. + +%% %% Convert from an angle in radians to degrees +%% radians_to_degrees(Radians) -> +%% Radians * 180 / math:pi(). +%% +%% %% Convert from an angle in degrees to radians +%% degrees_to_radians(Degrees) -> +%% Degrees * math:pi() / 180. diff --git a/lib/reltool/src/reltool_mod_win.erl b/lib/reltool/src/reltool_mod_win.erl new file mode 100644 index 0000000000..c05f73cde8 --- /dev/null +++ b/lib/reltool/src/reltool_mod_win.erl @@ -0,0 +1,773 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 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(reltool_mod_win). + +%% Public +-export([start_link/5, raise/1, refresh/1]). + +%% Internal +-export([init/6, loop/1]). + +%% sys callback functions +-export([ + system_continue/3, + system_terminate/4, + system_code_change/4 + ]). + +-include_lib("wx/include/wx.hrl"). +-include("reltool.hrl"). + +-record(state, + {parent_pid, + xref_pid, + rel_pid, + mod_wins, + sys, + common, + mod, + name, + frame, + panel, + book, + status_bar, + deps_used_by_ctrl, + deps_uses_ctrl, + popup_menu, + active_page, + code_pages}). + +-record(code_page, + {name, + editor, + find_objs, + find_data}). + +-record(find_objs, + {search, % Search input ctrl + goto, % Goto input ctrl + radio}). % Radio buttons + +-record(find_data, + {start, % start pos + found, % status + history}). % list of recent positions + +-define(WIN_WIDTH, 800). +-define(WIN_HEIGHT, 600). + +-define(CLOSE_ITEM, ?wxID_EXIT). %% Use OS specific version if available +-define(ABOUT_ITEM, ?wxID_ABOUT). %% Use OS specific +-define(CONTENTS_ITEM, 300). +-define(SEARCH_ENTRY, 413). +-define(GOTO_ENTRY, 414). + +-define(MODS_MOD_COL, 0). +-define(MODS_APP_COL, 1). + +-define(INITIAL_CODE_PAGE_NAME, "Code"). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% Client + +start_link(WxEnv, Xref, RelPid, Common, ModName) -> + proc_lib:start_link(?MODULE, init, [self(), WxEnv, Xref, RelPid, Common, ModName], infinity, []). + +raise(Pid) -> + reltool_utils:cast(Pid, raise). + +refresh(Pid) -> + reltool_utils:cast(Pid, refresh). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% Server + +init(Parent, WxEnv, Xref, RelPid, C, ModName) -> + try + do_init(Parent, WxEnv, Xref, RelPid, C, ModName) + catch + error:Reason -> + exit({Reason, erlang:get_stacktrace()}) + end. + +do_init(Parent, WxEnv, Xref, RelPid, C, ModName) -> + process_flag(trap_exit, C#common.trap_exit), + {ok, Mod} = reltool_server:get_mod(Xref, ModName), + {ok, Sys} = reltool_server:get_sys(Xref), + S = #state{parent_pid = Parent, + xref_pid = Xref, + rel_pid = RelPid, + sys = Sys, + mod = Mod, + name = atom_to_list(Mod#mod.name), + common = C}, + proc_lib:init_ack(Parent, {ok, self()}), + wx:set_env(WxEnv), + wx:debug(C#common.wx_debug), + S2 = wx:batch(fun() -> create_window(S) end), + loop(S2). + +loop(#state{xref_pid = Xref, common = C, mod = Mod} = S) -> + receive + Msg -> + %% io:format("~s~p -> ~p\n", [S#state.name, self(), Msg]), + case Msg of + {system, From, SysMsg} -> + Dbg = C#common.sys_debug, + sys:handle_system_msg(SysMsg, From, S#state.parent_pid, ?MODULE, Dbg, S); + {cast, _From, raise} -> + wxFrame:raise(S#state.frame), + wxFrame:setFocus(S#state.frame), + ?MODULE:loop(S); + {cast, _From, refresh} -> + %% wx_misc:beginBusyCursor(), + case reltool_server:get_mod(Xref, Mod#mod.name) of + {ok, Mod2} -> + {ok, Sys} = reltool_server:get_sys(Xref), + S2 = redraw_window(S#state{sys = Sys, mod = Mod2}), + %% wx_misc:endBusyCursor(), + ?MODULE:loop(S2); + {error, _} -> + wxFrame:destroy(S#state.frame), + exit(shutdown) + end; + {'EXIT', Pid, Reason} when Pid =:= S#state.parent_pid -> + exit(Reason); + #wx{event = #wxSize{}} = Wx -> + Wx2 = reltool_utils:get_latest_resize(Wx), + S2 = handle_event(S, Wx2), + ?MODULE:loop(S2); + #wx{obj = ObjRef, + event = #wxClose{type = close_window}} -> + wxFrame:destroy(ObjRef), + exit(shutdown); + #wx{} = Wx -> + S2 = handle_event(S, Wx), + ?MODULE:loop(S2); + _ -> + error_logger:format("~p~p got unexpected message:\n\t~p\n", + [?MODULE, self(), Msg]), + ?MODULE:loop(S) + end + end. + +create_window(#state{mod = Mod, name = ModStr} = S) -> + Title = atom_to_list(?APPLICATION) ++ " - " ++ + atom_to_list(Mod#mod.app_name) ++ " - " ++ + ModStr ++ ".erl", + Frame = wxFrame:new(wx:null(), ?wxID_ANY, Title, []), + %% wxFrame:setSize(Frame, {?WIN_WIDTH, ?WIN_HEIGHT}), + Panel = wxPanel:new(Frame, []), + StatusBar = wxFrame:createStatusBar(Frame,[]), + + Book = wxNotebook:new(Panel, ?wxID_ANY, []), + + S2 = S#state{frame = Frame, + panel = Panel, + book = Book, + status_bar = StatusBar, + code_pages = []}, + S3 = create_deps_page(S2), + S4 = create_code_page(S3, ?INITIAL_CODE_PAGE_NAME), + S5 = create_config_page(S4), + wxNotebook:setSelection(Book, 0), + Sizer = wxBoxSizer:new(?wxVERTICAL), + wxSizer:add(Sizer, Book, [{flag, ?wxEXPAND}, {proportion, 1}]), + + wxPanel:setSizer(Panel, Sizer), + wxSizer:fit(Sizer, Frame), + wxSizer:setSizeHints(Sizer, Frame), + + wxEvtHandler:connect(Book, command_notebook_page_changed, [{skip, true}]), + wxFrame:connect(Frame, close_window), + wxFrame:show(Frame), + + S5. + +create_deps_page(S) -> + Panel = wxPanel:new(S#state.book, []), + Main = wxBoxSizer:new(?wxHORIZONTAL), + + UsedByCtrl = create_mods_list_ctrl(Panel, Main, "Modules used by others", " and their applications"), + wxSizer:add(Main, + wxStaticLine:new(Panel, [{style, ?wxLI_VERTICAL}]), + [{border, 2}, {flag, ?wxALL bor ?wxEXPAND}]), + UsesCtrl = create_mods_list_ctrl(Panel, Main, "Used modules", " and their applications"), + S2 = S#state{deps_used_by_ctrl = UsedByCtrl, + deps_uses_ctrl = UsesCtrl}, + redraw_mods(S2), + wxPanel:setSizer(Panel, Main), + wxNotebook:addPage(S2#state.book, Panel, "Dependencies", []), + S2. + +create_mods_list_ctrl(Panel, Sizer, ModText, AppText) -> + Width = lists:max([100, ?WIN_WIDTH - 40]) div 2, + Height = lists:max([100, ?WIN_HEIGHT - 100]), + ListCtrl = wxListCtrl:new(Panel, + [{style, + ?wxLC_REPORT bor + %% ?wxLC_SORT_ASCENDING bor + ?wxLC_SINGLE_SEL bor + ?wxHSCROLL bor + ?wxVSCROLL}, + {size, {Width, Height}}]), + %% Prep images + reltool_utils:assign_image_list(ListCtrl), + + %% Prep column label + ListItem = wxListItem:new(), + wxListItem:setAlign(ListItem, ?wxLIST_FORMAT_LEFT), + wxListItem:setText(ListItem, ModText), + wxListCtrl:insertColumn(ListCtrl, ?MODS_MOD_COL, ListItem), + %% wxListCtrl:setColumnWidth(ListCtrl, ?MODS_MOD_COL, ?MODS_MOD_COL_WIDTH), + + wxListItem:setText(ListItem, AppText), + wxListCtrl:insertColumn(ListCtrl, ?MODS_APP_COL, ListItem), + %% wxListCtrl:setColumnWidth(ListCtrl, ?MODS_APP_COL, ?MODS_APP_COL_WIDTH), + wxListItem:destroy(ListItem), + + wxEvtHandler:connect(ListCtrl, size, [{skip, true}, {userData, mods_list_ctrl}]), + wxListCtrl:connect(ListCtrl, command_list_item_activated, [{userData, open_app}]), + wxWindow:connect(ListCtrl, enter_window), + + wxSizer:add(Sizer, ListCtrl, + [{border, 2}, + {flag, ?wxALL bor ?wxEXPAND}, + {proportion, 1}]), + ListCtrl. + +create_code_page(#state{book = Book, code_pages = Pages, name = ModStr} = S, PageName) -> + case find_page(S, PageName) of + not_found -> + Page = do_create_code_page(S, PageName), + Pages2 = Pages ++ [Page], + Pos = length(Pages2), + wxNotebook:setSelection(Book, Pos), + case find_page(S, ?INITIAL_CODE_PAGE_NAME) of + not_found -> + ignore; + {found, _, CodePos} -> + %% Rename initial code page + wxNotebook:setPageText(Book, CodePos, ModStr) + end, + S#state{active_page = Page, code_pages = Pages2}; + {found, Page, Pos} -> + wxNotebook:setSelection(Book, Pos), + S#state{active_page = Page} + end. + +find_page(S, PageName) -> + find_page(S#state.code_pages, PageName, 1). + +find_page([Page | Pages], PageName, Pos) -> + case Page#code_page.name =:= PageName of + true -> + {found, Page, Pos}; + false -> + find_page(Pages, PageName, Pos + 1) + end; +find_page([], _PageName, _Pos) -> + not_found. + +do_create_code_page(#state{xref_pid = Xref, mod = M} = S, PageName) -> + Panel = wxPanel:new(S#state.book, []), + Editor = create_editor(Panel), + ToolTip = "Double click on a function call to search the function definition.", + wxBitmapButton:setToolTip(Editor, ToolTip), + {Objs, Data, SearchSz} = create_search_area(Panel), + + {ok, App} = reltool_server:get_app(Xref, M#mod.app_name), + ErlBin = + case App#app.is_escript of + true -> find_escript_bin(App, M); + false -> find_regular_bin(App, M) + end, + + load_code(Editor, ErlBin), + + Sizer = wxBoxSizer:new(?wxVERTICAL), + wxSizer:add(Sizer, Editor, [{flag, ?wxEXPAND}, {proportion, 1}]), + wxSizer:add(Sizer, SearchSz, [{flag, ?wxEXPAND}]), + wxPanel:setSizer(Panel, Sizer), + wxNotebook:addPage(S#state.book, Panel, PageName, []), + #code_page{name = PageName, editor = Editor, find_objs = Objs, find_data = Data}. + +find_regular_bin(App, Mod) -> + ActiveDir = App#app.active_dir, + SrcDir = filename:join([ActiveDir, "src"]), + ModStr = atom_to_list(Mod#mod.name), + Base = ModStr ++ ".erl", + Find = fun(F, _Acc) -> file:read_file(F) end, + case filelib:fold_files(SrcDir, Base, true, Find, {error, enoent}) of + {ok, Bin} -> + Bin; + {error, enoent} -> + %% Reconstructing the source code from debug info if possible + BeamFile = filename:join([ActiveDir, "ebin", ModStr ++ ".beam"]), + case beam_lib:chunks(BeamFile, [abstract_code]) of + {ok,{_,[{abstract_code,{_,AC}}]}} -> + list_to_binary(erl_prettypr:format(erl_syntax:form_list(AC))); + _ -> + list_to_binary(["%% Bad luck, cannot find any debug info in the file \"", BeamFile]) + end + end. + +find_escript_bin(#app{active_dir = ActiveDir}, Mod) -> + NotFound = false, + ModName = Mod#mod.name, + {Fun, Escript} = + case filelib:is_regular(ActiveDir) of + true -> + %% File is on top level in the escript + {fun(FullName, _GetInfo, GetBin, Acc) -> + case filename:split(FullName) of + [_] -> + Bin = GetBin(), + case beam_lib:version(Bin) of + {ok,{M, _}} when M =:= ModName; FullName =:= "." -> + case beam_lib:chunks(Bin, [abstract_code]) of + {ok,{_,[{abstract_code,{_,AC}}]}} -> + {obj, list_to_binary(erl_prettypr:format(erl_syntax:form_list(AC)))}; + _ -> + Acc + end; + _ -> + Acc + end; + _ -> + Acc + end + end, + ActiveDir}; + false -> + %% File is in an archive + Ext = code:objfile_extension(), + SrcFile = lists:concat([ModName, ".erl"]), + ObjFile = lists:concat([ModName, Ext]), + {fun(FullName, _GetInfo, GetBin, Acc) -> + io:format("", []), + case filename:split(FullName) of + [_AppName, "ebin", F] when F =:= ObjFile, Acc =:= NotFound -> + case beam_lib:chunks(GetBin(), [abstract_code]) of + {ok,{_,[{abstract_code,{_,AC}}]}} -> + {obj, list_to_binary(erl_prettypr:format(erl_syntax:form_list(AC)))}; + _ -> + Acc + end; + [_AppName, "src", F] when F =:= SrcFile -> + {text, GetBin()}; + _ -> + Acc + end + end, + filename:dirname(ActiveDir)} + end, + try + case escript:foldl(Fun, NotFound, Escript) of + {ok, {text, Bin}} -> + Bin; + {ok, {obj, Bin}} -> + Bin; + _ -> + list_to_binary(["%% Bad luck, cannot find the code in the escript ", Escript, "."]) + end + catch + throw:Reason when is_list(Reason) -> + list_to_binary(["%% Bad luck, cannot find the code in the escript ", Escript, ": ", Reason]) + end. + +create_config_page(S) -> + S. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +handle_event(#state{xref_pid = Xref} = S, Wx) -> + %% io:format("wx: ~p\n", [Wx]), + case Wx of + #wx{obj= ListCtrl, userData = mods_list_ctrl, event = #wxSize{type = size, size = {W, _H}}} -> + wxListCtrl:setColumnWidth(ListCtrl, ?MODS_MOD_COL, (2 * W) div 3), + wxListCtrl:setColumnWidth(ListCtrl, ?MODS_APP_COL, W div 3), + S; + #wx{userData = open_app, + obj = ListCtrl, + event = #wxList{type = command_list_item_activated, itemIndex = Pos}} -> + ModStr = wxListCtrl:getItemText(ListCtrl, Pos), + ModName = list_to_atom(ModStr), + {ok, Mod} = reltool_server:get_mod(Xref, ModName), + S2 = create_code_page(S#state{mod = Mod}, ModStr), + find_regexp_forward(S2, S2#state.name ++ ":"); + %% ok = reltool_sys_win:open_app(S#state.rel_pid, Mod#mod.app_name), + %% S; + #wx{obj = Editor, + event = #wxStyledText{type = stc_doubleclick}} -> + goto_function(S, Editor); + #wx{id = ?SEARCH_ENTRY, + event = #wxCommand{type = command_text_enter, cmdString = Str}} -> + find_string(S, Str); + #wx{id = ?GOTO_ENTRY, + event = #wxCommand{type = command_text_enter, cmdString = Str}} -> + goto_line(S, Str); + #wx{event = #wxNotebook{type = command_notebook_page_changed}} -> + case wxNotebook:getSelection(S#state.book) of + 0 -> % Deps page + S; + N -> % Code page + Page = lists:nth(N, S#state.code_pages), + S#state{active_page = Page} + end; + #wx{event = #wxCommand{type = command_button_clicked}, userData = history_back} -> + goto_back(S); + #wx{obj = ObjRef, event = #wxMouse{type = enter_window}} -> + wxWindow:setFocus(ObjRef), + S; + _ -> + error_logger:format("~p~p got unexpected mod event from wx:\n\t~p\n", + [?MODULE, self(), Wx]), + S + end. + +redraw_mods(#state{xref_pid = Xref, + deps_used_by_ctrl = UsedByCtrl, + deps_uses_ctrl = UsesCtrl, + mod = #mod{is_pre_included = IsPre, + is_included = IsIncl, + uses_mods = UsesModNames, + used_by_mods = UsedByModNames}, + status_bar = Bar}) -> + InclStatus = + case IsIncl of + true when IsPre =:= true -> "Whitelist - "; + true -> "Derived - "; + false -> "Blacklist - "; + undefined -> "Source - " + end, + Status = lists:concat([InclStatus, + " uses ", length(UsesModNames), " modules and ", + " is used by ", length(UsedByModNames), " modules."]), + wxStatusBar:setStatusText(Bar, Status), + UsesMods = [select_image(Xref, M) || M <- UsesModNames], + UsedByMods = [select_image(Xref, M) || M <- UsedByModNames], + redraw_mods(UsedByCtrl, UsedByMods), + redraw_mods(UsesCtrl, UsesMods). + +select_image(Xref, ModName) -> + {ok, M} = reltool_server:get_mod(Xref, ModName), + Image = + case M#mod.is_included of + _ when M#mod.app_name =:= ?MISSING_APP -> ?ERR_IMAGE; + true -> ?TICK_IMAGE; + false -> ?WARN_IMAGE; + undefined -> ?ERR_IMAGE + end, + {Image, M#mod.app_name, M}. + +redraw_mods(ListCtrl, []) -> + wxListCtrl:deleteAllItems(ListCtrl); +redraw_mods(ListCtrl, ImageMods) -> + wxListCtrl:deleteAllItems(ListCtrl), + Add = + fun({ImageId, AppName, #mod{name = ModName}}, Row) -> + wxListCtrl:insertItem(ListCtrl, Row, ""), + if (Row rem 2) =:= 0 -> + wxListCtrl:setItemBackgroundColour(ListCtrl, Row, {240,240,255}); + true -> + ignore + end, + wxListCtrl:setItem(ListCtrl, Row, ?MODS_MOD_COL, + atom_to_list(ModName), [{imageId, ImageId}]), + wxListCtrl:setItem(ListCtrl, Row, ?MODS_APP_COL, + atom_to_list(AppName), [{imageId, ImageId}]), + Row + 1 + end, + wx:foldl(Add, 0, lists:sort(ImageMods)). + +redraw_config(S) -> + S. + +redraw_window(S) -> + redraw_config(S), + redraw_mods(S), + S. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +goto_line(#state{active_page = P} = S, LineNo) when is_integer(LineNo) -> + Editor = P#code_page.editor, + wxStyledTextCtrl:gotoLine(Editor, LineNo), + Left = wxStyledTextCtrl:getCurrentPos(Editor), + Right = wxStyledTextCtrl:getLineEndPosition(Editor, LineNo), + wxStyledTextCtrl:setSelection(Editor, Left, Right), + S; +goto_line(#state{active_page = P} =S, Str) when is_list(Str) -> + try + LineNo = list_to_integer(Str), + CurrentPos = wxStyledTextCtrl:getCurrentPos(P#code_page.editor), + S2 = add_pos_to_history(S, CurrentPos), + goto_line(S2, LineNo - 1) + catch + _:_ -> + wxStatusBar:setStatusText(S#state.status_bar, "Not a line number"), + S + end. + +find_string(S, Str) -> + find_string(S, Str, 0). + +find_regexp_forward(S, Str) -> + S2 = find_string(S, Str, ?wxSTC_FIND_REGEXP), + TextCtrl = ((S2#state.active_page)#code_page.find_objs)#find_objs.search, + wxTextCtrl:setValue(TextCtrl, Str), + S2. + +find_string(#state{active_page = #code_page{editor = Editor, + find_objs = #find_objs{radio={NextO,_,CaseO}}, + find_data = #find_data{found = Found} = Data} = P} = S, + Str, + Flag) -> + wxStyledTextCtrl:hideSelection(Editor, true), + Dir = wxRadioButton:getValue(NextO) xor wx_misc:getKeyState(?WXK_SHIFT), + Case = wxCheckBox:getValue(CaseO), + Pos = + if + Found, Dir -> %% Forward Continuation + wxStyledTextCtrl:getAnchor(Editor); + Found -> %% Backward Continuation + wxStyledTextCtrl:getCurrentPos(Editor); + Dir -> %% Forward wrap + 0; + true -> %% Backward wrap + wxStyledTextCtrl:getLength(Editor) + end, + wxStyledTextCtrl:gotoPos(Editor,Pos), + wxStyledTextCtrl:searchAnchor(Editor), + Flag2 = + if Case -> Flag bor ?wxSTC_FIND_MATCHCASE; + true -> Flag + end, + Res = + if + Dir -> wxStyledTextCtrl:searchNext(Editor, Flag2, Str); + true -> wxStyledTextCtrl:searchPrev(Editor, Flag2, Str) + end, + Found2 = + case Res >= 0 of + true -> + wxStyledTextCtrl:hideSelection(Editor, false), + %% io:format("Found ~p ~n",[Res]), + LineNo = wxStyledTextCtrl:lineFromPosition(Editor,Res), + wxStyledTextCtrl:scrollToLine(Editor, LineNo - 3), + wxStatusBar:setStatusText(S#state.status_bar, ""), + true; + false -> + wxStatusBar:setStatusText(S#state.status_bar, + "Not found (Hit Enter to wrap search)"), + false + end, + P2 = P#code_page{find_data = Data#find_data{found = Found2}}, + Pages = lists:keystore(P#code_page.name, #code_page.name, S#state.code_pages, P2), + S#state{active_page = P2, code_pages = Pages}. + +goto_function(S, Editor) -> + wxStyledTextCtrl:hideSelection(Editor, false), + CurrentPos = wxStyledTextCtrl:getCurrentPos(Editor), + Left = wxStyledTextCtrl:wordStartPosition(Editor, CurrentPos, true), + Right = wxStyledTextCtrl:wordEndPosition(Editor, CurrentPos, true), + ColonPos = Left - 1, + Left2 = + case wxStyledTextCtrl:getCharAt(Editor, ColonPos) of + $: -> + wxStyledTextCtrl:wordStartPosition(Editor, ColonPos, true); + _ -> + Left + end, + Right2 = + case wxStyledTextCtrl:getCharAt(Editor, Right) of + $: -> + wxStyledTextCtrl:wordEndPosition(Editor, Right + 1, true); + _ -> + Right + end, + case [wxStyledTextCtrl:getCharAt(Editor, Right2)] of + "(" -> + wxStyledTextCtrl:setSelection(Editor, Left2, Right2), + Text = wxStyledTextCtrl:getSelectedText(Editor), + S2 = add_pos_to_history(S, CurrentPos), + do_goto_function(S2, string:tokens(Text, ":")); + _ -> + %% No function call + wxStyledTextCtrl:hideSelection(Editor, false), + wxStyledTextCtrl:setSelection(Editor, Left2, Right2), + S + end. + +do_goto_function(S, []) -> + S; +do_goto_function(#state{active_page = P} = S, [FunName]) -> + wxStyledTextCtrl:gotoPos(P#code_page.editor, 1), + find_regexp_forward(S, "^" ++ FunName ++ "("); +do_goto_function(S, [ModStr, FunStr]) -> + case reltool_server:get_mod(S#state.xref_pid, list_to_atom(ModStr)) of + {ok, Mod} when Mod#mod.app_name =/= ?MISSING_APP -> + S2 = create_code_page(S#state{mod = Mod}, ModStr), + find_regexp_forward(S2, "^" ++ FunStr ++ "("); + {ok, _} -> + wxStatusBar:setStatusText(S#state.status_bar, "No such module: " ++ ModStr), + S + end. + +goto_back(#state{active_page = #code_page{editor = Editor, find_data = Data} = Page, + code_pages = Pages} = S) -> + case Data#find_data.history of + [PrevPos | History] -> + LineNo = wxStyledTextCtrl:lineFromPosition(Editor, PrevPos), + Data2 = Data#find_data{history = History}, + Page2 = Page#code_page{find_data = Data2}, + Pages2 = lists:keystore(Page2#code_page.name, #code_page.name, Pages, Page2), + goto_line(S#state{active_page = Page2, code_pages = Pages2}, LineNo); + [] -> + wxStatusBar:setStatusText(S#state.status_bar, "No history"), + S + end. + +add_pos_to_history(#state{active_page = Page, code_pages = Pages} = S, CurrentPos) -> + Data = Page#code_page.find_data, + Data2 = Data#find_data{history = [CurrentPos | Data#find_data.history]}, + Page2 = Page#code_page{find_data = Data2}, + Pages2 = lists:keystore(Page2#code_page.name, #code_page.name, Pages, Page2), + S#state{active_page = Page2, code_pages = Pages2}. + +create_editor(Parent) -> + FixedFont = wxFont:new(10, ?wxFONTFAMILY_TELETYPE, ?wxNORMAL, ?wxNORMAL,[]), + %%Ed = wxStyledTextCtrl:new(Parent, [{size, {700, 500}}]), + Ed = wxStyledTextCtrl:new(Parent), + + wxStyledTextCtrl:styleClearAll(Ed), + wxStyledTextCtrl:styleSetFont(Ed, ?wxSTC_STYLE_DEFAULT, FixedFont), + wxStyledTextCtrl:setLexer(Ed, ?wxSTC_LEX_ERLANG), + wxStyledTextCtrl:setMarginType(Ed, 0, ?wxSTC_MARGIN_NUMBER), + LW = wxStyledTextCtrl:textWidth(Ed, ?wxSTC_STYLE_LINENUMBER, "9"), + wxStyledTextCtrl:setMarginWidth(Ed, 0, LW), + + wxStyledTextCtrl:setSelectionMode(Ed, ?wxSTC_SEL_LINES), + %%wxStyledTextCtrl:hideSelection(Ed, true), + + Styles = [{?wxSTC_ERLANG_DEFAULT, {0,0,0}}, + {?wxSTC_ERLANG_COMMENT, {160,53,35}}, + {?wxSTC_ERLANG_VARIABLE, {150,100,40}}, + {?wxSTC_ERLANG_NUMBER, {5,5,100}}, + {?wxSTC_ERLANG_KEYWORD, {130,40,172}}, + {?wxSTC_ERLANG_STRING, {170,45,132}}, + {?wxSTC_ERLANG_OPERATOR, {30,0,0}}, + {?wxSTC_ERLANG_ATOM, {0,0,0}}, + {?wxSTC_ERLANG_FUNCTION_NAME, {64,102,244}}, + {?wxSTC_ERLANG_CHARACTER,{236,155,172}}, + {?wxSTC_ERLANG_MACRO, {40,144,170}}, + {?wxSTC_ERLANG_RECORD, {40,100,20}}, + {?wxSTC_ERLANG_SEPARATOR,{0,0,0}}, + {?wxSTC_ERLANG_NODE_NAME,{0,0,0}}], + SetStyle = fun({Style, Color}) -> + wxStyledTextCtrl:styleSetFont(Ed, Style, FixedFont), + wxStyledTextCtrl:styleSetForeground(Ed, Style, Color) + end, + [SetStyle(Style) || Style <- Styles], + wxStyledTextCtrl:setKeyWords(Ed, 0, keyWords()), + + %% Margins Markers + %% Breakpoint Should be a pixmap? + wxStyledTextCtrl:markerDefine(Ed, 0, ?wxSTC_MARK_CIRCLE, [{foreground, {170,20,20}}]), + wxStyledTextCtrl:markerDefine(Ed, 0, ?wxSTC_MARK_CIRCLE, [{background, {200,120,120}}]), + %% Disabled Breakpoint + wxStyledTextCtrl:markerDefine(Ed, 1, ?wxSTC_MARK_CIRCLE, [{foreground, {20,20,170}}]), + wxStyledTextCtrl:markerDefine(Ed, 1, ?wxSTC_MARK_CIRCLE, [{background, {120,120,200}}]), + + %% Current Line + wxStyledTextCtrl:markerDefine(Ed, 2, ?wxSTC_MARK_ARROW, [{foreground, {20,170,20}}]), + wxStyledTextCtrl:markerDefine(Ed, 2, ?wxSTC_MARK_ARROW, [{background, {200,255,200}}]), + wxStyledTextCtrl:markerDefine(Ed, 3, ?wxSTC_MARK_BACKGROUND, [{background, {200,255,200}}]), + + %% Scrolling + Policy = ?wxSTC_CARET_SLOP bor ?wxSTC_CARET_JUMPS bor ?wxSTC_CARET_EVEN, + wxStyledTextCtrl:setYCaretPolicy(Ed, Policy, 3), + wxStyledTextCtrl:setVisiblePolicy(Ed, Policy, 3), + + wxStyledTextCtrl:connect(Ed, stc_doubleclick), + wxWindow:connect(Ed, enter_window), + + wxStyledTextCtrl:setReadOnly(Ed, true), + Ed. + +create_search_area(Parent) -> + Sizer = wxBoxSizer:new(?wxHORIZONTAL), + wxSizer:add(Sizer, wxStaticText:new(Parent, ?wxID_ANY, "Find:"), + [{flag,?wxALIGN_CENTER_VERTICAL}]), + TC1 = wxTextCtrl:new(Parent, ?SEARCH_ENTRY, [{style, ?wxTE_PROCESS_ENTER}]), + wxSizer:add(Sizer, TC1, [{proportion,3}, {flag, ?wxEXPAND}]), + Nbtn = wxRadioButton:new(Parent, ?wxID_ANY, "Next"), + wxRadioButton:setValue(Nbtn, true), + wxSizer:add(Sizer,Nbtn,[{flag,?wxALIGN_CENTER_VERTICAL}]), + Pbtn = wxRadioButton:new(Parent, ?wxID_ANY, "Previous"), + wxSizer:add(Sizer,Pbtn,[{flag,?wxALIGN_CENTER_VERTICAL}]), + Cbtn = wxCheckBox:new(Parent, ?wxID_ANY, "Match Case"), + wxSizer:add(Sizer,Cbtn,[{flag,?wxALIGN_CENTER_VERTICAL}]), + wxSizer:add(Sizer, 15,15, [{proportion,1}, {flag, ?wxEXPAND}]), + wxSizer:add(Sizer, wxStaticText:new(Parent, ?wxID_ANY, "Goto Line:"), + [{flag,?wxALIGN_CENTER_VERTICAL}]), + TC2 = wxTextCtrl:new(Parent, ?GOTO_ENTRY, [{style, ?wxTE_PROCESS_ENTER}]), + wxSizer:add(Sizer, TC2, [{proportion,0}, {flag, ?wxEXPAND}]), + Button = wxButton:new(Parent, ?wxID_ANY, [{label, "Back"}]), + wxSizer:add(Sizer, Button, []), + + wxEvtHandler:connect(Button, command_button_clicked, [{userData, history_back}]), + %% wxTextCtrl:connect(TC1, command_text_updated), + wxTextCtrl:connect(TC1, command_text_enter), + %% wxTextCtrl:connect(TC1, kill_focus), + wxTextCtrl:connect(TC2, command_text_enter), + wxWindow:connect(Parent, command_button_clicked), + {#find_objs{search = TC1,goto = TC2,radio = {Nbtn,Pbtn,Cbtn}}, + #find_data{start = 0, found = false, history = []}, + Sizer}. + +load_code(Ed, Code) when is_binary(Code) -> + wxStyledTextCtrl:setReadOnly(Ed, false), + wxStyledTextCtrl:setTextRaw(Ed, <<Code/binary, 0:8>>), + Lines = wxStyledTextCtrl:getLineCount(Ed), + Sz = trunc(math:log10(Lines))+1, + LW = wxStyledTextCtrl:textWidth(Ed, ?wxSTC_STYLE_LINENUMBER, lists:duplicate(Sz, $9)), + %%io:format("~p ~p ~p~n", [Lines, Sz, LW]), + wxStyledTextCtrl:setMarginWidth(Ed, 0, LW+5), + wxStyledTextCtrl:setReadOnly(Ed, true), + Ed. + +keyWords() -> + L = ["after","begin","case","try","cond","catch","andalso","orelse", + "end","fun","if","let","of","query","receive","when","bnot","not", + "div","rem","band","and","bor","bxor","bsl","bsr","or","xor"], + lists:flatten([K ++ " " || K <- L] ++ [0]). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% sys callbacks + +system_continue(_Parent, _Debug, S) -> + ?MODULE:loop(S). + +system_terminate(Reason, _Parent, _Debug, _S) -> + exit(Reason). + +system_code_change(S,_Module,_OldVsn,_Extra) -> + {ok, S}. diff --git a/lib/reltool/src/reltool_server.erl b/lib/reltool/src/reltool_server.erl new file mode 100644 index 0000000000..8d4530131f --- /dev/null +++ b/lib/reltool/src/reltool_server.erl @@ -0,0 +1,1678 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 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(reltool_server). + +%% Public +-export([ + start_link/0, start_link/1, + get_config/3, load_config/2, save_config/4, + get_rel/2, get_script/2, + reset_config/1, undo_config/1, + get_mod/2, + get_app/2, set_app/2, + get_apps/2, set_apps/2, + get_sys/1, set_sys/2, + get_status/1, + gen_rel_files/2, gen_target/2, gen_spec/1 + ]). + +%% Internal +-export([init/1, loop/1]). + +%% sys callback functions +-export([ + system_continue/3, + system_terminate/4, + system_code_change/4 + ]). + +-include("reltool.hrl"). + +-record(state, + {options, + parent_pid, + common, + sys, + old_sys, + status, + old_status}). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% Client + +start_link() -> + start_link([]). + +start_link(Options) -> + proc_lib:start_link(?MODULE, init, [[{parent, self()} | Options]], infinity, []). + +get_config(Pid, InclDefaults, InclDerivates) -> + reltool_utils:call(Pid, {get_config, InclDefaults, InclDerivates}). + +load_config(Pid, FilenameOrConfig) -> + reltool_utils:call(Pid, {load_config, FilenameOrConfig}). + +save_config(Pid, Filename, InclDefaults, InclDerivates) -> + reltool_utils:call(Pid, {save_config, Filename, InclDefaults, InclDerivates}). + +reset_config(Pid) -> + reltool_utils:call(Pid, reset_config). + +undo_config(Pid) -> + reltool_utils:call(Pid, undo_config). + +get_rel(Pid, RelName) -> + reltool_utils:call(Pid, {get_rel, RelName}). + +get_script(Pid, RelName) -> + reltool_utils:call(Pid, {get_script, RelName}). + +get_mod(Pid, ModName) -> + reltool_utils:call(Pid, {get_mod, ModName}). + +get_app(Pid, AppName) -> + reltool_utils:call(Pid, {get_app, AppName}). + +set_app(Pid, App) -> + reltool_utils:call(Pid, {set_app, App}). + +get_apps(Pid, Kind) -> + reltool_utils:call(Pid, {get_apps, Kind}). + +set_apps(Pid, Apps) -> + reltool_utils:call(Pid, {set_apps, Apps}). + +get_sys(Pid) -> + reltool_utils:call(Pid, get_sys). + +set_sys(Pid, Sys) -> + reltool_utils:call(Pid, {set_sys, Sys}). + +get_status(Pid) -> + reltool_utils:call(Pid, get_status). + +gen_rel_files(Pid, Dir) -> + reltool_utils:call(Pid, {gen_rel_files, Dir}). + +gen_target(Pid, Dir) -> + reltool_utils:call(Pid, {gen_target, Dir}). + +gen_spec(Pid) -> + reltool_utils:call(Pid, gen_spec). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% Server + +init(Options) -> + try + do_init(Options) + catch + error:Reason -> + exit({Reason, erlang:get_stacktrace()}) + end. + +do_init(Options) -> + case parse_options(Options) of + {#state{parent_pid = ParentPid, common = C, sys = Sys} = S, Status} -> + %% process_flag(trap_exit, (S#state.common)#common.trap_exit), + proc_lib:init_ack(ParentPid, {ok, self(), C, Sys#sys{apps = undefined}}), + {S2, Status2} = refresh(S, true, Status), + {S3, Status3} = analyse(S2#state{old_sys = S2#state.sys}, Status2), + case Status3 of + {ok, _Warnings} -> + loop(S3#state{status = Status3, old_status = {ok, []}}); + {error, Reason} -> + exit(Reason) + end + end. + +parse_options(Opts) -> + AppTab = ets:new(reltool_apps, [public, ordered_set, {keypos, #app.name}]), + ModTab = ets:new(reltool_mods, [public, ordered_set, {keypos, #mod.name}]), + ModUsesTab = ets:new(reltool_mod_uses, [public, bag, {keypos, 1}]), + Sys = #sys{root_dir = reltool_utils:root_dir(), + lib_dirs = reltool_utils:erl_libs(), + escripts = [], + incl_cond = ?DEFAULT_INCL_COND, + mod_cond = ?DEFAULT_MOD_COND, + apps = ?DEFAULT_APPS, + boot_rel = ?DEFAULT_REL_NAME, + rels = reltool_utils:default_rels(), + emu_name = ?DEFAULT_EMU_NAME, + profile = ?DEFAULT_PROFILE, + incl_sys_filters = reltool_utils:decode_regexps(incl_sys_filters, ?DEFAULT_INCL_SYS_FILTERS, []), + excl_sys_filters = reltool_utils:decode_regexps(excl_sys_filters, ?DEFAULT_EXCL_SYS_FILTERS, []), + incl_app_filters = reltool_utils:decode_regexps(incl_app_filters, ?DEFAULT_INCL_APP_FILTERS, []), + excl_app_filters = reltool_utils:decode_regexps(excl_app_filters, ?DEFAULT_EXCL_APP_FILTERS, []), + relocatable = ?DEFAULT_RELOCATABLE, + app_type = ?DEFAULT_APP_TYPE, + app_file = ?DEFAULT_APP_FILE, + incl_archive_filters = reltool_utils:decode_regexps(incl_archive_filters, ?DEFAULT_INCL_ARCHIVE_FILTERS, []), + excl_archive_filters = reltool_utils:decode_regexps(excl_archive_filters, ?DEFAULT_EXCL_ARCHIVE_FILTERS, []), + archive_opts = ?DEFAULT_ARCHIVE_OPTS, + debug_info = ?DEFAULT_DEBUG_INFO}, + C2 = #common{sys_debug = [], + wx_debug = 0, + trap_exit = true, + app_tab = AppTab, + mod_tab = ModTab, + mod_used_by_tab = ModUsesTab}, + S = #state{options = Opts}, + parse_options(Opts, S, C2, Sys, {ok, []}). + +parse_options([{Key, Val} | KeyVals], S, C, Sys, Status) -> + case Key of + parent -> + parse_options(KeyVals, S#state{parent_pid = Val}, C, Sys, Status); + sys_debug -> + parse_options(KeyVals, S, C#common{sys_debug = Val}, Sys, Status); + wx_debug -> + parse_options(KeyVals, S, C#common{wx_debug = Val}, Sys, Status); + trap_exit -> + parse_options(KeyVals, S, C#common{trap_exit = Val}, Sys, Status); + config -> + {Sys2, Status2} = read_config(Sys, Val, Status), + parse_options(KeyVals, S, C, Sys2, Status2); + sys -> + {Sys2, Status2} = read_config(Sys, {sys, Val}, Status), + parse_options(KeyVals, S, C, Sys2, Status2); + _ -> + Text = lists:flatten(io_lib:format("~p", [{Key, Val}])), + Status2 = reltool_utils:return_first_error(Status, "Illegal option: " ++ Text), + parse_options(KeyVals, S, C, Sys, Status2) + end; +parse_options([], S, C, Sys, Status) -> + {S#state{common = C, sys = Sys}, Status}; +parse_options(KeyVals, S, C, Sys, Status) -> + Text = lists:flatten(io_lib:format("~p", [KeyVals])), + Status2 = reltool_utils:return_first_error(Status, "Illegal options: " ++ Text), + {S#state{common = C, sys = Sys}, Status2}. + +loop(#state{common = C, sys = Sys} = S) -> + receive + {system, From, Msg} -> + sys:handle_system_msg(Msg, From, S#state.parent_pid, ?MODULE, C#common.sys_debug, S); + {call, ReplyTo, Ref, {get_config, InclDefaults, InclDerivates}} -> + Reply = do_get_config(S, InclDefaults, InclDerivates), + reltool_utils:reply(ReplyTo, Ref, Reply), + ?MODULE:loop(S); + {call, ReplyTo, Ref, {load_config, SysConfig}} -> + {S2, Reply} = do_load_config(S, SysConfig), + reltool_utils:reply(ReplyTo, Ref, Reply), + ?MODULE:loop(S2); + {call, ReplyTo, Ref, {save_config, Filename, InclDefaults, InclDerivates}} -> + Reply = do_save_config(S, Filename, InclDefaults, InclDerivates), + reltool_utils:reply(ReplyTo, Ref, Reply), + ?MODULE:loop(S); + {call, ReplyTo, Ref, reset_config} -> + {S2, Status} = parse_options(S#state.options), + S3 = shrink_sys(S2), + {S4, Status2} = refresh(S3, true, Status), + {S5, Status3} = analyse(S4#state{old_sys = S4#state.sys}, Status2), + S6 = + case Status3 of + {ok, _Warnings} -> + S5#state{status = Status3, old_status = S#state.status}; + {error, _} -> + S + end, + reltool_utils:reply(ReplyTo, Ref, Status3), + ?MODULE:loop(S6); + {call, ReplyTo, Ref, undo_config} -> + reltool_utils:reply(ReplyTo, Ref, ok), + S2 = S#state{sys = S#state.old_sys, + old_sys = S#state.sys, + status = S#state.old_status, + old_status = S#state.status}, + ?MODULE:loop(S2); + {call, ReplyTo, Ref, {get_rel, RelName}} -> + Sys = S#state.sys, + Reply = + case lists:keysearch(RelName, #rel.name, Sys#sys.rels) of + {value, Rel} -> + {ok, reltool_target:gen_rel(Rel, Sys)}; + false -> + {error, "No such release"} + end, + reltool_utils:reply(ReplyTo, Ref, Reply), + ?MODULE:loop(S); + {call, ReplyTo, Ref, {get_script, RelName}} -> + Sys = S#state.sys, + Reply = + case lists:keysearch(RelName, #rel.name, Sys#sys.rels) of + {value, Rel} -> + PathFlag = true, + Variables = [], + reltool_target:gen_script(Rel, Sys, PathFlag, Variables); + false -> + {error, "No such release"} + end, + reltool_utils:reply(ReplyTo, Ref, Reply), + ?MODULE:loop(S); + {call, ReplyTo, Ref, {get_mod, ModName}} -> + Reply = + case ets:lookup(C#common.mod_tab, ModName) of + [M] -> + {ok, M}; + [] -> + {ok, missing_mod(ModName, ?MISSING_APP)} + end, + reltool_utils:reply(ReplyTo, Ref, Reply), + ?MODULE:loop(S); + {call, ReplyTo, Ref, {get_app, AppName}} when is_atom(AppName) -> + Reply = + case lists:keysearch(AppName, #app.name, Sys#sys.apps) of + {value, App} -> + {ok, App}; + false -> + {error, enoent} + end, + reltool_utils:reply(ReplyTo, Ref, Reply), + ?MODULE:loop(S); + {call, ReplyTo, Ref, {set_app, App}} -> + {S2, Status} = do_set_app(S, App, {ok, []}), + {S3, Status2} = analyse(S2, Status), + case Status2 of + {ok, Warnings} -> + App2 = ?KEYSEARCH(App#app.name, + #app.name, + (S3#state.sys)#sys.apps), + reltool_utils:reply(ReplyTo, Ref, {ok, App2, Warnings}), + ?MODULE:loop(S3); + {error, Reason} -> + reltool_utils:reply(ReplyTo, Ref, {error, Reason}), + ?MODULE:loop(S) + end; + {call, ReplyTo, Ref, {get_apps, Kind}} -> + AppNames = + case Kind of + whitelist -> + [A || + A <- Sys#sys.apps, + A#app.is_pre_included =:= true]; + blacklist -> + [A || + A <- Sys#sys.apps, + A#app.is_pre_included =:= false]; + source -> + [A || + A <- Sys#sys.apps, + A#app.is_included =/= true, + A#app.is_pre_included =/= false]; + derived -> + [A || + A <- Sys#sys.apps, + A#app.is_included =:= true, + A#app.is_pre_included =/= true] + end, + reltool_utils:reply(ReplyTo, Ref, {ok, AppNames}), + ?MODULE:loop(S); + {call, ReplyTo, Ref, {set_apps, Apps}} -> + {S2, Status} = lists:foldl(fun(A, {X, Y}) -> do_set_app(X, A, Y) end, + {S, {ok, []}}, + Apps), + {S3, Status2} = analyse(S2, Status), + reltool_utils:reply(ReplyTo, Ref, Status2), + ?MODULE:loop(S3); + {call, ReplyTo, Ref, get_sys} -> + reltool_utils:reply(ReplyTo, Ref, {ok, Sys#sys{apps = undefined}}), + ?MODULE:loop(S); + {call, ReplyTo, Ref, {set_sys, Sys2}} -> + S2 = S#state{sys = Sys2#sys{apps = Sys#sys.apps}}, + Force = + (Sys2#sys.root_dir =/= Sys#sys.root_dir) orelse + (Sys2#sys.lib_dirs =/= Sys#sys.lib_dirs) orelse + (Sys2#sys.escripts =/= Sys#sys.escripts), + {S3, Status} = refresh(S2, Force, {ok, []}), + {S4, Status2} = analyse(S3#state{old_sys = S#state.sys}, Status), + S6 = + case Status2 of + {ok, _Warnings} -> + S4#state{status = Status2, old_status = S#state.status}; + {error, _} -> + S + end, + reltool_utils:reply(ReplyTo, Ref, Status2), + ?MODULE:loop(S6); + {call, ReplyTo, Ref, get_status} -> + reltool_utils:reply(ReplyTo, Ref, S#state.status), + ?MODULE:loop(S); + {call, ReplyTo, Ref, {gen_rel_files, Dir}} -> + Status = + case reltool_target:gen_rel_files(S#state.sys, Dir) of + ok -> + {ok, []}; + {error, Reason} -> + {error, Reason} + end, + reltool_utils:reply(ReplyTo, Ref, Status), + ?MODULE:loop(S); + {call, ReplyTo, Ref, {gen_target, Dir}} -> + Reply = reltool_target:gen_target(S#state.sys, Dir), + reltool_utils:reply(ReplyTo, Ref, Reply), + ?MODULE:loop(S); + {call, ReplyTo, Ref, gen_spec} -> + Reply = reltool_target:gen_spec(S#state.sys), + reltool_utils:reply(ReplyTo, Ref, Reply), + ?MODULE:loop(S); + {'EXIT', Pid, Reason} when Pid =:= S#state.parent_pid -> + exit(Reason); + {call, ReplyTo, Ref, Msg} when is_pid(ReplyTo), is_reference(Ref) -> + error_logger:format("~p~p got unexpected call:\n\t~p\n", + [?MODULE, self(), Msg]), + reltool_utils:reply(ReplyTo, Ref, {error, {invalid_call, Msg}}), + ?MODULE:loop(S); + Msg -> + error_logger:format("~p~p got unexpected message:\n\t~p\n", + [?MODULE, self(), Msg]), + ?MODULE:loop(S) + end. + + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +do_set_app(#state{sys = Sys} = S, App, Status) -> + AppName = App#app.name, + {App2, Status2} = refresh_app(App, false, Status), + Apps = Sys#sys.apps, + Apps2 = lists:keystore(AppName, #app.name, Apps, App2), + Escripts = [A#app.active_dir || A <- Apps2, A#app.is_escript], + Sys2 = Sys#sys{apps = Apps2, escripts = Escripts}, + {S#state{sys = Sys2}, Status2}. + +analyse(#state{common = C, sys = #sys{apps = Apps0} = Sys} = S, Status) -> + Apps = lists:keydelete(?MISSING_APP, #app.name, Apps0), + ets:delete_all_objects(C#common.app_tab), + ets:delete_all_objects(C#common.mod_tab), + ets:delete_all_objects(C#common.mod_used_by_tab), + MissingApp = default_app(?MISSING_APP, "missing"), + ets:insert(C#common.app_tab, MissingApp), + + Apps2 = lists:map(fun(App) -> app_init_is_included(C, Sys, App) end, Apps), + Apps3 = + case app_propagate_is_included(C, Sys, Apps2, []) of + [] -> + Apps2; + MissingMods -> + %% io:format("Missing mods: ~p\n", [MissingMods]), + MissingApp2 = MissingApp#app{label = ?MISSING_APP_TEXT, + info = missing_app_info(""), + mods = MissingMods, + status = missing, + uses_mods = []}, + [MissingApp2 | Apps2] + end, + app_propagate_is_used_by(C, Apps3), + Apps4 = read_apps(C, Sys, Apps3, []), + %% io:format("Missing app: ~p\n", [lists:keysearch(?MISSING_APP, #app.name, Apps4)]), + Sys2 = Sys#sys{apps = Apps4}, + try + Status2 = verify_config(Sys2, Status), + {S#state{sys = Sys2}, Status2} + catch + throw:{error, Status3} -> + {S, Status3} + end. + +app_init_is_included(C, Sys, #app{mods = Mods} = A) -> + AppCond = + case A#app.incl_cond of + undefined -> Sys#sys.incl_cond; + _ -> A#app.incl_cond + end, + ModCond = + case A#app.mod_cond of + undefined -> Sys#sys.mod_cond; + _ -> A#app.mod_cond + end, + IsIncl = + case AppCond of + include -> true; + exclude -> false; + derived -> undefined + end, + A2 = A#app{is_pre_included = IsIncl, is_included = IsIncl}, + ets:insert(C#common.app_tab, A2), + lists:foreach(fun(Mod) -> mod_init_is_included(C, Mod, ModCond, AppCond, undefined) end, Mods), + %%app_mod_init_is_included(C, AppName, Info, ModCond, AppCond), + A2. + +mod_init_is_included(C, M, ModCond, AppCond, Default) -> + %% print(M#mod.name, hipe, "incl_cond -> ~p\n", [AppCond]), + IsIncl = + case AppCond of + include -> + case M#mod.incl_cond of + include -> + true; + exclude -> + false; + undefined -> + %% print(M#mod.name, hipe, "mod_cond -> ~p\n", [ModCond]), + case ModCond of + all -> true; + app -> false_to_undefined(M#mod.is_app_mod); + ebin -> false_to_undefined(M#mod.is_ebin_mod); + derived -> Default; + none -> false + end + end; + exclude -> + false; + derived -> + case M#mod.incl_cond of + include -> + true; + exclude -> + false; + undefined -> + Default + end + end, + M2 = M#mod{is_pre_included = IsIncl, is_included = IsIncl}, + %% print(M#mod.name, hipe, "~p -> ~p\n", [M2, IsIncl]), + ets:insert(C#common.mod_tab, M2). + +false_to_undefined(Bool) -> + case Bool of + false -> undefined; + _ -> Bool + end. + +app_propagate_is_included(C, Sys, [#app{mods = Mods} = A | Apps], Acc) -> + Acc2 = mod_propagate_is_included(C, Sys, A, Mods, Acc), + app_propagate_is_included(C, Sys, Apps, Acc2); +app_propagate_is_included(_C, _Sys, [], Acc) -> + Acc. + +mod_propagate_is_included(C, Sys, A, [#mod{name = ModName} | Mods], Acc) -> + [M2] = ets:lookup(C#common.mod_tab, ModName), + %% print(ModName, file, "Maybe Prop ~p -> ~p\n", [M2, M2#mod.is_included]), + %% print(ModName, filename, "Maybe Prop ~p -> ~p\n", [M2, M2#mod.is_included]), + Acc2 = + case M2#mod.is_included of + true -> + %% Propagate include mark + mod_mark_is_included(C, Sys, ModName, M2#mod.uses_mods, Acc); + false -> + Acc; + undefined -> + Acc + end, + mod_propagate_is_included(C, Sys, A, Mods, Acc2); +mod_propagate_is_included(_C, _Sys, _A, [], Acc) -> + Acc. + +mod_mark_is_included(C, Sys, UsedByName, [ModName | ModNames], Acc) -> + Acc3 = + case ets:lookup(C#common.mod_tab, ModName) of + [M] -> + %% print(UsedByName, file, "Maybe Mark ~p -> ~p\n", [M, M#mod.is_included]), + %% print(UsedByName, filename, "Maybe Mark ~p -> ~p\n", [M, M#mod.is_included]), + case M#mod.is_included of + true -> + %% Already marked + Acc; + false -> + %% Already marked + Acc; + undefined -> + %% Mark and propagate + M2 = + case M#mod.incl_cond of + include -> + M#mod{is_pre_included = true, is_included = true}; + exclude -> + M#mod{is_pre_included = true, is_included = true}; + undefined -> + M#mod{is_included = true} + end, + ets:insert(C#common.mod_tab, M2), + %% io:format("Propagate mod: ~p -> ~p (~p)\n", [UsedByName, ModName, M#mod.incl_cond]), + [A] = ets:lookup(C#common.app_tab, M2#mod.app_name), + Acc2 = + case A#app.is_included of + true -> + Acc; + false -> + Acc; + undefined -> + ModCond = + case A#app.mod_cond of + undefined -> Sys#sys.mod_cond; + _ -> A#app.mod_cond + end, + Filter = + fun(M3) -> + case ModCond of + all -> true; + app -> M3#mod.is_app_mod; + ebin -> M3#mod.is_ebin_mod; + derived -> false; + none -> false + end + end, + Mods = lists:filter(Filter, A#app.mods), + %% io:format("Propagate app: ~p ~p -> ~p\n", + %% [UsedByName, A#app.name, [M3#mod.name || M3 <- Mods]]), + A2 = A#app{is_included = true}, + ets:insert(C#common.app_tab, A2), + mod_mark_is_included(C, Sys, ModName, [M3#mod.name || M3 <- Mods], Acc) + end, + mod_mark_is_included(C, Sys, ModName, M2#mod.uses_mods, Acc2) + end; + [] -> + M = missing_mod(ModName, ?MISSING_APP), + M2 = M#mod{is_included = true}, + ets:insert(C#common.mod_tab, M2), + ets:insert(C#common.mod_used_by_tab, {UsedByName, ModName}), + [M2 | Acc] + end, + mod_mark_is_included(C, Sys, UsedByName, ModNames, Acc3); +mod_mark_is_included(_C, _Sys, _UsedByName, [], Acc) -> + Acc. + +app_propagate_is_used_by(C, [#app{mods = Mods, name = Name} | Apps]) -> + case Name =:= ?MISSING_APP of + true -> ok; + false -> ok + end, + mod_propagate_is_used_by(C, Mods), + app_propagate_is_used_by(C, Apps); +app_propagate_is_used_by(_C, []) -> + ok. + +mod_propagate_is_used_by(C, [#mod{name = ModName} | Mods]) -> + [M] = ets:lookup(C#common.mod_tab, ModName), + case M#mod.is_included of + true -> + [ets:insert(C#common.mod_used_by_tab, {UsedModName, ModName}) || + UsedModName <- M#mod.uses_mods]; + false -> + ignore; + undefined -> + ignore + end, + mod_propagate_is_used_by(C, Mods); +mod_propagate_is_used_by(_C, []) -> + ok. + +read_apps(C, Sys, [#app{mods = Mods, is_included = IsIncl} = A | Apps], Acc) -> + {Mods2, IsIncl2} = read_apps(C, Sys, A, Mods, [], IsIncl), + %% reltool_utils:print(A#app.name, stdlib, "Mods2: ~p\n", [[M#mod.status || M <- Mods2]]), + Status = + case lists:keysearch(missing, #mod.status, Mods2) of + {value, _} -> missing; + false -> ok + end, + UsesMods = [M#mod.uses_mods || M <- Mods2, M#mod.is_included =:= true], + UsesMods2 = lists:usort(lists:flatten(UsesMods)), + UsesApps = [M#mod.app_name || ModName <- UsesMods2, M <- ets:lookup(C#common.mod_tab, ModName)], + UsesApps2 = lists:usort(UsesApps), + UsedByMods = [M#mod.used_by_mods || M <- Mods2, M#mod.is_included =:= true], + UsedByMods2 = lists:usort(lists:flatten(UsedByMods)), + UsedByApps = [M#mod.app_name || ModName <- UsedByMods2, M <- ets:lookup(C#common.mod_tab, ModName)], + UsedByApps2 = lists:usort(UsedByApps), + + A2 = A#app{mods = Mods2, + status = Status, + uses_mods = UsesMods2, + used_by_mods = UsedByMods2, + uses_apps = UsesApps2, + used_by_apps = UsedByApps2, + is_included = IsIncl2}, + read_apps(C, Sys, Apps, [A2 | Acc]); +read_apps(_C, _Sys, [], Acc) -> + lists:reverse(Acc). + +read_apps(C, Sys, A, [#mod{name = ModName} | Mods], Acc, IsIncl) -> + [M2] = ets:lookup(C#common.mod_tab, ModName), + Status = do_get_status(M2), + %% print(M2#mod.name, hipe, "status -> ~p\n", [Status]), + {IsIncl2, M3} = + case M2#mod.is_included of + true -> + UsedByMods = [N || {_, N} <- ets:lookup(C#common.mod_used_by_tab, ModName)], + {true, M2#mod{status = Status, used_by_mods = UsedByMods}}; + _ -> + {IsIncl, M2#mod{status = Status, used_by_mods = []}} + end, + ets:insert(C#common.mod_tab, M3), + read_apps(C, Sys, A, Mods, [M3 | Acc], IsIncl2); +read_apps(_C, _Sys, _A, [], Acc, IsIncl) -> + {lists:reverse(Acc), IsIncl}. + +do_get_status(M) -> + if + M#mod.exists =:= false, M#mod.is_included =/= false -> + missing; + true -> + ok + end. + +shrink_sys(#state{sys = #sys{apps = Apps} = Sys} = S) -> + Apps2 = lists:zf(fun filter_app/1, Apps), + S#state{sys = Sys#sys{apps = Apps2}}. + +filter_app(A) -> + Mods = [M#mod{is_app_mod = undefined, + is_ebin_mod = undefined, + uses_mods = undefined, + exists = false, + is_pre_included = undefined, + is_included = undefined} || + M <- A#app.mods, + M#mod.incl_cond =/= undefined], + if + A#app.is_escript -> + {true, A#app{vsn = undefined, + label = undefined, + info = undefined, + mods = [], + uses_mods = undefined, + is_included = undefined}}; + Mods =:= [], + A#app.mod_cond =:= undefined, + A#app.incl_cond =:= undefined, + A#app.use_selected_vsn =:= undefined -> + false; + true -> + {Dir, Dirs} = + case A#app.use_selected_vsn of + undefined -> + {shrinked, []}; + false -> + {shrinked, []}; + true -> + {A#app.active_dir, [A#app.active_dir]}; + _ when A#app.is_escript -> + {A#app.active_dir, [A#app.active_dir]} + end, + OptVsn = + case A#app.use_selected_vsn of + undefined -> undefined; + false -> undefined; + true -> A#app.vsn + end, + {true, A#app{active_dir = Dir, + sorted_dirs = Dirs, + vsn = OptVsn, + label = undefined, + info = undefined, + mods = Mods, + uses_mods = undefined, + is_included = undefined}} + end. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +refresh_app(#app{name = AppName, + is_escript = IsEscript, + active_dir = ActiveDir, + label = OptLabel, + mods = Mods} = App, + Force, + Status) -> + if + Force; OptLabel =:= undefined -> + {AppInfo, EbinMods, Status3} = + case IsEscript of + false -> + + %% Add info from .app file + Base = get_base(AppName, ActiveDir), + {_, DefaultVsn} = reltool_utils:split_app_name(Base), + Ebin = filename:join([ActiveDir, "ebin"]), + AppFile = filename:join([Ebin, atom_to_list(AppName) ++ ".app"]), + {AI, Status2} = read_app_info(AppFile, AppFile, AppName, DefaultVsn, Status), + {AI, read_ebin_mods(Ebin, AppName), Status2}; + true -> + {App#app.info, Mods, Status} + end, + + %% Add non-existing modules + AppModNames = + case AppInfo#app_info.mod of + {StartModName, _} -> + case lists:member(StartModName, AppInfo#app_info.modules) of + true -> AppInfo#app_info.modules; + false -> [StartModName | AppInfo#app_info.modules] + end; + undefined -> + AppInfo#app_info.modules + end, + MissingMods = add_missing_mods(AppName, EbinMods, AppModNames), + + %% Add optional user config for each module + Mods2 = add_mod_config(MissingMods ++ EbinMods, Mods), + + %% Set app flag for each module in app file + Mods3 = set_mod_flags(Mods2, AppModNames), + AppVsn = AppInfo#app_info.vsn, + AppLabel = + case AppVsn of + "" -> atom_to_list(AppName); + _ -> atom_to_list(AppName) ++ "-" ++ AppVsn + end, + App2 = App#app{vsn = AppVsn, + label = AppLabel, + info = AppInfo, + mods = lists:keysort(#mod.name, Mods3)}, + {App2, Status3}; + true -> + {App, Status} + end. + +missing_app_info(Vsn) -> + #app_info{vsn = Vsn}. + +read_app_info(_AppFileOrBin, _AppFile, erts, DefaultVsn, Status) -> + {missing_app_info(DefaultVsn), Status}; +read_app_info(AppFileOrBin, AppFile, AppName, DefaultVsn, Status) -> + EnoentText = file:format_error(enoent), + case reltool_utils:prim_consult(AppFileOrBin) of + {ok, [{application, AppName, Info}]} -> + AI = #app_info{vsn = DefaultVsn}, + parse_app_info(AppFile, Info, AI, Status); + {ok, _BadApp} -> + Text = lists:concat([AppName, ": Illegal contents in app file ", AppFile]), + {missing_app_info(DefaultVsn), reltool_utils:add_warning(Status, Text)}; + {error, Text} when Text =:= EnoentText-> + {missing_app_info(DefaultVsn), Status}; + {error, Text} -> + Text2 = lists:concat([AppName, ": Cannot parse app file ", AppFile, " (", Text, ")."]), + {missing_app_info(DefaultVsn), reltool_utils:add_warning(Status, Text2)} + end. + +parse_app_info(File, [{Key, Val} | KeyVals], AI, Status) -> + case Key of + description -> parse_app_info(File, KeyVals, AI#app_info{description = Val}, Status); + id -> parse_app_info(File, KeyVals, AI#app_info{id = Val}, Status); + vsn -> parse_app_info(File, KeyVals, AI#app_info{vsn = Val}, Status); + modules -> parse_app_info(File, KeyVals, AI#app_info{modules = Val}, Status); + maxP -> parse_app_info(File, KeyVals, AI#app_info{maxP = Val}, Status); + maxT -> parse_app_info(File, KeyVals, AI#app_info{maxT = Val}, Status); + registered -> parse_app_info(File, KeyVals, AI#app_info{registered = Val}, Status); + included_applications -> parse_app_info(File, KeyVals, AI#app_info{incl_apps = Val}, Status); + applications -> parse_app_info(File, KeyVals, AI#app_info{applications = Val}, Status); + env -> parse_app_info(File, KeyVals, AI#app_info{env = Val}, Status); + mod -> parse_app_info(File, KeyVals, AI#app_info{mod = Val}, Status); + start_phases -> parse_app_info(File, KeyVals, AI#app_info{start_phases = Val}, Status); + _ -> parse_app_info(File, KeyVals, AI, reltool_utils:add_warning(Status, lists:concat(["Unexpected item ", Key, "in app file ", File]))) + end; +parse_app_info(_, [], AI, Status) -> + {AI, Status}. + +read_ebin_mods(Ebin, AppName) -> + case erl_prim_loader:list_dir(Ebin) of + {ok, Files} -> + Ext = code:objfile_extension(), + InitMod = fun(F) -> + File = filename:join([Ebin, F]), + init_mod(AppName, File, File, Ext) + end, + Files2 = [F || F <- Files, filename:extension(F) =:= Ext], + pmap(InitMod, Files2); + error -> + [] + end. + +pmap(Fun, List) -> + lists:map(Fun, List). + %% N = erlang:system_info(schedulers) * 2, + %% pmap(Fun, List, 0, N, 0, [], []). + +%% -record(pmap_res, {count, ref, res}). +%% -record(pmap_wait, {count, ref, pid}). +%% +%% pmap(Fun, [H | T], N, Max, Count, WaitFor, Results) when N < Max -> +%% Ref = make_ref(), +%% Parent = self(), +%% Count2 = Count + 1, +%% Pid = spawn_link(fun() -> Parent ! #pmap_res{count = Count2, ref = Ref, res = Fun(H)}, unlink(Parent) end), +%% PW = #pmap_wait{count = Count2, pid = Pid, ref = Ref}, +%% pmap(Fun, T, N + 1, Max, Count2, [PW | WaitFor], Results); +%% pmap(_Fun, [], _N, _Max, _Count, [], Results) -> +%% %% Sort results and return them in the same orderas the original list +%% [PR#pmap_res.res || PR <- lists:keysort(#pmap_res.count, Results)]; +%% pmap(Fun, List, N, Max, Count, WaitFor, Results) -> +%% receive +%% #pmap_res{ref = Ref} = PR -> +%% WaitFor2 = lists:keydelete(Ref, #pmap_wait.ref, WaitFor), +%% pmap(Fun, List, N - 1, Max, Count, WaitFor2, [PR | Results]); +%% {'EXIT', Reason} -> +%% exit(Reason) +%% end. + +init_mod(AppName, File, FileOrBin, Ext) -> + UsesMods = xref_mod(FileOrBin), + Base = filename:basename(File, Ext), + ModName = list_to_atom(Base), + #mod{name = ModName, + app_name = AppName, + incl_cond = undefined, + is_ebin_mod = true, + uses_mods = UsesMods, + exists = true}. + +xref_mod({Base, Bin}) when is_binary(Bin) -> + Dir = filename:absname("reltool_server.tmp"), + ok = reltool_utils:recursive_delete(Dir), + ok = file:make_dir(Dir), + File = filename:join([Dir, Base]), + ok = file:write_file(File, Bin), + Res = xref_mod(File), + ok = reltool_utils:recursive_delete(Dir), + Res; +xref_mod(File) when is_list(File) -> + {ok, Pid} = xref:start([{xref_mode, modules}]), + link(Pid), + ok = xref:set_default(Pid, [{verbose,false}, {warnings, false}]), + ok = xref:set_library_path(Pid, []), + {ok, _} = xref:add_module(Pid, File, []), + {ok, UnknownMods} = xref:q(Pid, "UM", []), + %% {ok, ExportedFuns} = xref:q(Pid, "X", []), + %% io:format("Unres: ~p\n", [xref:variables(Pid, [predefined])]), + %% io:format("Q: ~p\n", [xref:q(Pid, "XU", [])]), + Ref = erlang:monitor(process, Pid), + unlink(Pid), + xref:stop(Pid), + wait_for_processto_die(Ref, Pid, File), + UnknownMods. + +wait_for_processto_die(Ref, Pid, File) -> + receive + {'DOWN', Ref, _Type, _Object, _Info} -> + ok + after timer:seconds(30) -> + error_logger:error_msg("~p(~p): Waiting for process ~p to die ~p\n", + [?MODULE, ?LINE, Pid, File]), + wait_for_processto_die(Ref, Pid, File) + end. + +add_missing_mods(AppName, EbinMods, AppModNames) -> + EbinModNames = [M#mod.name || M <- EbinMods], + MissingModNames = AppModNames -- EbinModNames, + [missing_mod(ModName, AppName) || ModName <- MissingModNames]. + +missing_mod(ModName, AppName) -> + %% io:format("Missing: ~p -> ~p\n", [AppName, ModName]), + #mod{name = ModName, + app_name = AppName, + incl_cond = undefined, + is_ebin_mod = false, + exists = false, + status = missing, + uses_mods = []}. + +add_mod_config(Mods, ModConfigs) -> + AddConfig = + fun(Config, Acc) -> + case lists:keysearch(Config#mod.name, #mod.name, Mods) of + {value, M} -> + M2 = M#mod{incl_cond = Config#mod.incl_cond}, + lists:keystore(Config#mod.name, #mod.name, Acc, M2); + false -> + Config2 = Config#mod{uses_mods = [], exists = false}, + [Config2 | Acc] + end + end, + lists:foldl(AddConfig, Mods, ModConfigs). + +set_mod_flags(Mods, AppModNames) -> + SetFlags = + fun(#mod{name = N} = M) -> + M#mod{is_app_mod = lists:member(N, AppModNames)} + end, + lists:map(SetFlags, Mods). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +do_get_config(S, InclDefaults, InclDerivates) -> + S2 = + case InclDerivates of + false -> shrink_sys(S); + true -> S + end, + {ok, reltool_target:gen_config(S2#state.sys, InclDefaults)}. + +do_save_config(S, Filename, InclDefaults, InclDerivates) -> + {ok, Config} = do_get_config(S, InclDefaults, InclDerivates), + IoList = io_lib:format("%% config generated at ~w ~w\n~p.\n\n", + [date(), time(), Config]), + file:write_file(Filename, IoList). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +do_load_config(S, SysConfig) -> + OldSys = S#state.sys, + S2 = shrink_sys(S), + ShrinkedSys = S2#state.sys, + {NewSys, Status} = read_config(ShrinkedSys#sys{apps = []}, SysConfig, {ok, []}), + case Status of + {ok, _Warnings} -> + Force = false, + {MergedSys, Status2} = merge_config(OldSys, NewSys, Force, Status), + {S3, Status3} = analyse(S2#state{sys = MergedSys, old_sys = OldSys}, Status2), + S4 = + case Status3 of + {ok, _Warnings2} -> + S3#state{status = Status3, old_status = S#state.status}; + {error, _} -> + S + end, + {S4, Status3}; + {error, _} -> + %% Keep old state + {S, Status} + end. + +read_config(OldSys, Filename, Status) when is_list(Filename) -> + case file:consult(Filename) of + {ok, [SysConfig | _]} -> + read_config(OldSys, SysConfig, Status); + {ok, Content} -> + Text = lists:flatten(io_lib:format("~p", [Content])), + {OldSys, reltool_utils:return_first_error(Status, "Illegal file content: " ++ Text)}; + {error, Reason} -> + Text = file:format_error(Reason), + {OldSys, reltool_utils:return_first_error(Status, "File access: " ++ Text)} + end; +read_config(OldSys, {sys, KeyVals}, Status) -> + {NewSys, Status2} = + try + decode(OldSys#sys{apps = [], rels = []}, KeyVals, Status) + catch + throw:{error, Text} -> + {OldSys, reltool_utils:return_first_error(Status, Text)} + end, + Apps = [A#app{mods = lists:sort(A#app.mods)} || A <- NewSys#sys.apps], + case NewSys#sys.rels of + [] -> Rels = reltool_utils:default_rels(); + Rels -> ok + end, + NewSys2 = NewSys#sys{apps = lists:sort(Apps), rels = lists:sort(Rels)}, + case lists:keysearch(NewSys2#sys.boot_rel, #rel.name, NewSys2#sys.rels) of + {value, _} -> + {NewSys2, Status2}; + false -> + Text2 = "Missing rel: " ++ NewSys2#sys.boot_rel, + {OldSys, reltool_utils:return_first_error(Status2, Text2)} + end; +read_config(OldSys, BadConfig, Status) -> + Text = lists:flatten(io_lib:format("~p", [BadConfig])), + {OldSys, reltool_utils:return_first_error(Status, "Illegal content: " ++ Text)}. + +decode(#sys{apps = Apps} = Sys, [{erts = Name, AppKeyVals} | SysKeyVals], Status) + when is_atom(Name), is_list(AppKeyVals) -> + App = default_app(Name), + {App2, Status2} = decode(App, AppKeyVals, Status), + decode(Sys#sys{apps = [App2 | Apps]}, SysKeyVals, Status2); +decode(#sys{apps = Apps} = Sys, [{app, Name, AppKeyVals} | SysKeyVals], Status) + when is_atom(Name), is_list(AppKeyVals) -> + App = default_app(Name), + {App2, Status2} = decode(App, AppKeyVals, Status), + decode(Sys#sys{apps = [App2 | Apps]}, SysKeyVals, Status2); +decode(#sys{apps = Apps, escripts = Escripts} = Sys, [{escript, File, AppKeyVals} | SysKeyVals], Status) + when is_list(File), is_list(AppKeyVals) -> + {Name, Label} = split_escript_name(File), + App = default_app(Name, File), + App2 = App#app{is_escript = true, + label = Label, + info = missing_app_info(""), + active_dir = File, + sorted_dirs = [File]}, + {App3, Status2} = decode(App2, AppKeyVals, Status), + decode(Sys#sys{apps = [App3 | Apps], escripts = [File | Escripts]}, SysKeyVals, Status2); +decode(#sys{rels = Rels} = Sys, [{rel, Name, Vsn, RelApps} | SysKeyVals], Status) + when is_list(Name), is_list(Vsn), is_list(RelApps) -> + Rel = #rel{name = Name, vsn = Vsn, rel_apps = []}, + {Rel2, Status2} = decode(Rel, RelApps, Status), + decode(Sys#sys{rels = [Rel2 | Rels]}, SysKeyVals, Status2); +decode(#sys{} = Sys, [{Key, Val} | KeyVals], Status) -> + {Sys3, Status3} = + case Key of + root_dir when is_list(Val) -> + {Sys#sys{root_dir = Val}, Status}; + lib_dirs when is_list(Val) -> + {Sys#sys{lib_dirs = Val}, Status}; + mod_cond when Val =:= all; Val =:= app; + Val =:= ebin; Val =:= derived; + Val =:= none -> + {Sys#sys{mod_cond = Val}, Status}; + incl_cond when Val =:= include; Val =:= exclude; + Val =:= derived -> + {Sys#sys{incl_cond = Val}, Status}; + boot_rel when is_list(Val) -> + {Sys#sys{boot_rel = Val}, Status}; + emu_name when is_list(Val) -> + {Sys#sys{emu_name = Val}, Status}; + profile when Val =:= development -> + Val = ?DEFAULT_PROFILE, % assert, + {Sys#sys{profile = Val, + incl_sys_filters = reltool_utils:decode_regexps(incl_sys_filters, + ?DEFAULT_INCL_SYS_FILTERS, + Sys#sys.incl_sys_filters), + excl_sys_filters = reltool_utils:decode_regexps(excl_sys_filters, + ?DEFAULT_EXCL_SYS_FILTERS, + Sys#sys.excl_sys_filters), + incl_app_filters = reltool_utils:decode_regexps(incl_app_filters, + ?DEFAULT_INCL_APP_FILTERS, + Sys#sys.incl_app_filters), + excl_app_filters = reltool_utils:decode_regexps(excl_app_filters, + ?DEFAULT_EXCL_APP_FILTERS, + Sys#sys.excl_app_filters)}, + Status}; + profile when Val =:= embedded -> + {Sys#sys{profile = Val, + incl_sys_filters = reltool_utils:decode_regexps(incl_sys_filters, + ?EMBEDDED_INCL_SYS_FILTERS, + Sys#sys.incl_sys_filters), + excl_sys_filters = reltool_utils:decode_regexps(excl_sys_filters, + ?EMBEDDED_EXCL_SYS_FILTERS, + Sys#sys.excl_sys_filters), + incl_app_filters = reltool_utils:decode_regexps(incl_app_filters, + ?EMBEDDED_INCL_APP_FILTERS, + Sys#sys.incl_app_filters), + excl_app_filters = reltool_utils:decode_regexps(excl_app_filters, + ?EMBEDDED_EXCL_APP_FILTERS, + Sys#sys.excl_app_filters)}, + Status}; + profile when Val =:= standalone -> + {Sys#sys{profile = Val, + incl_sys_filters = reltool_utils:decode_regexps(incl_sys_filters, + ?STANDALONE_INCL_SYS_FILTERS, + Sys#sys.incl_sys_filters), + excl_sys_filters = reltool_utils:decode_regexps(excl_sys_filters, + ?STANDALONE_EXCL_SYS_FILTERS, + Sys#sys.excl_sys_filters), + incl_app_filters = reltool_utils:decode_regexps(incl_app_filters, + ?STANDALONE_INCL_APP_FILTERS, + Sys#sys.incl_app_filters), + excl_app_filters = reltool_utils:decode_regexps(excl_app_filters, + ?STANDALONE_EXCL_APP_FILTERS, + Sys#sys.excl_app_filters)}, + Status}; + incl_sys_filters -> + {Sys#sys{incl_sys_filters = reltool_utils:decode_regexps(Key, Val, Sys#sys.incl_sys_filters)}, Status}; + excl_sys_filters -> + {Sys#sys{excl_sys_filters = reltool_utils:decode_regexps(Key, Val, Sys#sys.excl_sys_filters)}, Status}; + incl_app_filters -> + {Sys#sys{incl_app_filters = reltool_utils:decode_regexps(Key, Val, Sys#sys.incl_app_filters)}, Status}; + excl_app_filters -> + {Sys#sys{excl_app_filters = reltool_utils:decode_regexps(Key, Val, Sys#sys.excl_app_filters)}, Status}; + incl_archive_filters -> + {Sys#sys{incl_archive_filters = reltool_utils:decode_regexps(Key, Val, Sys#sys.incl_archive_filters)}, Status}; + excl_archive_filters -> + {Sys#sys{excl_archive_filters = reltool_utils:decode_regexps(Key, Val, Sys#sys.excl_archive_filters)}, Status}; + archive_opts when is_list(Val) -> + {Sys#sys{archive_opts = Val}, Status}; + relocatable when Val =:= true; Val =:= false -> + {Sys#sys{relocatable = Val}, Status}; + app_type when Val =:= permanent; Val =:= transient; Val =:= temporary; + Val =:= load; Val =:= none -> + {Sys#sys{app_type = Val}, Status}; + app_file when Val =:= keep; Val =:= strip, Val =:= all -> + {Sys#sys{app_file = Val}, Status}; + debug_info when Val =:= keep; Val =:= strip -> + {Sys#sys{debug_info = Val}, Status}; + _ -> + Text = lists:flatten(io_lib:format("~p", [{Key, Val}])), + {Sys, reltool_utils:return_first_error(Status, "Illegal option: " ++ Text)} + end, + decode(Sys3, KeyVals, Status3); +decode(#app{} = App, [{Key, Val} | KeyVals], Status) -> + {App2, Status2} = + case Key of + mod_cond when Val =:= all; Val =:= app; Val =:= ebin; Val =:= derived; Val =:= none -> + {App#app{mod_cond = Val}, Status}; + incl_cond when Val =:= include; Val =:= exclude; Val =:= derived -> + {App#app{incl_cond = Val}, Status}; + + debug_info when Val =:= keep; Val =:= strip -> + {App#app{debug_info = Val}, Status}; + app_file when Val =:= keep; Val =:= strip, Val =:= all -> + {App#app{app_file = Val}, Status}; + app_type when Val =:= permanent; Val =:= transient; Val =:= temporary; + Val =:= load; Val =:= none -> + {App#app{app_type = Val}, Status}; + incl_app_filters -> + {App#app{incl_app_filters = reltool_utils:decode_regexps(Key, Val, App#app.incl_app_filters)}, Status}; + excl_app_filters -> + {App#app{excl_app_filters = reltool_utils:decode_regexps(Key, Val, App#app.excl_app_filters)}, Status}; + incl_archive_filters -> + {App#app{incl_archive_filters = reltool_utils:decode_regexps(Key, Val, App#app.incl_archive_filters)}, Status}; + excl_archive_filters -> + {App#app{excl_archive_filters = reltool_utils:decode_regexps(Key, Val, App#app.excl_archive_filters)}, Status}; + archive_opts when is_list(Val) -> + {App#app{archive_opts = Val}, Status}; + vsn when is_list(Val) -> + {App#app{use_selected_vsn = true, vsn = Val}, Status}; + _ -> + Text = lists:flatten(io_lib:format("~p", [{Key, Val}])), + {App, reltool_utils:return_first_error(Status, "Illegal option: " ++ Text)} + end, + decode(App2, KeyVals, Status2); +decode(#app{mods = Mods} = App, [{mod, Name, ModKeyVals} | AppKeyVals], Status) -> + {Mod, Status2} = decode(#mod{name = Name}, ModKeyVals, Status), + decode(App#app{mods = [Mod | Mods]}, AppKeyVals, Status2); +decode(#mod{} = Mod, [{Key, Val} | KeyVals], Status) -> + {Mod2, Status2} = + case Key of + incl_cond when Val =:= include; Val =:= exclude; Val =:= derived -> + {Mod#mod{incl_cond = Val}, Status}; + debug_info when Val =:= keep; Val =:= strip -> + {Mod#mod{debug_info = Val}, Status}; + _ -> + Text = lists:flatten(io_lib:format("~p", [{Key, Val}])), + {Mod, reltool_utils:return_first_error(Status, "Illegal option: " ++ Text)} + end, + decode(Mod2, KeyVals, Status2); +decode(#rel{rel_apps = RelApps} = Rel, [RelApp | KeyVals], Status) -> + RA = + case RelApp of + Name when is_atom(Name) -> + #rel_app{name = Name, app_type = undefined, incl_apps = []}; + {Name, Type} when is_atom(Name) -> + #rel_app{name = Name, app_type = Type, incl_apps = []}; + {Name, InclApps} when is_atom(Name), is_list(InclApps) -> + #rel_app{name = Name, app_type = undefined, incl_apps = InclApps}; + {Name, Type, InclApps} when is_atom(Name), is_list(InclApps) -> + #rel_app{name = Name, app_type = Type, incl_apps = InclApps}; + _ -> + #rel_app{incl_apps = []} + end, + IsType = is_type(RA#rel_app.app_type), + NonAtoms = [IA || IA <- RA#rel_app.incl_apps, not is_atom(IA)], + if + IsType, NonAtoms =:= [] -> + decode(Rel#rel{rel_apps = RelApps ++ [RA]}, KeyVals, Status); + true -> + Text = lists:flatten(io_lib:format("~p", [RelApp])), + Status2 = reltool_utils:return_first_error(Status, "Illegal option: " ++ Text), + decode(Rel, KeyVals, Status2) + end; +decode(Acc, [], Status) -> + {Acc, Status}; +decode(Acc, KeyVal, Status) -> + Text = lists:flatten(io_lib:format("~p", [KeyVal])), + {Acc, reltool_utils:return_first_error(Status, "Illegal option: " ++ Text)}. + +is_type(Type) -> + case Type of + undefined -> true; + permanent -> true; + transient -> true; + temporary -> true; + load -> true; + none -> true; + _ -> false + end. + +split_escript_name(File) when is_list(File) -> + Label = filename:basename(File, ".escript"), + {list_to_atom("*escript* " ++ Label), Label}. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +refresh(#state{sys = Sys} = S, Force, Status) -> + {Sys2, Status2} = merge_config(Sys, Sys#sys{apps = []}, Force, Status), + {S#state{sys = Sys2}, Status2}. + +merge_config(OldSys, NewSys, Force, Status) -> + RootDir = filename:absname(NewSys#sys.root_dir), + LibDirs = [filename:absname(D) || D <- NewSys#sys.lib_dirs], + Escripts = [filename:absname(E) || E <- NewSys#sys.escripts], + {SourceDirs, Status2} = + libs_to_dirs(RootDir, LibDirs, Status), + MergedApps = merge_app_dirs(SourceDirs, NewSys#sys.apps, OldSys#sys.apps), + {AllApps, Status3} = + escripts_to_apps(Escripts, MergedApps, OldSys#sys.apps, Status2), + {RefreshedApps, Status4} = + refresh_apps(OldSys#sys.apps, AllApps, [], Force, Status3), + {PatchedApps, Status5} = patch_erts_version(RootDir, RefreshedApps, Status4), + Escripts2 = [A#app.active_dir || A <- PatchedApps, A#app.is_escript], + NewSys2 = NewSys#sys{root_dir = RootDir, + lib_dirs = LibDirs, + escripts = Escripts2, + apps = PatchedApps}, + {NewSys2, Status5}. + +verify_config(Sys, Status) -> + case lists:keymember(Sys#sys.boot_rel, #rel.name, Sys#sys.rels) of + true -> + lists:foreach(fun(Rel)-> check_rel(Rel, Sys, Status) end, Sys#sys.rels), + Status; + false -> + Text = lists:concat([Sys#sys.boot_rel, ": release is mandatory"]), + Status2 = reltool_utils:return_first_error(Status, Text), + throw({error, Status2}) + end. + +check_rel(#rel{name = RelName, rel_apps = RelApps}, #sys{apps = Apps}, Status) -> + EnsureApp = + fun(AppName) -> + case lists:keymember(AppName, #rel_app.name, RelApps) of + true -> + ok; + false -> + Text = lists:concat([RelName, ": ", AppName, " is not included."]), + Status2 = reltool_utils:return_first_error(Status, Text), + throw({error, Status2}) + end + end, + EnsureApp(kernel), + EnsureApp(stdlib), + CheckRelApp = + fun(#rel_app{name = AppName}) -> + case lists:keysearch(AppName, #app.name, Apps) of + {value, App} when App#app.is_pre_included -> + ok; + {value, App} when App#app.is_included -> + ok; + _ -> + Text = lists:concat([RelName, ": uses application ", + AppName, " that not is included."]), + Status2 = reltool_utils:return_first_error(Status, Text), + %% throw BUGBUG: add throw + ({error, Status2}) + end + end, + lists:foreach(CheckRelApp, RelApps). + +patch_erts_version(RootDir, Apps, Status) -> + AppName = erts, + case lists:keysearch(AppName, #app.name, Apps) of + {value, Erts} -> + LocalRoot = code:root_dir(), + Vsn = Erts#app.vsn, + if + LocalRoot =:= RootDir, Vsn =:= "" -> + Vsn2 = erlang:system_info(version), + Erts2 = Erts#app{vsn = Vsn2, label = "erts-" ++ Vsn2}, + Apps2 = lists:keystore(AppName, #app.name, Apps, Erts2), + {Apps2, Status}; + Vsn =:= "" -> + {Apps, reltool_utils:add_warning(Status, "erts has no version")}; + true -> + {Apps, Status} + end; + false -> + Text = "erts cannnot be found in the root directory " ++ RootDir, + Status2 = reltool_utils:return_first_error(Status, Text), + {Apps, Status2} + end. + +libs_to_dirs(RootDir, LibDirs, Status) -> + case file:list_dir(RootDir) of + {ok, RootFiles} -> + RootLibDir = filename:join([RootDir, "lib"]), + AllLibDirs = [RootLibDir | LibDirs], + case AllLibDirs -- lists:usort(AllLibDirs) of + [] -> + Fun = fun(Base) -> + AppDir = filename:join([RootLibDir, Base]), + case filelib:is_dir(filename:join([AppDir, "ebin"]), erl_prim_loader) of + true -> + AppDir; + false -> + filename:join([RootDir, Base, "preloaded"]) + end + end, + ErtsFiles = [{erts, Fun(F)} || F <- RootFiles, lists:prefix("erts", F)], + app_dirs2(AllLibDirs, [ErtsFiles], Status); + [Duplicate | _] -> + {[], reltool_utils:return_first_error(Status, "Duplicate library: " ++ Duplicate)} + end; + {error, Reason} -> + Text = file:format_error(Reason), + {[], reltool_utils:return_first_error(Status, "Missing root library " ++ RootDir ++ ": " ++ Text)} + end. + +app_dirs2([Lib | Libs], Acc, Status) -> + case file:list_dir(Lib) of + {ok, Files} -> + Filter = + fun(Base) -> + AppDir = filename:join([Lib, Base]), + EbinDir = filename:join([AppDir, "ebin"]), + case filelib:is_dir(EbinDir, erl_prim_loader) of + true -> + {Name, _Vsn} = reltool_utils:split_app_name(Base), + case Name of + erts -> false; + _ -> {true, {Name, AppDir}} + end; + false -> + false + end + end, + Files2 = lists:zf(Filter, Files), + app_dirs2(Libs, [Files2 | Acc], Status); + {error, Reason} -> + Text = file:format_error(Reason), + {[], reltool_utils:return_first_error(Status, "Illegal library " ++ Lib ++ ": " ++ Text)} + end; +app_dirs2([], Acc, Status) -> + {lists:sort(lists:append(Acc)), Status}. + +escripts_to_apps([Escript | Escripts], Apps, OldApps, Status) -> + {EscriptAppName, _Label} = split_escript_name(Escript), + Ext = code:objfile_extension(), + Fun = fun(FullName, _GetInfo, GetBin, {FileAcc, StatusAcc}) -> + Components = filename:split(FullName), + case Components of + [AppLabel, "ebin", File] -> + case filename:extension(File) of + ".app" -> + {AppName, DefaultVsn} = reltool_utils:split_app_name(AppLabel), + AppFileName = filename:join([Escript, FullName]), + {Info, StatusAcc2} = + read_app_info(GetBin(), AppFileName, AppName, DefaultVsn, Status), + Dir = filename:join([Escript, AppName]), + {[{AppName, app, Dir, Info} | FileAcc], StatusAcc2}; + E when E =:= Ext -> + {AppName, _} = reltool_utils:split_app_name(AppLabel), + Mod = init_mod(AppName, File, {File, GetBin()}, Ext), + Dir = filename:join([Escript, AppName]), + {[{AppName, mod, Dir, Mod} | FileAcc], StatusAcc}; + _ -> + {FileAcc, StatusAcc} + end; + ["."] -> + Bin = GetBin(), + {ok, {ModName, _}} = beam_lib:version(Bin), + ModStr = atom_to_list(ModName) ++ Ext, + Mod = init_mod(EscriptAppName, ModStr, {ModStr, GetBin()}, Ext), + {[{EscriptAppName, mod, Escript, Mod} | FileAcc], StatusAcc}; + [File] -> + case filename:extension(File) of + E when E =:= Ext -> + Mod = init_mod(EscriptAppName, File, {File, GetBin()}, Ext), + {[{EscriptAppName, mod, File, Mod} | FileAcc], StatusAcc}; + _ -> + {FileAcc, StatusAcc} + end; + _ -> + {FileAcc, StatusAcc} + end + end, + try + case escript:foldl(Fun, {[], Status}, Escript) of + {ok, {Files, Status2}} -> + {Apps2, Status3} = files_to_apps(Escript, lists:sort(Files), Apps, Apps, OldApps, Status2), + escripts_to_apps(Escripts, Apps2, OldApps, Status3); + {error, Reason} -> + Text = lists:flatten(io_lib:format("~p", [Reason])), + {[], reltool_utils:return_first_error(Status, "Illegal escript " ++ Escript ++ ": " ++ Text)} + end + catch + throw:Reason2 when is_list(Reason2) -> + {[], reltool_utils:return_first_error(Status, "Illegal escript " ++ Escript ++ ": " ++ Reason2)} + end; +escripts_to_apps([], Apps, _OldApps, Status) -> + {Apps, Status}. + +%% Assume that all files for an app are in consecutive order +%% Assume the app info is before the mods +files_to_apps(Escript, [{AppName, Type, Dir, ModOrInfo} | Files] = AllFiles, Acc, Apps, OldApps, Status) -> + case Type of + mod -> + case Acc of + [] -> + Info = missing_app_info(""), + {NewApp, Status2} = merge_escript_app(AppName, Dir, Info, [ModOrInfo], Apps, OldApps, Status), + files_to_apps(Escript, AllFiles, [NewApp | Acc], Apps, OldApps, Status2); + [App | Acc2] when App#app.name =:= ModOrInfo#mod.app_name -> + App2 = App#app{mods = [ModOrInfo | App#app.mods]}, + files_to_apps(Escript, Files, [App2 | Acc2], Apps, OldApps, Status); + [App | Acc2] -> + PrevApp = App#app{mods = lists:keysort(#mod.name, App#app.mods)}, + Info = missing_app_info(""), + {NewApp, Status2} = merge_escript_app(AppName, Dir, Info, [ModOrInfo], Apps, OldApps, Status), + files_to_apps(Escript, Files, [NewApp, PrevApp | Acc2], Apps, OldApps, Status2) + end; + app -> + {App, Status2} = merge_escript_app(AppName, Dir, ModOrInfo, [], Apps, OldApps, Status), + files_to_apps(Escript, Files, [App | Acc], Apps, OldApps, Status2) + end; +files_to_apps(_Escript, [], Acc, _Apps, _OldApps, Status) -> + {lists:keysort(#app.name, Acc), Status}. + +merge_escript_app(AppName, Dir, Info, Mods, Apps, OldApps, Status) -> + case lists:keysearch(AppName, #app.name, OldApps) of + {value, App} -> + ok; + false -> + App = default_app(AppName, Dir) + end, + App2 = App#app{is_escript = true, + label = filename:basename(Dir, ".escript"), + info = Info, + mods = Mods, + active_dir = Dir, + sorted_dirs = [Dir]}, + case lists:keysearch(AppName, #app.name, Apps) of + {value, _} -> + Error = lists:concat([AppName, ": Application name clash. ", + "Escript ", Dir," contains application ", AppName, "."]), + {App2, reltool_utils:return_first_error(Status, Error)}; + false -> + {App2, Status} + end. + +merge_app_dirs([{Name, Dir} | Rest], [App | Apps], OldApps) + when App#app.name =:= Name -> + %% Add new dir to app + App2 = App#app{sorted_dirs = [Dir | App#app.sorted_dirs]}, + merge_app_dirs(Rest, [App2 | Apps], OldApps); +merge_app_dirs([{Name, Dir} | Rest], Apps, OldApps) -> + %% Initate app + Apps2 = sort_app_dirs(Apps), + Apps4 = + case lists:keysearch(Name, #app.name, Apps) of + false -> + case lists:keysearch(Name, #app.name, OldApps) of + {value, OldApp} when OldApp#app.active_dir =:= Dir -> + [OldApp | Apps2]; + {value, OldApp} -> + App = + case filter_app(OldApp) of + {true, NewApp} -> + NewApp#app{active_dir = Dir, sorted_dirs = [Dir]}; + false -> + default_app(Name, Dir) + end, + [App | Apps2]; + false -> + App = default_app(Name, Dir), + [App | Apps2] + end; + {value, OldApp} -> + Apps3 = lists:keydelete(Name, #app.name, Apps2), + App = OldApp#app{sorted_dirs = [Dir | OldApp#app.sorted_dirs]}, + [App | Apps3] + end, + merge_app_dirs(Rest, Apps4, OldApps); +merge_app_dirs([], Apps, _OldApps) -> + Apps2 = sort_app_dirs(Apps), + lists:reverse(Apps2). + +sort_app_dirs([#app{sorted_dirs = Dirs} = App | Acc]) -> + SortedDirs = lists:sort(fun reltool_utils:app_dir_test/2, Dirs), + case SortedDirs of + [ActiveDir | _] -> ok; + [] -> ActiveDir = undefined + end, + [App#app{active_dir = ActiveDir, sorted_dirs = SortedDirs} | Acc]; +sort_app_dirs([]) -> + []. + +default_app(Name, Dir) -> + App = default_app(Name), + App#app{active_dir = Dir, + sorted_dirs = [Dir]}. + +default_app(Name) -> + #app{name = Name, + is_escript = false, + use_selected_vsn = undefined, + active_dir = undefined, + sorted_dirs = [], + vsn = undefined, + label = undefined, + info = undefined, + mods = [], + + mod_cond = undefined, + incl_cond = undefined, + + status = missing, + uses_mods = undefined, + is_pre_included = undefined, + is_included = undefined}. + +%% Assume that the application are sorted +refresh_apps([Old | OldApps], [New | NewApps], Acc, Force, Status) when New#app.name =:= Old#app.name -> + {Info, ActiveDir, Status2} = ensure_app_info(New, Status), + OptLabel = + case Info#app_info.vsn =:= New#app.vsn of + true -> New#app.label; + false -> undefined % Cause refresh + end, + {Refreshed, Status3} = + refresh_app(New#app{label = OptLabel, + active_dir = ActiveDir, + vsn = Info#app_info.vsn, + info = Info}, + Force, + Status2), + refresh_apps(OldApps, NewApps, [Refreshed | Acc], Force, Status3); +refresh_apps([Old | OldApps], [New | NewApps], Acc, Force, Status) when New#app.name < Old#app.name -> + %% No old app version exists. Use new as is. + %% BUGBUG: Issue warning if the active_dir is not defined + {New2, Status2} = refresh_app(New, Force, Status), + refresh_apps([Old | OldApps], NewApps, [New2 | Acc], Force, Status2); +refresh_apps([Old | OldApps], [New | NewApps], Acc, Force, Status) when New#app.name > Old#app.name -> + %% No new version. Remove the old. + Status2 = + case Old#app.name =:= ?MISSING_APP of + true -> + Status; + false -> + Warning = lists:concat([Old#app.name, ": The source dirs does not contain the application anymore."]), + reltool_utils:add_warning(Status, Warning) + end, + refresh_apps(OldApps, [New | NewApps], Acc, Force, Status2); +refresh_apps([], [New | NewApps], Acc, Force, Status) -> + %% No old app version exists. Use new as is. + {New2, Status2} = refresh_app(New, Force, Status), + refresh_apps([], NewApps, [New2 | Acc], Force, Status2); +refresh_apps([Old | OldApps], [], Acc, Force, Status) -> + %% No new version. Remove the old. + Status2 = + case Old#app.name =:= ?MISSING_APP of + true -> + Status; + false -> + Warning = lists:concat([Old#app.name, ": The source dirs ", + "does not contain the application anymore."]), + reltool_utils:add_warning(Status, Warning) + end, + refresh_apps(OldApps, [], Acc, Force, Status2); +refresh_apps([], [], Acc, _Force, Status) -> + {lists:reverse(Acc), Status}. + +ensure_app_info(#app{is_escript = true, active_dir = Dir, info = Info}, Status) -> + {Info, Dir, Status}; +ensure_app_info(#app{name = Name, sorted_dirs = []}, Status) -> + Error = lists:concat([Name, ": Missing application directory."]), + Status2 = reltool_utils:return_first_error(Status, Error), + {missing_app_info(""), undefined, Status2}; +ensure_app_info(#app{name = Name, vsn = Vsn, sorted_dirs = Dirs, info = undefined}, Status) -> + ReadInfo = + fun(Dir, StatusAcc) -> + Base = get_base(Name, Dir), + Ebin = filename:join([Dir, "ebin"]), + {_, DefaultVsn} = reltool_utils:split_app_name(Base), + AppFile = filename:join([Ebin, atom_to_list(Name) ++ ".app"]), + read_app_info(AppFile, AppFile, Name, DefaultVsn, StatusAcc) + end, + {AllInfo, Status2} = lists:mapfoldl(ReadInfo, Status, Dirs), + AllVsns = [I#app_info.vsn || I <- AllInfo], + Status3 = + case AllVsns -- lists:usort(AllVsns) of + [] -> + %% No redundant info + Status2; + [BadVsn | _] -> + Error2 = lists:concat([Name, ": Application version clash. ", + "Multiple directories contains version \"", BadVsn, "\"."]), + reltool_utils:return_first_error(Status2, Error2) + end, + FirstInfo = hd(AllInfo), + FirstDir = hd(Dirs), + if + Vsn =:= undefined -> + {FirstInfo, FirstDir, Status3}; + Vsn =:= FirstInfo#app_info.vsn -> + {FirstInfo, FirstDir, Status3}; + true -> + case find_vsn(Vsn, AllInfo, Dirs) of + {Info, VsnDir} -> + {Info, VsnDir, Status3}; + false -> + Error3 = lists:concat([Name, ": No application directory contains selected version \"", Vsn, "\"."]), + Status4 = reltool_utils:return_first_error(Status3, Error3), + {FirstInfo, FirstDir, Status4} + end + end; +ensure_app_info(#app{active_dir = Dir, info = Info}, Status) -> + {Info, Dir, Status}. + +find_vsn(Vsn, [#app_info{vsn = Vsn} = Info | _], [Dir | _]) -> + {Info, Dir}; +find_vsn(Vsn, [_ | MoreInfo], [_ | MoreDirs]) -> + find_vsn(Vsn, MoreInfo, MoreDirs); +find_vsn(_, [], []) -> + false. + +get_base(Name, Dir) -> + case Name of + erts -> + case filename:basename(Dir) of + "preloaded" -> + filename:basename(filename:dirname(Dir)); + TmpBase -> + TmpBase + end; + _ -> + filename:basename(Dir) + end. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% sys callbacks + +system_continue(_Parent, _Debug, S) -> + ?MODULE:loop(S). + +system_terminate(Reason, _Parent, _Debug, _S) -> + exit(Reason). + +system_code_change(S,_Module,_OldVsn,_Extra) -> + {ok, S}. diff --git a/lib/reltool/src/reltool_sys_win.erl b/lib/reltool/src/reltool_sys_win.erl new file mode 100644 index 0000000000..ea80ab7e85 --- /dev/null +++ b/lib/reltool/src/reltool_sys_win.erl @@ -0,0 +1,1292 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 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(reltool_sys_win). + +%% Public +-export([start_link/1, get_server/1, set_app/2, open_app/2]). + +%% Internal +-export([init/1, loop/1]). + +%% sys callback functions +-export([ + system_continue/3, + system_terminate/4, + system_code_change/4 + ]). + +-include_lib("wx/include/wx.hrl"). +-include("reltool.hrl"). + +-record(state, + {parent_pid, + server_pid, + app_wins, + sys, + common, + config_file, + target_dir, + boot_dir, + frame, + panel, + book, + rel_book, + lib_tree, + status_bar, + popup_menu, + source, + whitelist, + blacklist, + derived, + fgraph_wins + }). + +-define(WIN_WIDTH, 800). +-define(WIN_HEIGHT, 600). + +-define(CLOSE_ITEM, ?wxID_EXIT). %% Use OS specific version if available +-define(ABOUT_ITEM, ?wxID_ABOUT). %% Use OS specific +-define(CONTENTS_ITEM, 300). +-define(APP_GRAPH_ITEM, 301). +-define(MOD_GRAPH_ITEM, 302). +-define(LOAD_CONFIG_ITEM, 303). +-define(SAVE_CONFIG_NODEF_NODER_ITEM, 304). +-define(SAVE_CONFIG_NODEF_DER_ITEM, 305). +-define(SAVE_CONFIG_DEF_NODER_ITEM, 306). +-define(SAVE_CONFIG_DEF_DER_ITEM, 307). +-define(UNDO_CONFIG_ITEM, 308). +-define(RESET_CONFIG_ITEM, 309). +-define(GEN_REL_FILES_ITEM, 310). +-define(GEN_TARGET_ITEM, 311). + +-define(APP_PAGE, "Applications"). +-define(LIB_PAGE, "Libraries"). +-define(SYS_PAGE, "System settings"). +-define(REL_PAGE, "Releases"). + +-define(APPS_APP_COL, 0). +-define(source, "Available"). +-define(whitelist, "Included"). +-define(blacklist, "Excluded"). +-define(derived, "Derived"). + +-record(root_data, {dir}). +-record(lib_data, {dir, tree, item}). +-record(escript_data, {file, tree, item}). +-record(app_data, {name, dir}). +-record(app_win, {name, pid}). +-record(fgraph_win, {frame, pid}). +-record(root_popup, {dir, choices, tree, item}). +-record(lib_popup, {dir, choices, tree, item}). +-record(escript_popup, {file, choices, tree, item}). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% Client + +start_link(Opts) -> + proc_lib:start_link(?MODULE, init, [[{parent, self()} | Opts]], infinity, []). + +get_server(Pid) -> + reltool_utils:call(Pid, get_server). + +set_app(Pid, App) -> + reltool_utils:call(Pid, {set_app, App}). + +open_app(Pid, AppName) -> + reltool_utils:call(Pid, {open_app, AppName}). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% Server + +init(Options) -> + try + do_init(Options) + catch + error:Reason -> + exit({Reason, erlang:get_stacktrace()}) + end. + +do_init([{parent, Parent} | Options]) -> + case reltool_server:start_link(Options) of + {ok, ServerPid, C, Sys} -> + process_flag(trap_exit, C#common.trap_exit), + S = #state{parent_pid = Parent, + server_pid = ServerPid, + common = C, + config_file = filename:absname("config.reltool"), + target_dir = filename:absname("reltool_target_dir"), + app_wins = [], + sys = Sys, + fgraph_wins = []}, + wx:new(), + wx:debug(C#common.wx_debug), + S2 = create_window(S), + + %% wx_misc:beginBusyCursor(), + case reltool_server:get_status(ServerPid) of + {ok, Warnings} -> + exit_dialog(Warnings), + {ok, Sys2} = reltool_server:get_sys(ServerPid), + S3 = S2#state{sys = Sys2}, + S5 = wx:batch(fun() -> + Title = atom_to_list(?APPLICATION), + wxFrame:setTitle(S3#state.frame, Title), + %% wxFrame:setMinSize(Frame, {?WIN_WIDTH, ?WIN_HEIGHT}), + wxStatusBar:setStatusText(S3#state.status_bar, "Done."), + S4 = redraw_apps(S3), + redraw_libs(S4) + end), + %% wx_misc:endBusyCursor(), + %% wxFrame:destroy(Frame), + proc_lib:init_ack(S#state.parent_pid, {ok, self()}), + loop(S5); + {error, Reason} -> + io:format("~p(~p): <ERROR> ~p\n", [?MODULE, ?LINE, Reason]), + exit(Reason) + end; + {error, Reason} -> + io:format("~p(~p): <ERROR> ~p\n", [?MODULE, ?LINE, Reason]), + exit(Reason) + end. + +exit_dialog([]) -> + ok; +exit_dialog(Warnings) -> + Question = "Do you want to continue despite these warnings?", + Details = lists:flatten([[W, $\n] || W <- Warnings]), + case question_dialog(Question, Details) of + ?wxID_OK -> + ok; + ?wxID_CANCEL -> + io:format("~p(~p): <ERROR> ~s\n", [?MODULE, ?LINE, Details]), + exit(Details) + end. + +loop(S) -> + receive + {system, From, Msg} -> + Common = S#state.common, + sys:handle_system_msg(Msg, From, S#state.parent_pid, ?MODULE, Common#common.sys_debug, S); + #wx{obj = ObjRef, + event = #wxClose{type = close_window}} = Msg -> + if + ObjRef =:= S#state.frame -> + wxFrame:destroy(ObjRef), + exit(shutdown); + true -> + FWs = S#state.fgraph_wins, + case lists:keysearch(ObjRef, #fgraph_win.frame, FWs) of + {value, FW} -> + reltool_fgraph_win:stop(FW#fgraph_win.pid, shutdown), + wxFrame:destroy(ObjRef), + FWs2 = lists:keydelete(ObjRef, #fgraph_win.frame, FWs), + ?MODULE:loop(S#state{fgraph_wins = FWs2}); + false -> + error_logger:format("~p~p got unexpected message:\n\t~p\n", + [?MODULE, self(), Msg]), + ?MODULE:loop(S) + end + end; + #wx{id = ?CLOSE_ITEM, event = #wxCommand{type = command_menu_selected}, userData = main_window} -> + wxFrame:destroy(S#state.frame), + exit(shutdown); + #wx{event = #wxSize{}} = Wx -> + Wx2 = reltool_utils:get_latest_resize(Wx), + S2 = handle_event(S, Wx2), + ?MODULE:loop(S2); + #wx{} = Wx -> + S2 = handle_event(S, Wx), + ?MODULE:loop(S2); + {call, ReplyTo, Ref, get_server} -> + reltool_utils:reply(ReplyTo, Ref, {ok, S#state.server_pid}), + ?MODULE:loop(S); + {call, ReplyTo, Ref, {set_app, NewApp}} -> + {ok, AnalysedApp, S2} = do_set_app(S, NewApp), + reltool_utils:reply(ReplyTo, Ref, {ok, AnalysedApp}), + ?MODULE:loop(S2); + {call, ReplyTo, Ref, {open_app, AppName}} -> + S2 = do_open_app(S, AppName), + {value, #app_win{pid = AppPid}} = lists:keysearch(AppName, #app_win.name, S2#state.app_wins), + reltool_utils:reply(ReplyTo, Ref, {ok, AppPid}), + ?MODULE:loop(S2); + {'EXIT', Pid, Reason} when Pid =:= S#state.parent_pid -> + [reltool_fgraph_win:stop(FW#fgraph_win.pid, Reason) || FW <- S#state.fgraph_wins], + exit(Reason); + {'EXIT', _Pid, _Reason} = Exit -> + {FWs, AWs} = handle_child_exit(Exit, S#state.fgraph_wins, S#state.app_wins), + ?MODULE:loop(S#state{fgraph_wins = FWs, app_wins = AWs}); + Msg -> + error_logger:format("~p~p got unexpected message:\n\t~p\n", + [?MODULE, self(), Msg]), + ?MODULE:loop(S) + end. + +handle_child_exit({'EXIT', Pid, _Reason} = Exit, FWs, AWs) -> + case lists:keymember(Pid, #fgraph_win.pid, FWs) of + true -> + msg_warning(Exit, forcegraph_window), + {lists:keydelete(Pid, #fgraph_win.pid, FWs), AWs}; + false -> + case lists:keymember(Pid, #app_win.pid, AWs) of + true -> + msg_warning(Exit, application_window), + {FWs, lists:keydelete(Pid, #app_win.pid, AWs)}; + false -> + msg_warning(Exit, unknown), + {FWs, AWs} + end + end. + +msg_warning({'EXIT', _Pid, shutdown}, Type) when Type =/= unknown -> + ok; +msg_warning(Exit, Type) -> + error_logger:format("~p~p got unexpected message (~p):\n\t~p\n", + [?MODULE, self(), Type, Exit]). + +create_window(S) -> + Title = lists:concat([?APPLICATION, " - starting up"]), + Frame = wxFrame:new(wx:null(), ?wxID_ANY, Title, [{size, {?WIN_WIDTH, ?WIN_HEIGHT}}]), + %%wxFrame:setSize(Frame, {?WIN_WIDTH, ?WIN_HEIGHT}), + %% wxFrame:setMinSize(Frame, {?WIN_WIDTH, ?WIN_HEIGHT}), + Bar = wxFrame:createStatusBar(Frame,[]), + wxStatusBar:setStatusText(Bar, "Processing libraries..."), + %% Label = wxStaticText:new(Panel, ?wxID_ANY, Text, [{style, ?wxTE_READONLY}]), + %% Sizer = wxBoxSizer:new(?wxVERTICAL), + %% wxSizer:add(Sizer, Label, [{flag, ?wxEXPAND}, {proportion, 1}]), + %% wxPanel:setSizer(Panel, Sizer), + %% wxSizer:fit(Sizer, Frame), + %% wxSizer:setSizeHints(Sizer, Frame), + + %% Frame = wxFrame:new(wx:null(), ?wxID_ANY, Title, []), + %% Frame = S#state.frame, + wxToolTip:setDelay(3000), + Panel = wxPanel:new(Frame, []), + %% Bar = wxFrame:createStatusBar(Frame,[]), + create_menubar(Frame), + + Book = wxNotebook:new(Panel, ?wxID_ANY, []), + S2 = S#state{frame = Frame, panel = Panel, book = Book, status_bar = Bar}, + S3 = lists:foldl(fun(Fun, Acc) -> Fun(Acc) end, + S2, + [ + fun create_app_page/1, + fun create_lib_page/1, + fun create_main_release_page/1, + fun create_config_page/1 + ]), + Sizer = wxBoxSizer:new(?wxVERTICAL), + wxSizer:add(Sizer, Book, [{flag, ?wxEXPAND}, {proportion, 1}]), + + wxPanel:setSizer(Panel, Sizer), + wxSizer:fit(Sizer, Frame), + wxSizer:setSizeHints(Sizer, Frame), + wxFrame:connect(Frame, close_window), + + wxFrame:show(Frame), + S3. + +create_menubar(Frame) -> + MenuBar = wxMenuBar:new(), + File = wxMenu:new([]), + Help = wxMenu:new([]), + wxMenuBar:append(MenuBar, File, "File" ), + wxMenu:append(File, ?APP_GRAPH_ITEM, "Display application dependency graph" ), + wxMenu:append(File, ?MOD_GRAPH_ITEM, "Display module dependency graph" ), + wxMenu:appendSeparator(File), + wxMenu:append(File, ?RESET_CONFIG_ITEM, "Reset configuration to default" ), + wxMenu:append(File, ?UNDO_CONFIG_ITEM, "Undo configuration (toggle)" ), + wxMenu:append(File, ?LOAD_CONFIG_ITEM, "Load configuration" ), + Save = wxMenu:new(), + wxMenu:append(Save, ?SAVE_CONFIG_NODEF_NODER_ITEM, "Save explicit configuration (neither defaults nor derivates)"), + wxMenu:append(Save, ?SAVE_CONFIG_DEF_NODER_ITEM , "Save configuration defaults (defaults only)"), + wxMenu:append(Save, ?SAVE_CONFIG_NODEF_DER_ITEM, "Save configuration derivates (derivates only))"), + wxMenu:append(Save, ?SAVE_CONFIG_DEF_DER_ITEM, "Save extended configuration (both defaults and derivates)"), + + wxMenu:append(File, ?wxID_ANY, "Save configuration", Save), + wxMenu:appendSeparator(File), + wxMenu:append(File, ?GEN_REL_FILES_ITEM, "Generate rel, script and boot files" ), + wxMenu:append(File, ?GEN_TARGET_ITEM, "Generate target system" ), + wxMenu:appendSeparator(File), + wxMenu:append(File, ?CLOSE_ITEM, "Close" ), + wxMenuBar:append(MenuBar, Help, "Help" ), + wxMenu:append(Help, ?CONTENTS_ITEM, "Contents" ), + wxMenu:append(Help, ?ABOUT_ITEM, "About" ), + wxFrame:setMenuBar(Frame, MenuBar), + wxEvtHandler:connect(Frame, + command_menu_selected, + [{userData, main_window}]), + wxEvtHandler:connect(File, menu_close), + wxEvtHandler:connect(Help, menu_close), + MenuBar. + +create_app_page(#state{book = Book} = S) -> + Panel = wxPanel:new(Book, []), + Sizer = wxBoxSizer:new(?wxHORIZONTAL), + + SourceCtrl = create_app_list_ctrl(Panel, Sizer, ?source, + whitelist_add, blacklist_add), + wxSizer:add(Sizer, + wxStaticLine:new(Panel, [{style, ?wxLI_VERTICAL}]), + [{border, 2}, {flag, ?wxALL bor ?wxEXPAND}]), + WhiteCtrl = create_app_list_ctrl(Panel, Sizer, ?whitelist, + whitelist_del, blacklist_add), + wxSizer:add(Sizer, + wxStaticLine:new(Panel, [{style, ?wxLI_VERTICAL}]), + [{border, 2}, {flag, ?wxALL bor ?wxEXPAND}]), + BlackCtrl = create_app_list_ctrl(Panel, Sizer, ?blacklist, + whitelist_add, blacklist_del), + wxSizer:add(Sizer, + wxStaticLine:new(Panel, [{style, ?wxLI_VERTICAL}]), + [{border, 2}, {flag, ?wxALL bor ?wxEXPAND}]), + DerivedCtrl = create_app_list_ctrl(Panel, Sizer, ?derived, + whitelist_add, blacklist_add), + %% S3 = redraw_apps(S2), + wxPanel:setSizer(Panel, Sizer), + wxNotebook:addPage(Book, Panel, ?APP_PAGE, []), + S#state{source = SourceCtrl, + whitelist = WhiteCtrl, + blacklist = BlackCtrl, + derived = DerivedCtrl}. + +create_app_list_ctrl(Panel, OuterSz, Title, Tick, Cross) -> + %% Create list control + Width = lists:max([100, ?WIN_WIDTH - 40]) div 4, + Height = lists:max([100, ?WIN_HEIGHT - 100]), + ListCtrl = wxListCtrl:new(Panel, + [{style, + ?wxLC_REPORT bor + %% ?wxLC_SORT_ASCENDING bor + %% ?wxLC_SINGLE_SEL bor + ?wxVSCROLL}, + {size, {Width, Height}}]), + ToolTip = "Select application(s) or open separate application window with a double click.", + wxListCtrl:setToolTip(ListCtrl, ToolTip), + + %% Prep images + reltool_utils:assign_image_list(ListCtrl), + + %% Prep column label + ListItem = wxListItem:new(), + wxListItem:setAlign(ListItem, ?wxLIST_FORMAT_LEFT), + wxListItem:setText(ListItem, Title), + wxListCtrl:insertColumn(ListCtrl, ?APPS_APP_COL, ListItem), + wxListItem:destroy(ListItem), + + %% Create button + ButtonSz = wxBoxSizer:new(?wxHORIZONTAL), + create_button(Panel, ButtonSz, ListCtrl, Title, "wxART_TICK_MARK", Tick), + create_button(Panel, ButtonSz, ListCtrl, Title, "wxART_CROSS_MARK", Cross), + + + InnerSz = wxBoxSizer:new(?wxVERTICAL), + wxSizer:add(InnerSz, + ListCtrl, + [{border, 2}, + {flag, ?wxALL bor ?wxEXPAND}, + {proportion, 1}]), + wxSizer:add(InnerSz, + ButtonSz, + [{flag, ?wxEXPAND}]), + wxSizer:add(OuterSz, + InnerSz, + [{flag, ?wxEXPAND}, {proportion, 1}]), + + %% Subscribe on events + wxEvtHandler:connect(ListCtrl, size, [{skip, true}, {userData, app_list_ctrl}]), + wxEvtHandler:connect(ListCtrl, command_list_item_activated), + wxWindow:connect(ListCtrl, enter_window), + + ListCtrl. + +%% create_button(_Panel, Sizer, _ListCtrl, _BitMapName, _Tag, undefined) -> +%% wxSizer:addStretchSpacer(Sizer); +create_button(Panel, Sizer, ListCtrl, Title, BitMapName, Action) -> + BitMap = wxArtProvider:getBitmap(BitMapName), + Button = wxBitmapButton:new(Panel, ?wxID_ANY, BitMap, []), + ToolTip = action_to_tool_tip(Title, Action), + wxBitmapButton:setToolTip(Button, ToolTip), + Options = [{userData, {app_button, Action, ListCtrl}}], + wxEvtHandler:connect(Button, command_button_clicked, Options), + wxSizer:add(Sizer, + Button, + [{border, 2}, + {flag, ?wxALL}, + {proportion, 1}]). + +action_to_tool_tip(Label, Action) -> + case Action of + whitelist_add when Label =:= ?whitelist -> + "Remove selected application(s) from whitelist."; + whitelist_add -> + "Add selected application(s) to whitelist."; + whitelist_del -> + "Remove selected application(s)from whitelist."; + blacklist_add when Label =:= ?blacklist -> + "Remove selected application(s) from blacklist."; + blacklist_add -> + "Add selected application(s) to blacklist."; + blacklist_del -> + "Remove selected application(s) from blacklist." + end. + +create_lib_page(#state{book = Book} = S) -> + Panel = wxPanel:new(Book, []), + Sizer = wxBoxSizer:new(?wxHORIZONTAL), + + Tree = wxTreeCtrl:new(Panel, [{style , ?wxTR_HAS_BUTTONS bor ?wxTR_HIDE_ROOT}]), + ToolTip = "Edit application sources.", + wxBitmapButton:setToolTip(Tree, ToolTip), + + wxFrame:connect(Tree, command_tree_item_activated), + wxFrame:connect(Tree, command_tree_item_right_click), + + wxSizer:add(Sizer, + Tree, + [{border, 2}, + {flag, ?wxALL bor ?wxEXPAND}, + {proportion, 1}]), + wxPanel:setSizer(Panel, Sizer), + wxNotebook:addPage(Book, Panel, ?LIB_PAGE, []), + S#state{lib_tree = Tree}. + +redraw_libs(#state{lib_tree = Tree, sys = Sys} = S) -> + wxTreeCtrl:deleteAllItems(Tree), + + Top = wxTreeCtrl:addRoot(Tree, "Sources", []), + {ok, Erts} = reltool_server:get_app(S#state.server_pid, erts), + append_root(Tree, Top, Sys#sys.root_dir, Erts), + + LibItem = wxTreeCtrl:appendItem(Tree, Top, "Library directories", []), + LibData = #lib_data{dir = undefined, tree = Tree, item = LibItem}, + wxTreeCtrl:setItemData(Tree, LibItem, LibData), + [append_lib(Tree, LibItem, Dir) || Dir <- Sys#sys.lib_dirs], + + EscriptItem = append_item(Tree, Top, "Escript files", undefined), + EscriptData = #escript_data{file = undefined, tree = Tree, item = EscriptItem}, + wxTreeCtrl:setItemData(Tree,EscriptItem, EscriptData), + [append_escript(Tree, EscriptItem, File) || File <- Sys#sys.escripts], + wxTreeCtrl:expand(Tree, LibItem), + wxTreeCtrl:expand(Tree, EscriptItem), + S. + +append_root(Tree, Parent, Dir, Erts) -> + Top = append_item(Tree, Parent, "Root directory", undefined), + Data = #root_data{dir = Dir}, + RootItem = append_item(Tree, Top, Dir, Data), + ErtsItem = append_item(Tree, RootItem, "erts", undefined), + [append_app(Tree, ErtsItem, filename:basename(filename:dirname(D)), D) + || D <- Erts#app.sorted_dirs], + LibItem = append_item(Tree, RootItem, "lib", undefined), + LibDir = filename:join([Dir, "lib"]), + LibDirs = reltool_utils:lib_dirs(LibDir), + AppDirs = lists:sort(fun reltool_utils:app_dir_test/2, LibDirs), + [append_app(Tree, LibItem, D, LibDir) || D <- AppDirs], + wxTreeCtrl:expand(Tree, Top), + RootItem. + +append_lib(Tree, Parent, Dir) -> + Item = wxTreeCtrl:appendItem(Tree, Parent, Dir, []), + Data = #lib_data{dir = Dir, tree = Tree, item = Item}, + wxTreeCtrl:setItemData(Tree, Item, Data), + append_apps(Tree, Item, Dir). + +append_apps(Tree, Item, Dir) -> + AppDirs = lists:sort(fun reltool_utils:app_dir_test/2, + reltool_utils:lib_dirs(Dir)), + [append_app(Tree, Item, D, Dir) || D <- AppDirs], + Item. + +append_app(Tree, Parent, Base, Dir) -> + Data = #app_data{name = Base, dir = Dir}, + append_item(Tree, Parent, Base, Data). + +append_escript(Tree, Parent, File) -> + Data = #escript_data{file = File}, + append_item(Tree, Parent, File, Data). + +append_item(Tree, Parent, Label, Data) -> + Item = wxTreeCtrl:appendItem(Tree, Parent, Label, []), + wxTreeCtrl:setItemData(Tree, Item, Data), + Item. + +create_config_page(#state{sys = Sys, book = Book} = S) -> + Panel = wxPanel:new(Book, []), + Sizer = wxBoxSizer:new(?wxHORIZONTAL), + AppConds = reltool_utils:incl_conds(), + AppBox = wxRadioBox:new(Panel, + ?wxID_ANY, + "Application inclusion policy", + ?wxDefaultPosition, + ?wxDefaultSize, + AppConds, + []), + AppToolTip = "Choose default policy for inclusion of applications. ", + wxBitmapButton:setToolTip(AppBox, AppToolTip), + AppChoice = reltool_utils:incl_cond_to_index(Sys#sys.incl_cond), + wxRadioBox:setSelection(AppBox, AppChoice), + wxEvtHandler:connect(AppBox, command_radiobox_selected, + [{userData, config_incl_cond}]), + ModConds = reltool_utils:mod_conds(), + ModBox = wxRadioBox:new(Panel, + ?wxID_ANY, + "Module inclusion policy", + ?wxDefaultPosition, + ?wxDefaultSize, + ModConds, + []), + ModToolTip = "Choose default policy for module inclusion.", + wxBitmapButton:setToolTip(ModBox, ModToolTip), + + ModChoice = reltool_utils:mod_cond_to_index(Sys#sys.mod_cond), + wxRadioBox:setSelection(ModBox, ModChoice), + wxEvtHandler:connect(ModBox, command_radiobox_selected, + [{userData, config_mod_cond}]), + + wxSizer:add(Sizer, + AppBox, + [{border, 2}, + {flag, ?wxALL bor ?wxEXPAND}, + {proportion, 1}]), + wxSizer:add(Sizer, + ModBox, + [{border, 2}, + {flag, ?wxALL bor ?wxEXPAND}, + {proportion, 1}]), + wxPanel:setSizer(Panel, Sizer), + wxNotebook:addPage(Book, Panel, ?SYS_PAGE, []), + S. + +create_main_release_page(#state{book = Book} = S) -> + Panel = wxPanel:new(Book, []), + RelBook = wxNotebook:new(Panel, ?wxID_ANY, []), + Sizer = wxBoxSizer:new(?wxVERTICAL), + ButtonSizer = wxBoxSizer:new(?wxHORIZONTAL), + + Create = wxButton:new(Panel, ?wxID_ANY, [{label, "Create"}]), + wxButton:setToolTip(Create, "Create a new release."), + wxButton:connect(Create, command_button_clicked, [{userData, create_rel}]), + wxSizer:add(ButtonSizer, Create), + + Delete = wxButton:new(Panel, ?wxID_ANY, [{label, "Delete"}]), + wxButton:setToolTip(Delete, "Delete a release."), + wxButton:connect(Delete, command_button_clicked, [{userData, delete_rel}]), + wxSizer:add(ButtonSizer, Delete), + + View = wxButton:new(Panel, ?wxID_ANY, [{label, "View script"}]), + wxButton:setToolTip(View, "View generated script file."), + wxButton:connect(View, command_button_clicked, [{userData, view_script}]), + wxSizer:add(ButtonSizer, View), + + [add_release_page(RelBook, Rel) || Rel <- (S#state.sys)#sys.rels], + + wxSizer:add(Sizer, RelBook, [{flag, ?wxEXPAND}, {proportion, 1}]), + wxSizer:add(Sizer, ButtonSizer, [{flag, ?wxEXPAND}]), + wxPanel:setSizer(Panel, Sizer), + wxNotebook:addPage(Book, Panel, ?REL_PAGE, []), + S#state{rel_book = RelBook}. + +add_release_page(Book, #rel{name = RelName, rel_apps = RelApps}) -> + Panel = wxPanel:new(Book, []), + Sizer = wxBoxSizer:new(?wxHORIZONTAL), + RelBox = wxRadioBox:new(Panel, + ?wxID_ANY, + "Applications included in the release " ++ RelName, + ?wxDefaultPosition, + ?wxDefaultSize, + [atom_to_list(RA#rel_app.name) || RA <- RelApps], + []), + %% wxRadioBox:setSelection(RelBox, 2), % mandatory + wxEvtHandler:connect(RelBox, command_radiobox_selected, [{userData, {config_rel_cond, RelName}}]), + RelToolTip = "Choose which applications that shall be included in the release resource file.", + wxBitmapButton:setToolTip(RelBox, RelToolTip), + + wxSizer:add(Sizer, + RelBox, + [{border, 2}, + {flag, ?wxALL bor ?wxEXPAND}, + {proportion, 1}]), + wxPanel:setSizer(Panel, Sizer), + wxNotebook:addPage(Book, Panel, RelName, []). + +do_open_app(S, AppBase) when is_list(AppBase) -> + {AppName, _AppVsn} = reltool_utils:split_app_name(AppBase), + do_open_app(S, AppName); +do_open_app(S, '') -> + S; +do_open_app(#state{server_pid = ServerPid, common = C, app_wins = AppWins} = S, AppName) when is_atom(AppName) -> + case lists:keysearch(AppName, #app_win.name, AppWins) of + false -> + WxEnv = wx:get_env(), + {ok, Pid} = reltool_app_win:start_link(WxEnv, ServerPid, C, AppName), + AW = #app_win{name = AppName, pid = Pid}, + S#state{app_wins = [AW | AppWins]}; + {value, AW} -> + reltool_app_win:raise(AW#app_win.pid), + S + end. + +root_popup(S, Root, Tree, Item) -> + PopupMenu = wxMenu:new(), + wxMenu:append(PopupMenu, 0, "Root dir"), + wxMenu:appendSeparator(PopupMenu), + wxMenu:append(PopupMenu, 1, "Edit"), + Choices = [edit], + wxEvtHandler:connect(PopupMenu, command_menu_selected), + wxEvtHandler:connect(PopupMenu, menu_close), + wxWindow:popupMenu(S#state.frame, PopupMenu), + + Popup = #root_popup{dir = Root, choices = Choices, tree = Tree, item = Item}, + S#state{popup_menu = Popup}. + +lib_popup(S, Lib, Tree, Item) -> + PopupMenu = wxMenu:new(), + wxMenu:append(PopupMenu, 0, "Library dir"), + wxMenu:appendSeparator(PopupMenu), + wxMenu:append(PopupMenu, 1, "Add"), + Choices = + case wxTreeCtrl:getItemData(Tree, Item) of + #lib_data{dir = undefined} -> + [add]; + #lib_data{} -> + wxMenu:append(PopupMenu, 2, "Edit"), + wxMenu:append(PopupMenu, 3, "Delete"), + [add, edit, delete] + end, + wxEvtHandler:connect(PopupMenu, command_menu_selected), + wxEvtHandler:connect(PopupMenu, menu_close), + wxWindow:popupMenu(S#state.frame, PopupMenu), + + Popup = #lib_popup{dir = Lib, choices = Choices, tree = Tree, item = Item}, + S#state{popup_menu = Popup}. + +escript_popup(S, File, Tree, Item) -> + PopupMenu = wxMenu:new(), + wxMenu:append(PopupMenu, 0, "Escript file"), + wxMenu:appendSeparator(PopupMenu), + wxMenu:append(PopupMenu, 1, "Add"), + Choices = + case wxTreeCtrl:getItemData(Tree, Item) of + #escript_data{file = undefined} -> + [add]; + #escript_data{} -> + wxMenu:append(PopupMenu, 2, "Edit"), + wxMenu:append(PopupMenu, 3, "Delete"), + [add, edit, delete] + end, + wxEvtHandler:connect(PopupMenu, command_menu_selected), + wxEvtHandler:connect(PopupMenu, menu_close), + wxWindow:popupMenu(S#state.frame, PopupMenu), + + Popup = #escript_popup{file = File, choices = Choices, tree = Tree, item = Item}, + S#state{popup_menu = Popup}. + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +handle_event(S, #wx{id = Id, obj= ObjRef, userData = UserData, event = Event} = _Wx) -> + %% io:format("wx: ~p\n", [Wx]), + case Event of + #wxSize{type = size, size = {W, _H}} when UserData =:= app_list_ctrl -> + wxListCtrl:setColumnWidth(ObjRef, ?APPS_APP_COL, W), + S; + #wxCommand{type = command_menu_selected} when Id =:= ?APP_GRAPH_ITEM -> + update_app_graph(S); + #wxCommand{type = command_menu_selected} when Id =:= ?MOD_GRAPH_ITEM -> + update_mod_graph(S); + #wxCommand{type = command_menu_selected} when Id =:= ?RESET_CONFIG_ITEM -> + reset_config(S); + #wxCommand{type = command_menu_selected} when Id =:= ?UNDO_CONFIG_ITEM -> + undo_config(S); + #wxCommand{type = command_menu_selected} when Id =:= ?LOAD_CONFIG_ITEM -> + load_config(S); + #wxCommand{type = command_menu_selected} when Id =:= ?SAVE_CONFIG_NODEF_NODER_ITEM -> + save_config(S, false, false); + #wxCommand{type = command_menu_selected} when Id =:= ?SAVE_CONFIG_NODEF_DER_ITEM -> + save_config(S, false, true); + #wxCommand{type = command_menu_selected} when Id =:= ?SAVE_CONFIG_DEF_NODER_ITEM -> + save_config(S, true, false); + #wxCommand{type = command_menu_selected} when Id =:= ?SAVE_CONFIG_DEF_DER_ITEM -> + save_config(S, true, true); + #wxCommand{type = command_menu_selected} when Id =:= ?GEN_REL_FILES_ITEM -> + gen_rel_files(S); + #wxCommand{type = command_menu_selected} when Id =:= ?GEN_TARGET_ITEM -> + gen_target(S); + #wxCommand{type = command_menu_selected} when UserData =:= main_window, Id =:= ?CONTENTS_ITEM -> + {file, BeamFile} = code:is_loaded(?MODULE), + EbinDir = filename:dirname(BeamFile), + AppDir = filename:dirname(EbinDir), + HelpFile = filename:join([AppDir, "doc", "html", "index.html"]), + Url = "file://" ++ filename:absname(HelpFile), + wx_misc:launchDefaultBrowser(Url), + S; + #wxCommand{type = command_menu_selected} when UserData =:= main_window, Id =:= ?ABOUT_ITEM -> + AboutStr = "Reltool is a release management tool. It analyses a given" + " Erlang/OTP installation and determines various dependencies" + " between applications. The graphical frontend depicts the" + " dependencies and enables interactive customization of a" + " target system. The backend provides a batch interface" + " for generation of customized target systems.", + MD = wxMessageDialog:new(S#state.frame, + AboutStr, + [{style, ?wxOK bor ?wxICON_INFORMATION}, + {caption, "About Reltool"}]), + wxMessageDialog:showModal(MD), + wxMessageDialog:destroy(MD), + S; + #wxMenu{type = menu_close} -> + S#state{popup_menu = undefined}; + #wxCommand{type = command_menu_selected = Type, cmdString = Str} + when S#state.popup_menu =/= undefined -> + handle_popup_event(S, Type, Id, ObjRef, UserData, Str); + #wxMouse{type = enter_window} -> + wxWindow:setFocus(ObjRef), + S; + _ -> + case wxNotebook:getPageText(S#state.book, wxNotebook:getSelection(S#state.book)) of + ?APP_PAGE -> handle_app_event(S, Event, ObjRef, UserData); + ?LIB_PAGE -> handle_source_event(S, Event, ObjRef, UserData); + ?SYS_PAGE -> handle_system_event(S, Event, ObjRef, UserData); + ?REL_PAGE -> handle_release_event(S, Event, ObjRef, UserData) + end + end. + +handle_popup_event(S, _Type, 0, _ObjRef, _UserData, _Str) -> + S#state{popup_menu = undefined}; +handle_popup_event(#state{popup_menu = #root_popup{dir = OldDir, choices = Choices}, + sys = Sys} = S, + _Type, Pos, _ObjRef, _UserData, _Str) -> + case lists:nth(Pos, Choices) of + edit -> + Style = ?wxFD_OPEN bor ?wxFD_FILE_MUST_EXIST, + case select_dir(S#state.frame, "Change root directory", OldDir, Style) of + {ok, NewDir} when NewDir =:= OldDir -> + %% Same dir.Ignore. + S#state{popup_menu = undefined}; + {ok, NewDir} -> + Sys2 = Sys#sys{root_dir = NewDir}, + do_set_sys(S#state{popup_menu = undefined, sys = Sys2}); + cancel -> + S#state{popup_menu = undefined} + end + end; +handle_popup_event(#state{popup_menu = #lib_popup{dir = OldDir, choices = Choices}, + sys = Sys} = S, + _Type, Pos, _ObjRef, _UserData, _Str) -> + case lists:nth(Pos, Choices) of + add -> + {ok, Cwd} = file:get_cwd(), + Style = ?wxFD_OPEN bor ?wxFD_FILE_MUST_EXIST, + case select_dir(S#state.frame, "Select a library directory to add", Cwd, Style) of + {ok, NewDir} -> + case lists:member(NewDir, Sys#sys.lib_dirs) of + true -> + %% Ignore duplicate. Keep old. + S#state{popup_menu = undefined}; + false -> + LibDirs = Sys#sys.lib_dirs ++ [NewDir], + Sys2 = Sys#sys{lib_dirs = LibDirs}, + do_set_sys(S#state{popup_menu = undefined, sys = Sys2}) + end; + cancel -> + S#state{popup_menu = undefined} + end; + edit -> + Style = ?wxFD_OPEN bor ?wxFD_FILE_MUST_EXIST, + case select_dir(S#state.frame, "Change library directory", OldDir, Style) of + {ok, NewDir} -> + case lists:member(NewDir, Sys#sys.lib_dirs) of + true -> + %% Ignore duplicate. Keep old. + S#state{popup_menu = undefined}; + false -> + Pred = fun(E) -> E =/= OldDir end, + {Before, [_| After]} = + lists:splitwith(Pred, Sys#sys.lib_dirs), + LibDirs2 = Before ++ [NewDir | After], + Sys2 = Sys#sys{lib_dirs = LibDirs2}, + do_set_sys(S#state{popup_menu = undefined, sys = Sys2}) + end; + cancel -> + S#state{popup_menu = undefined} + end; + delete -> + LibDirs = Sys#sys.lib_dirs -- [OldDir], + Sys2 = Sys#sys{lib_dirs = LibDirs}, + do_set_sys(S#state{popup_menu = undefined, sys = Sys2}) + end; +handle_popup_event(#state{popup_menu = #escript_popup{file = OldFile, choices = Choices}, + sys = Sys} = S, + _Type, Pos, _ObjRef, _UserData, _Str) -> + case lists:nth(Pos, Choices) of + add -> + OldFile2 = + case OldFile of + undefined -> + {ok, Cwd} = file:get_cwd(), + filename:join([Cwd, "myEscript"]); + _ -> + OldFile + end, + Style = ?wxFD_OPEN bor ?wxFD_FILE_MUST_EXIST, + case select_file(S#state.frame, "Select an escript file to add", OldFile2, Style) of + {ok, NewFile} -> + case lists:member(NewFile, Sys#sys.escripts) of + true -> + %% Ignore duplicate. Keep old. + S#state{popup_menu = undefined}; + false -> + Escripts = Sys#sys.escripts ++ [NewFile], + Sys2 = Sys#sys{escripts = Escripts}, + do_set_sys(S#state{popup_menu = undefined, sys = Sys2}) + end; + cancel -> + S#state{popup_menu = undefined} + end; + edit -> + Style = ?wxFD_OPEN bor ?wxFD_FILE_MUST_EXIST, + case select_file(S#state.frame, "Change escript file name", OldFile, Style) of + {ok, NewFile} -> + case lists:member(NewFile, Sys#sys.escripts) of + true -> + %% Ignore duplicate. Keep old. + S#state{popup_menu = undefined}; + false -> + Pred = fun(E) -> E =/= OldFile end, + {Before, [_| After]} = lists:splitwith(Pred, Sys#sys.escripts), + Escripts2 = Before ++ [NewFile | After], + Sys2 = Sys#sys{escripts = Escripts2}, + do_set_sys(S#state{popup_menu = undefined, sys = Sys2}) + end; + cancel -> + S#state{popup_menu = undefined} + end; + delete -> + Escripts = Sys#sys.escripts -- [OldFile], + Sys2 = Sys#sys{escripts = Escripts}, + do_set_sys(S#state{popup_menu = undefined, sys = Sys2}) + end. + +handle_system_event(#state{sys = Sys} = S, + #wxCommand{type = command_radiobox_selected, cmdString = Choice}, + _ObjRef, + config_mod_cond) -> + ModCond = reltool_utils:list_to_mod_cond(Choice), + Sys2 = Sys#sys{mod_cond = ModCond}, + do_set_sys(S#state{sys = Sys2}); +handle_system_event(#state{sys = Sys} = S, + #wxCommand{type = command_radiobox_selected, cmdString = Choice}, + _ObjRef, + config_incl_cond) -> + AppCond = reltool_utils:list_to_incl_cond(Choice), + Sys2 = Sys#sys{incl_cond = AppCond}, + do_set_sys(S#state{sys = Sys2}); +handle_system_event(S, Event, ObjRef, UserData) -> + error_logger:format("~p~p got unexpected wx sys event to ~p with user data: ~p\n\t ~p\n", + [?MODULE, self(), ObjRef, UserData, Event]), + S. + +handle_release_event(S, _Event, _ObjRef, UserData) -> + io:format("Release data: ~p\n", [UserData]), + S. + +handle_source_event(S, #wxTree{type = command_tree_item_activated, item = Item}, ObjRef, _UserData) -> + case wxTreeCtrl:getItemData(ObjRef, Item) of + #root_data{dir = _Dir} -> + %% io:format("Root dialog: ~p\n", [Dir]), + S; + #lib_data{dir = _Dir} -> + %% io:format("Lib dialog: ~p\n", [Dir]), + S; + #escript_data{file = _File} -> + %% io:format("Escript dialog: ~p\n", [File]), + S; + #app_data{name = Name} -> + do_open_app(S, Name); + undefined -> + S + end; +handle_source_event(S, #wxTree{type = command_tree_item_right_click, item = Item}, Tree, _UserData) -> + case wxTreeCtrl:getItemData(Tree, Item) of + #root_data{dir = Dir} -> + wx:batch(fun() -> root_popup(S, Dir, Tree, Item) end); + #lib_data{dir = Dir} -> + wx:batch(fun() -> lib_popup(S, Dir, Tree, Item) end); + #escript_data{file = File} -> + wx:batch(fun() -> escript_popup(S, File, Tree, Item) end); + #app_data{name = Name} -> + io:format("App menu: ~p\n", [Name]), + S; + undefined -> + S + end. + +handle_app_event(S, #wxList{type = command_list_item_activated, itemIndex = Pos}, ListCtrl, _UserData) -> + AppName = wxListCtrl:getItemText(ListCtrl, Pos), + do_open_app(S, AppName); +handle_app_event(S, #wxCommand{type = command_button_clicked}, _ObjRef, {app_button, Action, ListCtrl}) -> + Items = reltool_utils:get_items(ListCtrl), + handle_app_button(S, Items, Action); +handle_app_event(S, Event, ObjRef, UserData) -> + error_logger:format("~p~p got unexpected wx app event to ~p with user data: ~p\n\t ~p\n", + [?MODULE, self(), ObjRef, UserData, Event]), + S. + +handle_app_button(#state{server_pid = ServerPid, app_wins = AppWins} = S, Items, Action) -> + NewApps = [move_app(S, Item, Action) || Item <- Items], + case reltool_server:set_apps(ServerPid, NewApps) of + {ok, []} -> + ok; + {ok, Warnings} -> + Msg = lists:flatten([[W, $\n] || W <- Warnings]), + display_message(Msg, ?wxICON_WARNING); + {error, Reason} -> + display_message(Reason, ?wxICON_ERROR) + end, + [ok = reltool_app_win:refresh(AW#app_win.pid) || AW <- AppWins], + redraw_apps(S). + +do_set_sys(#state{sys = Sys, server_pid = ServerPid, status_bar = Bar} = S) -> + wxStatusBar:setStatusText(Bar, "Processing libraries..."), + Status = reltool_server:set_sys(ServerPid, Sys), + check_and_refresh(S, Status). + +move_app(S, {_ItemNo, AppBase}, Action) -> + {AppName, _Vsn} = reltool_utils:split_app_name(AppBase), + {ok, OldApp} = reltool_server:get_app(S#state.server_pid, AppName), + AppCond = + case Action of + whitelist_add -> + case OldApp#app.incl_cond of + include -> undefined; + exclude -> include; + undefined -> include + end; + whitelist_del -> + undefined; + blacklist_add -> + exclude; + blacklist_del -> + undefined; + _ -> + error_logger:format("~p~p got unexpected app button event: ~p ~p\n", + [?MODULE, self(), Action, AppBase]), + OldApp#app.incl_cond + end, + OldApp#app{incl_cond = AppCond}. + +do_set_app(#state{server_pid = ServerPid, app_wins = AppWins} = S, NewApp) -> + {ok, AnalysedApp, Warnings} = reltool_server:set_app(ServerPid, NewApp), + [ok = reltool_app_win:refresh(AW#app_win.pid) || AW <- AppWins], + S2 = redraw_apps(S), + case Warnings of + [] -> + ignore; + _ -> + Msg = lists:flatten([[W, $\n] || W <- Warnings]), + display_message(Msg, ?wxICON_WARNING) + end, + {ok, AnalysedApp, S2}. + +redraw_apps(#state{server_pid = ServerPid, + source = SourceCtrl, + whitelist = WhiteCtrl, + blacklist = BlackCtrl, + derived = DerivedCtrl} = S) -> + {ok, SourceApps} = reltool_server:get_apps(ServerPid, source), + {ok, WhiteApps} = reltool_server:get_apps(ServerPid, whitelist), + {ok, BlackApps} = reltool_server:get_apps(ServerPid, blacklist), + {ok, DerivedApps} = reltool_server:get_apps(ServerPid, derived), + + BadApps = fun(#app{used_by_apps = UsedBy} = A) when UsedBy =/= [] -> + A#app{status = missing}; + (A) -> + A + end, + BlackApps2 = lists:map(BadApps, BlackApps), + redraw_apps(SourceApps, SourceCtrl, ?CROSS_IMAGE, ?WARN_IMAGE), + WhiteN = redraw_apps(WhiteApps, WhiteCtrl, ?TICK_IMAGE, ?ERR_IMAGE), + redraw_apps(BlackApps2, BlackCtrl, ?CROSS_IMAGE, ?WARN_IMAGE), + DerivedN = redraw_apps(DerivedApps, DerivedCtrl, ?TICK_IMAGE, ?ERR_IMAGE), + Status = lists:concat([WhiteN, " whitelisted modules and ", + DerivedN, " derived modules."]), + wxStatusBar:setStatusText(S#state.status_bar, Status), + S. + +redraw_apps(Apps, ListCtrl, OkImage, ErrImage) -> + do_redraw_apps(ListCtrl, Apps, OkImage, ErrImage). + +do_redraw_apps(ListCtrl, [], _OkImage, _ErrImage) -> + wxListCtrl:deleteAllItems(ListCtrl), + 0; +do_redraw_apps(ListCtrl, Apps, OkImage, ErrImage) -> + OldItems = reltool_utils:get_items(ListCtrl), + wxListCtrl:deleteAllItems(ListCtrl), + AddImage = + fun(App) -> + case App#app.status of + ok -> {OkImage, App#app.label, App}; + missing -> {ErrImage, App#app.label, App} + end + end, + ImageApps = lists:map(AddImage, Apps), + Show = + fun({ImageId, Text, App}, {Row, ModCount, Items}) -> + wxListCtrl:insertItem(ListCtrl, Row, ""), + if (Row rem 2) =:= 0 -> + wxListCtrl:setItemBackgroundColour(ListCtrl, Row, {240,240,255}); + true -> + ignore + end, + wxListCtrl:setItem(ListCtrl, Row, ?APPS_APP_COL, Text, [{imageId, ImageId}]), + N = length([M || M <- App#app.mods, M#mod.is_included =:= true]), + {Row + 1, ModCount + N, [{Row, Text} | Items]} + end, + {_, N, NewItems} = wx:foldl(Show, {0, 0, []}, lists:sort(ImageApps)), + reltool_utils:select_items(ListCtrl, OldItems, lists:reverse(NewItems)), + N. + +update_app_graph(S) -> + {ok, WhiteApps} = reltool_server:get_apps(S#state.server_pid, whitelist), + {ok, DerivedApps} = reltool_server:get_apps(S#state.server_pid, derived), + + WhiteNames = [A#app.name || A <- WhiteApps], + DerivedNames = [A#app.name || A <- DerivedApps], + Nodes = WhiteNames ++ DerivedNames, + %% WhiteUses = [N || A <- WhiteApps, N <- A#app.uses_apps, lists:member(N, Nodes)], + %% DerivedUses = [N || A <- DerivedApps, N <- A#app.uses_apps, lists:member(N, Nodes)], + + WhiteLinks = [[A#app.name, U] || A <- WhiteApps, + U <- A#app.uses_apps, + U =/= A#app.name, + lists:member(U, Nodes)], + DerivedLinks = [[A#app.name, U] || A <- DerivedApps, + U <- A#app.uses_apps, + U =/= A#app.name, + lists:member(U, Nodes)], + Links = lists:usort(WhiteLinks ++ DerivedLinks), + %% io:format("Links: ~p\n", [Links]), + Title = lists:concat([?APPLICATION, " - application graph"]), + create_fgraph_window(S, Title, Nodes, Links). + +update_mod_graph(S) -> + {ok, WhiteApps} = reltool_server:get_apps(S#state.server_pid, whitelist), + {ok, DerivedApps} = reltool_server:get_apps(S#state.server_pid, derived), + WhiteMods = lists:usort([M || A <- WhiteApps, M <- A#app.mods, M#mod.is_included =:= true]), + DerivedMods = lists:usort([M || A <- DerivedApps, M <- A#app.mods, M#mod.is_included =:= true]), + + WhiteNames = [M#mod.name || M <- WhiteMods], + DerivedNames = [M#mod.name || M <- DerivedMods], + Nodes = WhiteNames ++ DerivedNames, + + WhiteLinks = [[M#mod.name, U] || M <- WhiteMods, + U <- M#mod.uses_mods, + U =/= M#mod.name, + lists:member(U, Nodes)], + DerivedLinks = [[M#mod.name, U] || M <- DerivedMods, + U <- M#mod.uses_mods, + U =/= M#mod.name, + lists:member(U, Nodes)], + Links = lists:usort(WhiteLinks ++ DerivedLinks), + %% io:format("Links: ~p\n", [Links]), + Title = lists:concat([?APPLICATION, " - module graph"]), + create_fgraph_window(S, Title, Nodes, Links). + +create_fgraph_window(S, Title, Nodes, Links) -> + Frame = wxFrame:new(wx:null(), ?wxID_ANY, Title, []), + wxFrame:setSize(Frame, {?WIN_WIDTH, ?WIN_HEIGHT}), + Panel = wxPanel:new(Frame, []), + Options = [{size, {lists:max([100, ?WIN_WIDTH - 100]), ?WIN_HEIGHT}}], + {Server, Fgraph} = reltool_fgraph_win:new(Panel, Options), + Choose = fun(?MISSING_APP) -> alternate; + (_) -> default + end, + [reltool_fgraph_win:add_node(Server, N, Choose(N)) || N <- Nodes], + [reltool_fgraph_win:add_link(Server, {From, To}) || [From, To] <- Links], + + Sizer = wxBoxSizer:new(?wxVERTICAL), + wxSizer:add(Sizer, Fgraph, [{flag, ?wxEXPAND}, {proportion, 1}]), + wxPanel:setSizer(Panel, Sizer), + %% wxSizer:fit(Sizer, Frame), + %% wxSizer:setSizeHints(Sizer, Frame), + wxFrame:connect(Frame, close_window), + wxFrame:show(Frame), + FW = #fgraph_win{frame = Frame, pid = Server}, + S#state{fgraph_wins = [FW | S#state.fgraph_wins]}. + +reset_config(#state{status_bar = Bar} = S) -> + wxStatusBar:setStatusText(Bar, "Processing libraries..."), + Status = reltool_server:reset_config(S#state.server_pid), + check_and_refresh(S, Status). + +undo_config(#state{status_bar = Bar} = S) -> + wxStatusBar:setStatusText(Bar, "Processing libraries..."), + ok = reltool_server:undo_config(S#state.server_pid), + refresh(S). + +load_config(#state{status_bar = Bar, config_file = OldFile} = S) -> + Style = ?wxFD_OPEN bor ?wxFD_FILE_MUST_EXIST, + case select_file(S#state.frame, "Select a file to load the configuration from", OldFile, Style) of + {ok, NewFile} -> + wxStatusBar:setStatusText(Bar, "Processing libraries..."), + Status = reltool_server:load_config(S#state.server_pid, NewFile), + check_and_refresh(S#state{config_file = NewFile}, Status); + cancel -> + S + end. + +save_config(#state{config_file = OldFile} = S, InclDefaults, InclDerivates) -> + Style = ?wxFD_SAVE bor ?wxFD_OVERWRITE_PROMPT, + case select_file(S#state.frame, "Select a file to save the configuration to", OldFile, Style) of + {ok, NewFile} -> + Status = reltool_server:save_config(S#state.server_pid, NewFile, InclDefaults, InclDerivates), + check_and_refresh(S#state{config_file = NewFile}, Status); + cancel -> + S + end. + +gen_rel_files(#state{target_dir = OldDir} = S) -> + Style = ?wxFD_SAVE bor ?wxFD_OVERWRITE_PROMPT, + case select_dir(S#state.frame, "Select a directory to generate rel, script and boot files to", OldDir, Style) of + {ok, NewDir} -> + Status = reltool_server:gen_rel_files(S#state.server_pid, NewDir), + check_and_refresh(S, Status); + cancel -> + S + end. + +gen_target(#state{target_dir = OldDir} = S) -> + Style = ?wxFD_SAVE bor ?wxFD_OVERWRITE_PROMPT, + case select_dir(S#state.frame, "Select a directory to generate a target system to", OldDir, Style) of + {ok, NewDir} -> + Status = reltool_server:gen_target(S#state.server_pid, NewDir), + check_and_refresh(S#state{target_dir = NewDir}, Status); + cancel -> + S + end. + +select_file(Frame, Message, DefaultFile, Style) -> + Dialog = wxFileDialog:new(Frame, + [{message, Message}, + {defaultDir, filename:dirname(DefaultFile)}, + {defaultFile, filename:basename(DefaultFile)}, + {style, Style}]), + Choice = + case wxMessageDialog:showModal(Dialog) of + ?wxID_CANCEL -> cancel; + ?wxID_OK -> {ok, wxFileDialog:getPath(Dialog)} + end, + wxFileDialog:destroy(Dialog), + Choice. + +select_dir(Frame, Message, DefaultDir, Style) -> + Dialog = wxDirDialog:new(Frame, + [{title, Message}, + {defaultPath, DefaultDir}, + {style, Style}]), + Choice = + case wxMessageDialog:showModal(Dialog) of + ?wxID_CANCEL -> cancel; + ?wxID_OK -> {ok, wxDirDialog:getPath(Dialog)} + end, + wxDirDialog:destroy(Dialog), + Choice. + +check_and_refresh(S, Status) -> + case Status of + ok -> + true; + {ok, Warnings} -> + undo_dialog(S, Warnings); + {error, Reason} when is_list(Reason) -> + display_message(Reason, ?wxICON_ERROR), + false; + {error, Reason} -> + Msg = lists:flatten(io_lib:format("Error:\n\n~p\n", [Reason])), + display_message(Msg, ?wxICON_ERROR), + false + end, + refresh(S). + +refresh(S) -> + {ok, Sys} = reltool_server:get_sys(S#state.server_pid), + [ok = reltool_app_win:refresh(AW#app_win.pid) || AW <- S#state.app_wins], + S2 = S#state{sys = Sys}, + S3 = redraw_libs(S2), + redraw_apps(S3). + +question_dialog(Question, Details) -> + %% Parent = S#state.frame, + Parent = wx:typeCast(wx:null(), wxWindow), + %% [{style, ?wxYES_NO bor ?wxICON_ERROR bor ?wx}]), + DialogStyle = ?wxRESIZE_BORDER bor ?wxCAPTION bor ?wxSYSTEM_MENU bor + ?wxMINIMIZE_BOX bor ?wxMAXIMIZE_BOX bor ?wxCLOSE_BOX, + Dialog = wxDialog:new(Parent, ?wxID_ANY, "Undo dialog", [{style, DialogStyle}]), + Color = wxWindow:getBackgroundColour(Dialog), + TextStyle = ?wxTE_READONLY bor ?wxTE_MULTILINE bor ?wxHSCROLL, + Text1 = wxTextCtrl:new(Dialog, ?wxID_ANY, [{style, ?wxTE_READONLY bor ?wxBORDER_NONE}]), + wxWindow:setBackgroundColour(Text1, Color), + wxTextCtrl:appendText(Text1, Question), + Text2 = wxTextCtrl:new(Dialog, ?wxID_ANY, [{size, {600, 400}}, {style, TextStyle}]), + wxWindow:setBackgroundColour(Text2, Color), + wxTextCtrl:appendText(Text2, Details), + %% wxDialog:setAffirmativeId(Dialog, ?wxID_YES), + %% wxDialog:setEscapeId(Dialog, ?wxID_NO), + Sizer = wxBoxSizer:new(?wxVERTICAL), + wxSizer:add(Sizer, Text1, [{border, 2}, {flag, ?wxEXPAND}]), + wxSizer:add(Sizer, Text2, [{border, 2}, {flag, ?wxEXPAND}, {proportion, 1}]), + ButtSizer = wxDialog:createStdDialogButtonSizer(Dialog, ?wxOK bor ?wxCANCEL), + wxSizer:add(Sizer, ButtSizer, [{border, 2}, {flag, ?wxEXPAND}]), + wxPanel:setSizer(Dialog, Sizer), + wxSizer:fit(Sizer, Dialog), + wxSizer:setSizeHints(Sizer, Dialog), + Answer = wxDialog:showModal(Dialog), + wxDialog:destroy(Dialog), + Answer. + +undo_dialog(_S, []) -> + true; +undo_dialog(S, Warnings) -> + Question = "Do you want to perform the update despite these warnings?", + Details = lists:flatten([[W, $\n] || W <- Warnings]), + case question_dialog(Question, Details) of + ?wxID_OK -> + true; + ?wxID_CANCEL -> + reltool_server:undo_config(S#state.server_pid), + false + end. + +display_message(Message, Icon) -> + Dialog = wxMessageDialog:new(wx:null(), + Message, + [{style, ?wxOK bor Icon}]), + wxMessageDialog:showModal(Dialog), + wxMessageDialog:destroy(Dialog). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% sys callbacks + +system_continue(_Parent, _Debug, S) -> + ?MODULE:loop(S). + +system_terminate(Reason, _Parent, _Debug, _S) -> + exit(Reason). + +system_code_change(S,_Module,_OldVsn,_Extra) -> + {ok, S}. diff --git a/lib/reltool/src/reltool_target.erl b/lib/reltool/src/reltool_target.erl new file mode 100644 index 0000000000..895fc6702b --- /dev/null +++ b/lib/reltool/src/reltool_target.erl @@ -0,0 +1,1226 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 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(reltool_target). + +%% Public +-export([ + gen_config/2, + gen_app/1, + gen_rel/2, + gen_rel_files/2, + gen_boot/1, + gen_script/4, + gen_spec/1, + eval_spec/3, + gen_target/2, + install/2 + ]). +-compile(export_all). +-include("reltool.hrl"). +-include_lib("kernel/include/file.hrl"). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% Hardcoded internals about the kernel application +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +%% Mandatory modules are modules that must be loaded before processes +%% can be started. These are a collection of modules from the kernel +%% and stdlib applications. Nowadays, error_handler dynamically loads +%% almost every module. The error_handler self must still be there +%% though. + +mandatory_modules() -> + [error_handler]. + +%% Kernel processes are specially treated by the init process. If a +%% kernel process terminates the whole system terminates. + +kernel_processes(KernelApp) -> + [ + {kernelProcess, heart, {heart, start, []}}, + {kernelProcess, error_logger , {error_logger, start_link, []}}, + {kernelProcess, application_controller, {application_controller, start, [KernelApp]}} + ]. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% Generate the contents of a config file +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +gen_config(#sys{root_dir = RootDir, + lib_dirs = LibDirs, + mod_cond = ModCond, + incl_cond = AppCond, + apps = Apps, + boot_rel = BootRel, + rels = Rels, + emu_name = EmuName, + profile = Profile, + incl_sys_filters = InclSysFiles, + excl_sys_filters = ExclSysFiles, + incl_app_filters = InclAppFiles, + excl_app_filters = ExclAppFiles, + incl_archive_filters = InclArchiveDirs, + excl_archive_filters = ExclArchiveDirs, + archive_opts = ArchiveOpts, + relocatable = Relocatable, + app_type = AppType, + app_file = AppFile, + debug_info = DebugInfo}, + InclDefaults) -> + ErtsItems = + case lists:keysearch(erts, #app.name, Apps) of + {value, Erts} -> + [{erts, gen_config(Erts, InclDefaults)}]; + false -> + [] + end, + AppsItems = + [{app, A#app.name, gen_config(A, InclDefaults)} + || A <- Apps, + A#app.name =/= ?MISSING_APP, + A#app.name =/= erts, + A#app.is_included =:= true, + A#app.is_escript =/= true], + EscriptItems = [{escript, A#app.active_dir, emit(incl_cond, A#app.incl_cond, undefined, InclDefaults)} + || A <- Apps, A#app.is_escript], + DefaultRels = reltool_utils:default_rels(), + RelsItems = + case {[{rel, R#rel.name, R#rel.vsn, gen_config(R, InclDefaults)} || R <- Rels], + [{rel, R#rel.name, R#rel.vsn, gen_config(R, InclDefaults)} || R <- DefaultRels]} of + {RI, RI} -> []; + {RI, _} -> RI + end, + X = fun(List) -> [Re || #regexp{source = Re} <- List] end, + {sys, + emit(root_dir, RootDir, code:root_dir(), InclDefaults) ++ + emit(lib_dirs, LibDirs, ?DEFAULT_LIBS, InclDefaults) ++ + EscriptItems ++ + emit(mod_cond, ModCond, ?DEFAULT_MOD_COND, InclDefaults) ++ + emit(incl_cond, AppCond, ?DEFAULT_INCL_COND, InclDefaults) ++ + ErtsItems ++ + AppsItems ++ + emit(boot_rel, BootRel, ?DEFAULT_REL_NAME, InclDefaults) ++ + RelsItems ++ + emit(emu_name, EmuName, ?DEFAULT_EMU_NAME, InclDefaults) ++ + emit(relocatable, Relocatable, ?DEFAULT_RELOCATABLE, InclDefaults) ++ + emit(profile, Profile, ?DEFAULT_PROFILE, InclDefaults) ++ + emit(incl_sys_filters, X(InclSysFiles), ?DEFAULT_INCL_SYS_FILTERS, InclDefaults) ++ + emit(excl_sys_filters, X(ExclSysFiles), ?DEFAULT_EXCL_SYS_FILTERS, InclDefaults) ++ + emit(incl_app_filters, X(InclAppFiles), ?DEFAULT_INCL_APP_FILTERS, InclDefaults) ++ + emit(excl_app_filters, X(ExclAppFiles), ?DEFAULT_EXCL_APP_FILTERS, InclDefaults) ++ + emit(incl_archive_filters, X(InclArchiveDirs), ?DEFAULT_INCL_ARCHIVE_FILTERS, InclDefaults) ++ + emit(excl_archive_filters, X(ExclArchiveDirs), ?DEFAULT_EXCL_ARCHIVE_FILTERS, InclDefaults) ++ + emit(archive_opts, ArchiveOpts, ?DEFAULT_ARCHIVE_OPTS, InclDefaults) ++ + emit(app_type, AppType, ?DEFAULT_APP_TYPE, InclDefaults) ++ + emit(app_file, AppFile, ?DEFAULT_APP_FILE, InclDefaults) ++ + emit(debug_info, DebugInfo, ?DEFAULT_DEBUG_INFO, InclDefaults)}; +gen_config(#app{name = _Name, + mod_cond = ModCond, + incl_cond = AppCond, + debug_info = DebugInfo, + app_file = AppFile, + incl_app_filters = InclAppFiles, + excl_app_filters = ExclAppFiles, + incl_archive_filters = InclArchiveDirs, + excl_archive_filters = ExclArchiveDirs, + archive_opts = ArchiveOpts, + use_selected_vsn = UseSelected, + vsn = Vsn, + mods = Mods}, + InclDefaults) -> + emit(mod_cond, ModCond, undefined, InclDefaults) ++ + emit(incl_cond, AppCond, undefined, InclDefaults) ++ + emit(debug_info, DebugInfo, undefined, InclDefaults) ++ + emit(app_file, AppFile, undefined, InclDefaults) ++ + emit(incl_app_filters, InclAppFiles, undefined, InclDefaults) ++ + emit(excl_app_filters, ExclAppFiles, undefined, InclDefaults) ++ + emit(incl_archive_filters, InclArchiveDirs, undefined, InclDefaults) ++ + emit(excl_archive_filters, ExclArchiveDirs, undefined, InclDefaults) ++ + emit(archive_opts, ArchiveOpts, undefined, InclDefaults) ++ + emit(vsn, Vsn, undefined, InclDefaults orelse UseSelected =/= true) ++ + [{mod, M#mod.name, gen_config(M, InclDefaults)} || M <- Mods, M#mod.is_included =:= true]; +gen_config(#mod{name = _Name, + incl_cond = AppCond, + debug_info = DebugInfo}, + InclDefaults) -> + emit(incl_cond, AppCond, undefined, InclDefaults) ++ + emit(debug_info, DebugInfo, undefined, InclDefaults); +gen_config(#rel{name = _Name, + vsn = _Vsn, + rel_apps = RelApps}, + InclDefaults) -> + [gen_config(RA, InclDefaults) || RA <- RelApps]; +gen_config(#rel_app{name = Name, + app_type = Type, + incl_apps = InclApps}, + _InclDefaults) -> + case {Type, InclApps} of + {undefined, []} -> Name; + {undefined, _} -> {Name, InclApps}; + {_, []} -> {Name, Type}; + {_, _} -> {Name, Type, InclApps} + end; +gen_config({Tag, Val}, InclDefaults) -> + emit(Tag, Val, undefined, InclDefaults); +gen_config([], _InclDefaults) -> + []; +gen_config([H | T], InclDefaults) -> + lists:flatten([gen_config(H, InclDefaults), gen_config(T, InclDefaults)]). + +emit(Tag, Val, Default, InclDefaults) -> + if + Val == undefined -> []; + InclDefaults -> [{Tag, Val}]; + Val =/= Default -> [{Tag, Val}]; + true -> [] + end. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% Generate the contents of an app file +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +gen_app(#app{name = Name, + info = #app_info{description = Desc, + id = Id, + vsn = Vsn, + modules = Mods, + maxP = MaxP, + maxT = MaxT, + registered = Regs, + incl_apps = InclApps, + applications = ReqApps, + env = Env, + mod = StartMod, + start_phases = StartPhases}}) -> + StartMod2 = + case StartMod =:= undefined of + true -> []; + false -> [{mod, StartMod}] + end, + {application, Name, + [{description, Desc}, + {vsn, Vsn}, + {id, Id}, + {modules, Mods}, + {registered, Regs}, + {applications, ReqApps}, + {included_applications, InclApps}, + {env, Env}, + {start_phases, StartPhases}, + {maxT, MaxT}, + {maxP, MaxP} | + StartMod2]}. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% Generate the contents of a rel file +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +gen_rel(#rel{name = RelName, vsn = RelVsn, rel_apps = RelApps}, + #sys{apps = Apps}) -> + {value, Erts} = lists:keysearch(erts, #app.name, Apps), + {release, + {RelName, RelVsn}, + {erts, Erts#app.vsn}, + [app_to_rel(RA, Apps ) || RA <- RelApps]}. + +app_to_rel(#rel_app{name = Name, app_type = Type, incl_apps = InclApps}, Apps) -> + {value, #app{vsn = Vsn}} = lists:keysearch(Name, #app.name, Apps), + case {Type, InclApps} of + {undefined, []} -> {Name, Vsn}; + {undefined, _} -> {Name, Vsn, InclApps}; + {_, []} -> {Name, Vsn, Type}; + {_, _} -> {Name, Vsn, Type, InclApps} + end. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% Generate the contents of a boot file +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +gen_boot({script, {_, _}, _} = Script) -> + {ok, term_to_binary(Script)}. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% Generate the contents of a script file +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +gen_script(Rel, Sys, PathFlag, Variables) -> + try + do_gen_script(Rel, Sys, PathFlag, Variables) + catch + throw:{error, Text} -> + {error, Text} + end. + +do_gen_script(#rel{name = RelName, vsn = RelVsn, rel_apps = RelApps}, + #sys{apps = Apps, app_type = DefaultType}, + PathFlag, + Variables) -> + {value, Erts} = lists:keysearch(erts, #app.name, Apps), + Preloaded = [Mod#mod.name || Mod <- Erts#app.mods], + Mandatory = mandatory_modules(), + Early = Mandatory ++ Preloaded, + MergedApps = [merge_app(RA, Apps, DefaultType) || RA <- RelApps], + SortedApps = sort_apps(MergedApps), + {value, KernelApp} = lists:keysearch(kernel, #app.name, SortedApps), + + InclApps = lists:append([I || #app{info = #app_info{incl_apps = I}} <- SortedApps]), + + %% Create the script + DeepList = + [ + %% Register preloaded modules + {preLoaded, lists:sort(Preloaded)}, + {progress, preloaded}, + + %% Load mandatory modules + {path, create_mandatory_path(SortedApps, PathFlag, Variables)}, + {primLoad, lists:sort(Mandatory)}, + {kernel_load_completed}, + {progress, kernel_load_completed}, + + %% Load remaining modules + [load_app_mods(A, Early, PathFlag, Variables) || A <- SortedApps], + {progress, modules_loaded}, + + %% Start kernel processes + {path, create_path(SortedApps, PathFlag, Variables)}, + kernel_processes(gen_app(KernelApp)), + {progress, init_kernel_started}, + + %% Load applications + [{apply, {application, load, [gen_app(A)]}} || + A = #app{name = Name, app_type = Type} <- SortedApps, + Name =/= kernel, + Type =/= none], + {progress, applications_loaded}, + + %% Start applications + [{apply, {application, start_boot, [Name, Type]}} || + #app{name = Name, app_type = Type} <- SortedApps, + Type =/= none, + Type =/= load, + not lists:member(Name, InclApps)], + + %% Apply user specific customizations + {apply, {c, erlangrc, []}}, + {progress, started} + ], + {ok, {script, {RelName, RelVsn}, lists:flatten(DeepList)}}. + +merge_app(#rel_app{name = Name, app_type = Type, incl_apps = RelIncl}, Apps, DefaultType) -> + {value, App} = lists:keysearch(Name, #app.name, Apps), + Type2 = + case {Type, App#app.app_type} of + {undefined, undefined} -> DefaultType; + {undefined, AppType} -> AppType; + {_, _} -> Type + end, + Info = App#app.info, + case RelIncl -- Info#app_info.incl_apps of + [] -> + App#app{app_type = Type2, info = Info#app_info{incl_apps = RelIncl}}; + BadIncl -> + reltool_utils:throw_error("~p: These applications are missing as " + "included_applications in the app file: ~p\n", + [Name, BadIncl]) + end. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +load_app_mods(#app{mods = Mods} = App, Mand, PathFlag, Variables) -> + Path = cr_path(App, PathFlag, Variables), + PartNames = + lists:sort([{packages:split(M),M} || + #mod{name = M} <- Mods, + not lists:member(M, Mand)]), + SplitMods = + lists:foldl( + fun({Parts,M}, [{Last, Acc}|Rest]) -> + [_|Tail] = lists:reverse(Parts), + case lists:reverse(Tail) of + Subs when Subs == Last -> + [{Last,[M|Acc]}|Rest]; + Subs -> + [{Subs, [M]}|[{Last,Acc}|Rest]] + end + end, + [{[], + []}], + PartNames), + lists:foldl( + fun({Subs,Ms}, Cmds) -> + [{path, [filename:join([Path | Subs])]}, + {primLoad, lists:sort(Ms)} | Cmds] + end, + [], + SplitMods). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% Function: sort_apps(Apps) -> {ok, Apps'} | throw({error, Error}) +%% Types: Apps = {{Name, Vsn}, #application}] +%% Purpose: Sort applications according to dependencies among +%% applications. If order doesn't matter, use the same +%% order as in the original list. +%% Alg. written by Ulf Wiger 970917 ([email protected]) +%% Mod. by mbj +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +sort_apps(Apps) -> + sort_apps(Apps, [], [], []). + +sort_apps([#app{name = Name, info = Info} = App | Apps], Missing, Circular, Visited) -> + {Uses, Apps1, NotFnd1} = find_all(Name, Info#app_info.applications, Apps, Visited, [], []), + {Incs, Apps2, NotFnd2} = find_all(Name, lists:reverse(Info#app_info.incl_apps), + Apps1, Visited, [], []), + + Missing1 = NotFnd1 ++ NotFnd2 ++ Missing, + case Uses ++ Incs of + [] -> + %% No more app that must be started before this one is + %% found; they are all already taken care of (and present + %% in Visited list) + [App | sort_apps(Apps, Missing1, Circular, [Name | Visited])]; + L -> + %% The apps in L must be started before the app. + %% Check if we have already taken care of some app in L, + %% in that case we have a circular dependency. + NewCircular = [N1 || N1 <- L, N2 <- Visited, N1 =:= N2], + Circular1 = case NewCircular of + [] -> Circular; + _ -> [Name | NewCircular] ++ Circular + end, + %% L must be started before N, try again, with all apps + %% in L added before N. + Apps3 = del_apps(NewCircular, L ++ [App | Apps2]), + sort_apps(Apps3, Missing1, Circular1, [Name | Visited]) + end; +sort_apps([], [], [], _) -> + []; +sort_apps([], Missing, [], _) -> + %% this has already been checked before, but as we have the info... + reltool_utils:throw_error("Undefined applications: ~p\n", [make_set(Missing)]); +sort_apps([], [], Circular, _) -> + reltool_utils:throw_error("Circular dependencies: ~p\n", [make_set(Circular)]); +sort_apps([], Missing, Circular, _) -> + reltool_utils:throw_error("Circular dependencies: ~p\n" + "Undefined applications: ~p\n", + [make_set(Circular), make_set(Missing)]). + +find_all(CheckingApp, [Name | Names], Apps, Visited, Found, NotFound) -> + case lists:keysearch(Name, #app.name, Apps) of + {value, #app{info = Info} = App} -> + %% It is OK to have a dependecy like + %% X includes Y, Y uses X. + case lists:member(CheckingApp, Info#app_info.incl_apps) of + true -> + case lists:member(Name, Visited) of + true -> + find_all(CheckingApp, Names, Apps, Visited, Found, NotFound); + false -> + find_all(CheckingApp, Names, Apps, Visited, Found, [Name | NotFound]) + end; + false -> + find_all(CheckingApp, Names, Apps -- [App], Visited, [App|Found], NotFound) + end; + false -> + case lists:member(Name, Visited) of + true -> + find_all(CheckingApp, Names, Apps, Visited, Found, NotFound); + false -> + find_all(CheckingApp, Names, Apps, Visited, Found, [Name|NotFound]) + end + end; +find_all(_CheckingApp, [], Apps, _Visited, Found, NotFound) -> + {Found, Apps, NotFound}. + +del_apps([Name | Names], Apps) -> + del_apps(Names, lists:keydelete(Name, #app.name, Apps)); +del_apps([], Apps) -> + Apps. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% Create the load path used in the generated script. +%% If PathFlag is true a script intended to be used as a complete +%% system (e.g. in an embbeded system), i.e. all applications are +%% located under $ROOT/lib. +%% Otherwise all paths are set according to dir per application. +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +%% Create the complete path. +create_path(Apps, PathFlag, Variables) -> + make_set([cr_path(App, PathFlag, Variables) || App <- Apps]). + +%% Create the path to a specific application. +%% (The otp_build flag is only used for OTP internal system make) +cr_path(#app{label = Label}, true, []) -> + filename:join(["$ROOT", "lib", Label, "ebin"]); +cr_path(#app{name = Name, vsn = Vsn, label = Label, active_dir = Dir}, true, Variables) -> + Tail = [Label, "ebin"], + case variable_dir(Dir, atom_to_list(Name), Vsn, Variables) of + {ok, VarDir} -> + filename:join([VarDir] ++ Tail); + _ -> + filename:join(["$ROOT", "lib"] ++ Tail) + end; +cr_path(#app{name = Name}, otp_build, _) -> + filename:join(["$ROOT", "lib", atom_to_list(Name), "ebin"]); +cr_path(#app{active_dir = Dir}, _, _) -> + filename:join([Dir, "ebin"]). + +variable_dir(Dir, Name, Vsn, [{Var,Path} | Variables]) -> + case lists:prefix(Path, Dir) of + true -> + D0 = strip_prefix(Path, Dir), + case strip_name_ebin(D0, Name, Vsn) of + {ok, D} -> + {ok, filename:join(["\$" ++ Var] ++ D)}; + _ -> + %% We know at least that we are located + %% under the variable dir. + {ok, filename:join(["\$" ++ Var] ++ D0)} + end; + false -> + variable_dir(Dir, Name, Vsn, Variables) + end; +variable_dir(_Dir, _, _, []) -> + false. + +strip_prefix(Path, Dir) -> + L = length(filename:split(Path)), + lists:nthtail(L, filename:split(Dir)). + +strip_name_ebin(Dir, Name, Vsn) -> + FullName = Name ++ "-" ++ Vsn, + case lists:reverse(Dir) of + ["ebin", Name | D] -> {ok, lists:reverse(D)}; + ["ebin", FullName | D] -> {ok, lists:reverse(D)}; + _ -> false + end. + +%% Create the path to the kernel and stdlib applications. +create_mandatory_path(Apps, PathFlag, Variables) -> + Mandatory = [kernel, stdlib], + make_set(lists:map(fun(#app{name = Name} = App) -> + case lists:member(Name, Mandatory) of + true -> + cr_path(App, PathFlag, Variables); + false -> + "" + end + end, + Apps)). + +make_set([]) -> + []; +make_set([""|T]) -> % Ignore empty items. + make_set(T); +make_set([H|T]) -> + [H | [ Y || Y<- make_set(T), + Y =/= H]]. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% Generate rel, script and boot files +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +gen_rel_files(Sys, TargetDir) -> + try + Spec = spec_rel_files(Sys), + eval_spec(Spec, Sys#sys.root_dir, TargetDir) + catch + throw:{error, Text} -> + {error, Text} + end. + +spec_rel_files(#sys{rels = Rels} = Sys) -> + lists:append([do_spec_rel_files(R, Sys) || R <- Rels]). + +do_spec_rel_files(#rel{name = Name} = Rel, Sys) -> + RelFile = Name ++ ".rel", + ScriptFile = Name ++ ".script", + BootFile = Name ++ ".boot", + GenRel = gen_rel(Rel, Sys), + PathFlag = true, + Variables = [], + {ok, Script} = do_gen_script(Rel, Sys, PathFlag, Variables), + {ok, BootBin} = gen_boot(Script), + Date = date(), + Time = time(), + RelIoList = io_lib:format("%% rel generated at ~w ~w\n~p.\n\n", + [Date, Time, GenRel]), + ScriptIoList = io_lib:format("%% script generated at ~w ~w\n~p.\n\n", + [Date, Time, Script]), + [ + {write_file, RelFile, RelIoList}, + {write_file, ScriptFile, ScriptIoList}, + {write_file, BootFile, BootBin} + ]. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% Generate a complete target system +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +gen_target(Sys, TargetDir) -> + try + Spec = do_gen_spec(Sys), + eval_spec(Spec, Sys#sys.root_dir, TargetDir) + catch + throw:{error, Text} -> + {error, Text} + end. + +gen_spec(Sys) -> + try + {ok, do_gen_spec(Sys)} + catch + throw:{error, Text} -> + {error, Text} + end. + +do_gen_spec(#sys{root_dir = RootDir, + incl_sys_filters = InclRegexps, + excl_sys_filters = ExclRegexps, + relocatable = Relocatable, + apps = Apps} = Sys) -> + {create_dir, _, SysFiles} = spec_dir(RootDir), + {ExclRegexps2, SysFiles2} = strip_sys_files(Relocatable, SysFiles, Apps, ExclRegexps), + RelFiles = spec_rel_files(Sys), + {InclRegexps2, BinFiles} = spec_bin_files(Sys, SysFiles, SysFiles2, RelFiles, InclRegexps), + LibFiles = spec_lib_files(Sys), + {BootVsn, StartFile} = spec_start_file(Sys), + SysFiles3 = + [ + {create_dir, "releases", + [StartFile, + {create_dir,BootVsn, RelFiles}]}, + {create_dir, "bin", BinFiles} + ] ++ SysFiles2, + %% io:format("InclRegexps2: ~p\n", [InclRegexps2]), + %% io:format("ExclRegexps2: ~p\n", [ExclRegexps2]), + SysFiles4 = filter_spec(SysFiles3, InclRegexps2, ExclRegexps2), + SysFiles5 = SysFiles4 ++ [{create_dir, "lib", LibFiles}], + check_sys(["bin", "erts", "lib"], SysFiles5), + SysFiles5. + +strip_sys_files(Relocatable, SysFiles, Apps, ExclRegexps) -> + ExclRegexps2 = + case Relocatable of + true -> + ExtraExcl = ["^erts.*/bin/.*src$"], + reltool_utils:decode_regexps(excl_sys_filters, {add, ExtraExcl}, ExclRegexps); + false -> + ExclRegexps + end, + {value, Erts} = lists:keysearch(erts, #app.name, Apps), + FilterErts = + fun(Spec) -> + File = element(2, Spec), + case lists:prefix("erts", File) of + true -> + if + File =:= Erts#app.label -> + replace_dyn_erl(Relocatable, Spec); + true -> + false + end; + false -> + true + end + end, + SysFiles2 = lists:zf(FilterErts, SysFiles), + SysFiles3 = lists:foldl(fun(F, Acc) -> lists:keydelete(F, 2, Acc) end, + SysFiles2, + ["releases", "lib", "bin"]), + {ExclRegexps2, SysFiles3}. + +replace_dyn_erl(false, _ErtsSpec) -> + true; +replace_dyn_erl(true, {create_dir, ErtsDir, ErtsFiles}) -> + [{create_dir, _, BinFiles}] = safe_lookup_spec("bin", ErtsFiles), + case lookup_spec("dyn_erl", BinFiles) of + [] -> + case lookup_spec("erl.ini", BinFiles) of + [] -> + true; + [{copy_file, ErlIni}] -> + %% Remove Windows .ini file + BinFiles2 = lists:keydelete(ErlIni, 2, BinFiles), + ErtsFiles2 = lists:keyreplace("bin", 2, ErtsFiles, {create_dir, "bin", BinFiles2}), + {true, {create_dir, ErtsDir, ErtsFiles2}} + end; + [{copy_file, DynErlExe}] -> + %% Replace erl with dyn_erl + ErlExe = "erl" ++ filename:extension(DynErlExe), + BinFiles2 = lists:keydelete(DynErlExe, 2, BinFiles), + DynErlExe2 = filename:join([ErtsDir, "bin", DynErlExe]), + BinFiles3 = lists:keyreplace(ErlExe, 2, BinFiles2, {copy_file, ErlExe, DynErlExe2}), + ErtsFiles2 = lists:keyreplace("bin", 2, ErtsFiles, {create_dir, "bin", BinFiles3}), + {true, {create_dir, ErtsDir, ErtsFiles2}} + end. + +spec_bin_files(Sys, AllSysFiles, StrippedSysFiles, RelFiles, InclRegexps) -> + [{create_dir, ErtsLabel, ErtsFiles}] = safe_lookup_spec("erts", StrippedSysFiles), + [{create_dir, _, BinFiles}] = safe_lookup_spec("bin", ErtsFiles), + ErtsBin = filename:join([ErtsLabel, "bin"]), + Escripts = spec_escripts(Sys, ErtsBin, BinFiles), + Map = fun({copy_file, File}) -> + {copy_file, File, filename:join([ErtsBin, File])}; + ({copy_file, NewFile, OldFile}) -> + {_, OldFile2} = abs_to_rel_path(ErtsBin, filename:join([ErtsBin, OldFile])), + {copy_file, NewFile, OldFile2} + end, + + %% Do only copy those bin files from erts/bin that also exists in bin + [{create_dir, _, OldBinFiles}] = safe_lookup_spec("bin", AllSysFiles), + GoodNames = [F || {copy_file, F} <- OldBinFiles, + not lists:suffix(".boot", F), + not lists:suffix(".script", F)], + BinFiles2 = [Map(S) || S <- BinFiles, lists:member(element(2, S), GoodNames)], + BootFiles = [F || F <- RelFiles, lists:suffix(".boot", element(2, F))], + [{write_file, _, BootRel}] = safe_lookup_spec(Sys#sys.boot_rel ++ ".boot", BootFiles), + BootFiles2 = lists:keystore("start.boot", 2, BootFiles, {write_file, "start.boot", BootRel}), + MakeRegexp = fun(File) -> "^bin/" ++ element(2, File) ++ "(|.escript)$" end, + ExtraIncl = lists:map(MakeRegexp, Escripts), + InclRegexps2 = reltool_utils:decode_regexps(incl_sys_filters, {add, ExtraIncl}, InclRegexps), + {InclRegexps2, Escripts ++ BinFiles2 ++ BootFiles2}. + +spec_escripts(#sys{apps = Apps}, ErtsBin, BinFiles) -> + Filter = fun(#app{is_escript = IsEscript, is_included = IsIncl, + is_pre_included = IsPre, name = Name, active_dir = File}) -> + if + Name =:= ?MISSING_APP -> + false; + not IsEscript -> + false; + IsIncl; IsPre -> + {true, do_spec_escript(File, ErtsBin, BinFiles)}; + true -> + false + end + end, + lists:flatten(lists:zf(Filter, Apps)). + +do_spec_escript(File, ErtsBin, BinFiles) -> + [{copy_file, EscriptExe}] = safe_lookup_spec("escript", BinFiles), + EscriptExt = ".escript", + Base = filename:basename(File, EscriptExt), + ExeExt = filename:extension(EscriptExe), + [{copy_file, Base ++ EscriptExt, File}, + {copy_file, Base ++ ExeExt, filename:join([ErtsBin, EscriptExe])}]. + +check_sys(Mandatory, SysFiles) -> + lists:foreach(fun(M) -> do_check_sys(M, SysFiles) end, Mandatory). + +do_check_sys(Prefix, Specs) -> + %%io:format("Prefix: ~p\n", [Prefix]), + case lookup_spec(Prefix, Specs) of + [] -> + reltool_utils:throw_error("Mandatory system directory ~s is not included", + [Prefix]); + _ -> + ok + end. + +spec_start_file(#sys{boot_rel = BootRelName, + rels = Rels, + apps = Apps}) -> + {value, Erts} = lists:keysearch(erts, #app.name, Apps), + {value, BootRel} = lists:keysearch(BootRelName, #rel.name, Rels), + Data = Erts#app.vsn ++ " " ++ BootRel#rel.vsn ++ "\n", + {BootRel#rel.vsn, {write_file, "start_erl.data", Data}}. + +lookup_spec(Prefix, Specs) -> + lists:filter(fun(S) -> lists:prefix(Prefix, element(2, S)) end, Specs). + +safe_lookup_spec(Prefix, Specs) -> + case lookup_spec(Prefix, Specs) of + [] -> + reltool_utils:throw_error("Mandatory system file ~s is not included", [Prefix]); + Match -> + Match + end. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% Specify applications +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +spec_lib_files(#sys{apps = Apps} = Sys) -> + Filter = fun(#app{is_escript = IsEscript, is_included = IsIncl, + is_pre_included = IsPre, name = Name}) -> + if + Name =:= ?MISSING_APP -> + false; + IsEscript -> + false; + IsIncl; IsPre -> + true; + true -> + false + end + end, + SelectedApps = lists:filter(Filter, Apps), + check_apps([kernel, stdlib], SelectedApps), + lists:flatten([spec_app(App, Sys) || App <- SelectedApps]). + +check_apps([Mandatory | Names], Apps) -> + case lists:keymember(Mandatory, #app.name, Apps) of + false -> + reltool_utils:throw_error("Mandatory application ~p is not included in ~p", + [Mandatory, Apps]); + true -> + check_apps(Names, Apps) + end; +check_apps([], _) -> + ok. + +spec_app(#app{name = Name, + mods = Mods, + active_dir = SourceDir, + incl_app_filters = AppInclRegexps, + excl_app_filters = AppExclRegexps} = App, + #sys{incl_app_filters = SysInclRegexps, + excl_app_filters = SysExclRegexps, + debug_info = SysDebugInfo} = Sys) -> + %% List files recursively + {create_dir, _, AppFiles} = spec_dir(SourceDir), + + %% Replace ebin + AppUpFilename = atom_to_list(Name) ++ ".appup", + EbinDir = filename:join([SourceDir, "ebin"]), + OptAppUpFileSpec = spec_opt_copy_file(EbinDir, AppUpFilename), + OptAppFileSpec = spec_app_file(App, Sys, EbinDir), + ModSpecs = [spec_mod(M, SysDebugInfo) || M <- Mods, M#mod.is_included, M#mod.exists], + NewEbin = {create_dir, "ebin", OptAppUpFileSpec ++ OptAppFileSpec ++ ModSpecs}, + AppFiles2 = lists:keystore("ebin", 2, AppFiles, NewEbin), + + %% Apply file filter + InclRegexps = reltool_utils:default_val(AppInclRegexps, SysInclRegexps), + ExclRegexps = reltool_utils:default_val(AppExclRegexps, SysExclRegexps), + AppFiles3 = filter_spec(AppFiles2, InclRegexps, ExclRegexps), + + %% Regular top directory and/or archive + spec_archive(App, Sys, AppFiles3). + +spec_archive(#app{label = Label, + active_dir = SourceDir, + incl_archive_filters = AppInclArchiveDirs, + excl_archive_filters = AppExclArchiveDirs, + archive_opts = AppArchiveOpts}, + #sys{root_dir = RootDir, + incl_archive_filters = SysInclArchiveDirs, + excl_archive_filters = SysExclArchiveDirs, + archive_opts = SysArchiveOpts}, + Files) -> + InclArchiveDirs = reltool_utils:default_val(AppInclArchiveDirs, SysInclArchiveDirs), + ExclArchiveDirs = reltool_utils:default_val(AppExclArchiveDirs, SysExclArchiveDirs), + ArchiveOpts = reltool_utils:default_val(AppArchiveOpts, SysArchiveOpts), + Match = fun(F) -> match(element(2, F), InclArchiveDirs, ExclArchiveDirs) end, + case lists:filter(Match, Files) of + [] -> + %% Nothing to archive + [spec_create_dir(RootDir, SourceDir, Label, Files)]; + ArchiveFiles -> + OptDir = + case Files -- ArchiveFiles of + [] -> + []; + ExternalFiles -> + [spec_create_dir(RootDir, SourceDir, Label, ExternalFiles)] + end, + ArchiveOpts = reltool_utils:default_val(AppArchiveOpts, SysArchiveOpts), + ArchiveDir = spec_create_dir(RootDir, SourceDir, Label, ArchiveFiles), + [{archive, Label ++ ".ez", ArchiveOpts, [ArchiveDir]} | OptDir] + end. + +spec_dir(Dir) -> + Base = filename:basename(Dir), + case erl_prim_loader:read_file_info(Dir) of + {ok, #file_info{type = directory}} -> + case erl_prim_loader:list_dir(Dir) of + {ok, Files} -> + %% Directory + {create_dir, Base, [spec_dir(filename:join([Dir, F])) || F <- Files]}; + error -> + reltool_utils:throw_error("list dir ~s failed\n", [Dir]) + end; + {ok, #file_info{type = regular}} -> + %% Plain file + {copy_file, Base}; + _ -> + reltool_utils:throw_error("read file info ~s failed\n", [Dir]) + end. + +spec_mod(Mod, DebugInfo) -> + File = atom_to_list(Mod#mod.name) ++ code:objfile_extension(), + case reltool_utils:default_val(Mod#mod.debug_info, DebugInfo) of + keep -> + {copy_file, File}; + strip -> + {strip_beam, File} + end. + +spec_app_file(#app{name = Name, + info = Info, + mods = Mods, + app_file = AppFile} = App, + #sys{app_file = SysAppFile}, + EbinDir) -> + AppFilename = atom_to_list(Name) ++ ".app", + case reltool_utils:default_val(AppFile, SysAppFile) of + keep -> + %% Copy if it exists + spec_opt_copy_file(EbinDir, AppFilename); + strip -> + %% Remove non-included modules + %% Generate new file + ModNames = [M#mod.name || M <- Mods, + M#mod.is_included, + lists:member(M#mod.name, + Info#app_info.modules)], + App2 = App#app{info = Info#app_info{modules = ModNames}}, + Contents = gen_app(App2), + AppIoList = io_lib:format("%% app generated at ~w ~w\n~p.\n\n", + [date(), time(), Contents]), + [{write_file, AppFilename, AppIoList}]; + all -> + %% Include all included modules + %% Generate new file + ModNames = [M#mod.name || M <- Mods, M#mod.is_included], + App2 = App#app{info = Info#app_info{modules = ModNames}}, + Contents = gen_app(App2), + AppIoList = io_lib:format("%% app generated at ~w ~w\n~p.\n\n", + [date(), time(), Contents]), + [{write_file, AppFilename, AppIoList}] + + end. + +spec_opt_copy_file(DirName, BaseName) -> + case filelib:is_regular(filename:join([DirName, BaseName]), erl_prim_loader) of + true -> [{copy_file, BaseName}]; + false -> [] + end. + +spec_create_dir(RootDir, SourceDir, BaseDir, Files) -> + LibDir = filename:join([RootDir, "lib"]), + case abs_to_rel_path(LibDir, SourceDir) of + {relative, Dir} -> {create_dir, Dir, Files}; + {absolute, Dir} -> {create_dir, BaseDir, Dir, Files} + end. + +abs_to_rel_path(RootDir, SourcePath) -> + R = filename:split(RootDir), + S = filename:split(SourcePath), + abs_to_rel_path(R, S, SourcePath). + +abs_to_rel_path([H | R], [H | S], SourcePath) -> + abs_to_rel_path(R, S, SourcePath); +abs_to_rel_path([], S, _SourcePath) -> + {relative, filename:join(S)}; +abs_to_rel_path(_, _, SourcePath) -> + {absolute, SourcePath}. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% Evaluate specification +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +eval_spec(Spec, SourceDir, TargetDir) -> + SourceDir2 = filename:absname(SourceDir), + TargetDir2 = filename:absname(TargetDir), + try + case filelib:is_dir(TargetDir2) of + true -> + do_eval_spec(Spec, SourceDir2, SourceDir2, TargetDir2), + ok; + false -> + {error, TargetDir2 ++ ": " ++ file:format_error(enoent)} + end + catch + throw:{error, Text} -> + cleanup_spec(Spec, TargetDir2), + {error, Text} + end. + +do_eval_spec(List, OrigSourceDir, SourceDir, TargetDir) when is_list(List) -> + lists:foreach(fun(F) -> do_eval_spec(F, OrigSourceDir, SourceDir, TargetDir) end, List); +%% do_eval_spec({source_dir, SourceDir2, Spec}, OrigSourceDir, _SourceDir, TargetDir) -> +%% %% Source dir is absolute or relative the original source dir +%% SourceDir3 = filename:join([OrigSourceDir, SourceDir2]), +%% do_eval_spec(Spec, OrigSourceDir, SourceDir3, TargetDir); +do_eval_spec({create_dir, Dir, Files}, OrigSourceDir, SourceDir, TargetDir) -> + SourceDir2 = filename:join([SourceDir, Dir]), + TargetDir2 = filename:join([TargetDir, Dir]), + reltool_utils:create_dir(TargetDir2), + do_eval_spec(Files, OrigSourceDir, SourceDir2, TargetDir2); +do_eval_spec({create_dir, NewDir, OldDir, Files}, OrigSourceDir, _SourceDir, TargetDir) -> + SourceDir2 = filename:join([OrigSourceDir, OldDir]), + TargetDir2 = filename:join([TargetDir, NewDir]), + reltool_utils:create_dir(TargetDir2), + do_eval_spec(Files, SourceDir2, SourceDir2, TargetDir2); +do_eval_spec({archive, Archive, Options, Files}, OrigSourceDir, SourceDir, TargetDir) -> + TmpSpec = {create_dir, "tmp", Files}, + TmpDir = filename:join([TargetDir, "tmp"]), + reltool_utils:create_dir(TmpDir), + do_eval_spec(Files, OrigSourceDir, SourceDir, TmpDir), + + ArchiveFile = filename:join([TargetDir, Archive]), + Files2 = [element(2, F) || F <- Files], + Res = zip:create(ArchiveFile, Files2, [{cwd, TmpDir} | Options]), + + cleanup_spec(TmpSpec, TargetDir), + case Res of + {ok, _} -> + ok; + {error, Reason} -> + reltool_utils:throw_error("create archive ~s: ~p\n", [ArchiveFile, Reason]) + end; +do_eval_spec({copy_file, File}, _OrigSourceDir, SourceDir, TargetDir) -> + SourceFile = filename:join([SourceDir, File]), + TargetFile = filename:join([TargetDir, File]), + reltool_utils:copy_file(SourceFile, TargetFile); +do_eval_spec({copy_file, NewFile, OldFile}, OrigSourceDir, _SourceDir, TargetDir) -> + SourceFile = filename:join([OrigSourceDir, OldFile]), + TargetFile = filename:join([TargetDir, NewFile]), + reltool_utils:copy_file(SourceFile, TargetFile); +do_eval_spec({write_file, File, IoList}, _OrigSourceDir, _SourceDir, TargetDir) -> + TargetFile = filename:join([TargetDir, File]), + reltool_utils:write_file(TargetFile, IoList); +do_eval_spec({strip_beam, File}, _OrigSourceDir, SourceDir, TargetDir) -> + SourceFile = filename:join([SourceDir, File]), + TargetFile = filename:join([TargetDir, File]), + BeamBin = reltool_utils:read_file(SourceFile), + {ok, {_, BeamBin2}} = beam_lib:strip(BeamBin), + reltool_utils:write_file(TargetFile, BeamBin2). + +cleanup_spec(List, TargetDir) when is_list(List) -> + lists:foreach(fun(F)-> cleanup_spec(F, TargetDir) end, List); +%% cleanup_spec({source_dir, _SourceDir, Spec}, TargetDir) -> +%% cleanup_spec(Spec, TargetDir); +cleanup_spec({create_dir, Dir, Files}, TargetDir) -> + TargetDir2 = filename:join([TargetDir, Dir]), + cleanup_spec(Files, TargetDir2), + file:del_dir(TargetDir2); +cleanup_spec({create_dir, NewDir, _OldDir, Files}, TargetDir) -> + TargetDir2 = filename:join([TargetDir, NewDir]), + cleanup_spec(Files, TargetDir2), + file:del_dir(TargetDir2); +cleanup_spec({archive, Archive, _Options, Files}, TargetDir) -> + TargetFile = filename:join([TargetDir, Archive]), + file:delete(TargetFile), + TmpDir = filename:join([TargetDir, "tmp"]), + cleanup_spec(Files, TmpDir), + file:del_dir(TmpDir); +cleanup_spec({copy_file, File}, TargetDir) -> + TargetFile = filename:join([TargetDir, File]), + file:delete(TargetFile); +cleanup_spec({copy_file, NewFile, _OldFile}, TargetDir) -> + TargetFile = filename:join([TargetDir, NewFile]), + file:delete(TargetFile); +cleanup_spec({write_file, File, _IoList}, TargetDir) -> + TargetFile = filename:join([TargetDir, File]), + file:delete(TargetFile); +cleanup_spec({strip_beam, File}, TargetDir) -> + TargetFile = filename:join([TargetDir, File]), + file:delete(TargetFile). + +filter_spec(List, InclRegexps, ExclRegexps) -> + do_filter_spec("", List, InclRegexps, ExclRegexps). + +do_filter_spec(Path, List, InclRegexps, ExclRegexps) when is_list(List) -> + lists:zf(fun(File) -> do_filter_spec(Path, File, InclRegexps, ExclRegexps) end, List); +%% do_filter_spec(Path, {source_dir, _SourceDir, Spec}, InclRegexps, ExclRegexps) -> +%% do_filter_spec(Path, Spec, InclRegexps, ExclRegexps); +do_filter_spec(Path, {create_dir, Dir, Files}, InclRegexps, ExclRegexps) -> + Path2 = opt_join(Path, Dir), + case do_filter_spec(Path2, Files, InclRegexps, ExclRegexps) of + [] -> + case match(Path2, InclRegexps, ExclRegexps) of + true -> + {true, {create_dir, Dir, []}}; + false -> + false + end; + Files2 when is_list(Files2) -> + {true, {create_dir, Dir, Files2}} + end; +do_filter_spec(Path, {create_dir, NewDir, OldDir, Files}, InclRegexps, ExclRegexps) -> + Path2 = opt_join(Path, NewDir), + case do_filter_spec(Path2, Files, InclRegexps, ExclRegexps) of + [] -> + case match(Path2, InclRegexps, ExclRegexps) of + true -> + {true, {create_dir, NewDir, OldDir, []}}; + false -> + false + end; + Files2 when is_list(Files2) -> + {true, {create_dir, NewDir, OldDir, Files2}} + end; +do_filter_spec(Path, {archive, Archive, Options, Files}, InclRegexps, ExclRegexps) -> + case do_filter_spec(Path, Files, InclRegexps, ExclRegexps) of + [] -> + case match(Path, InclRegexps, ExclRegexps) of + true -> + {true, {archive, Archive, Options, []}}; + false -> + false + end; + Files2 when is_list(Files2) -> + {true, {archive, Archive, Options, Files2}} + end; +do_filter_spec(Path, {copy_file, File}, InclRegexps, ExclRegexps) -> + Path2 = opt_join(Path, File), + match(Path2, InclRegexps, ExclRegexps); +do_filter_spec(Path, {copy_file, NewFile, _OldFile}, InclRegexps, ExclRegexps) -> + Path2 = opt_join(Path, NewFile), + match(Path2, InclRegexps, ExclRegexps); +do_filter_spec(Path, {write_file, File, _IoList}, InclRegexps, ExclRegexps) -> + Path2 = opt_join(Path, File), + match(Path2, InclRegexps, ExclRegexps); +do_filter_spec(Path, {strip_beam, File}, InclRegexps, ExclRegexps) -> + Path2 = opt_join(Path, File), + match(Path2, InclRegexps, ExclRegexps). + +opt_join([], File) -> + File; +opt_join(Path, File) -> + filename:join([Path, File]). + +match(String, InclRegexps, ExclRegexps) -> + %%case + match(String, InclRegexps) andalso not match(String, ExclRegexps). +%% of +%% true -> +%% true; +%% false -> +%% io:format("no match: ~p\n" +%% " incl: ~p\n" +%% " excl: ~p\n", +%% [String, InclRegexps, ExclRegexps]), +%% false +%% end. + +%% Match at least one regexp +match(_String, []) -> + false; +match(String, [#regexp{source = _, compiled = MP} | Regexps]) -> + %% io:format("Regexp: ~p ~p\n", [String, Regexp]), + case re:run(String, MP, [{capture, none}]) of + nomatch -> match(String, Regexps); + match -> true + end. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +install(RelName, TargetDir) -> + try + do_install(RelName, TargetDir) + catch + throw:{error, Text} -> + {error, Text} + end. + +do_install(RelName, TargetDir) -> + TargetDir2 = filename:absname(TargetDir), + RelDir = filename:join([TargetDir2, "releases"]), + DataFile = filename:join([RelDir, "start_erl.data"]), + Bin = reltool_utils:read_file(DataFile), + case string:tokens(binary_to_list(Bin), " \n") of + [ErlVsn, RelVsn | _] -> + ErtsBinDir = filename:join([TargetDir2, "erts-" ++ ErlVsn, "bin"]), + BinDir = filename:join([TargetDir2, "bin"]), + case os:type() of + {win32, _} -> + NativeRootDir = filename:nativename(TargetDir2), + %% NativeBinDir = filename:nativename(filename:join([BinDir, "win32"])), + NativeBinDir = filename:nativename(BinDir), + IniData = ["[erlang]\r\n", + "Bindir=", NativeBinDir, "\r\n", + "Progname=erl\r\n", + "Rootdir=", NativeRootDir, "\r\n"], + IniFile = filename:join([BinDir, "erl.ini"]), + ok = file:write_file(IniFile, IniData); + _ -> + subst_src_scripts(start_scripts(), ErtsBinDir, BinDir, + [{"FINAL_ROOTDIR", TargetDir2}, {"EMU", "beam"}], + [preserve]) + end, + RelFile = filename:join([RelDir, RelVsn, RelName ++ ".rel"]), + ok = release_handler:create_RELEASES(TargetDir2, RelFile), + ok; + _ -> + reltool_utils:throw_error("~s: Illegal syntax.\n", [DataFile]) + end. + +subst_src_scripts(Scripts, SrcDir, DestDir, Vars, Opts) -> + Fun = fun(Script) -> subst_src_script(Script, SrcDir, DestDir, Vars, Opts) end, + lists:foreach(Fun, Scripts). + +subst_src_script(Script, SrcDir, DestDir, Vars, Opts) -> + subst_file(filename:join([SrcDir, Script ++ ".src"]), + filename:join([DestDir, Script]), + Vars, + Opts). + +subst_file(Src, Dest, Vars, Opts) -> + Bin = reltool_utils:read_file(Src), + Chars = subst(binary_to_list(Bin), Vars), + reltool_utils:write_file(Dest, Chars), + case lists:member(preserve, Opts) of + true -> + FileInfo = reltool_utils:read_file_info(Src), + reltool_utils:write_file_info(Dest, FileInfo); + false -> + ok + end. + +%% subst(Str, Vars) +%% Vars = [{Var, Val}] +%% Var = Val = string() +%% Substitute all occurrences of %Var% for Val in Str, using the list +%% of variables in Vars. +%% +subst(Str, Vars) -> + subst(Str, Vars, []). + +subst([$%, C | Rest], Vars, Result) when $A =< C, C =< $Z -> + subst_var([C| Rest], Vars, Result, []); +subst([$%, C | Rest], Vars, Result) when $a =< C, C =< $z -> + subst_var([C| Rest], Vars, Result, []); +subst([$%, C | Rest], Vars, Result) when C == $_ -> + subst_var([C| Rest], Vars, Result, []); +subst([C| Rest], Vars, Result) -> + subst(Rest, Vars, [C| Result]); +subst([], _Vars, Result) -> + lists:reverse(Result). + +subst_var([$%| Rest], Vars, Result, VarAcc) -> + Key = lists:reverse(VarAcc), + case lists:keysearch(Key, 1, Vars) of + {value, {Key, Value}} -> + subst(Rest, Vars, lists:reverse(Value, Result)); + false -> + subst(Rest, Vars, [$% | VarAcc ++ [$% | Result]]) + end; +subst_var([C| Rest], Vars, Result, VarAcc) -> + subst_var(Rest, Vars, Result, [C| VarAcc]); +subst_var([], Vars, Result, VarAcc) -> + subst([], Vars, [VarAcc ++ [$% | Result]]). + + +start_scripts() -> + ["erl", "start", "start_erl"]. diff --git a/lib/reltool/src/reltool_utils.erl b/lib/reltool/src/reltool_utils.erl new file mode 100644 index 0000000000..8d52ade9be --- /dev/null +++ b/lib/reltool/src/reltool_utils.erl @@ -0,0 +1,555 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 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(reltool_utils). + +%% Public +-compile([export_all]). + +-include_lib("kernel/include/file.hrl"). +-include_lib("wx/include/wx.hrl"). +-include("reltool.hrl"). + +root_dir() -> + code:root_dir(). + +erl_libs() -> + case os:getenv("ERL_LIBS") of + false -> + []; + LibStr -> + string:tokens(LibStr, ":;") + end. + +lib_dirs(Dir) -> + case erl_prim_loader:list_dir(Dir) of + {ok, Files} -> + [F || F <- Files, + filelib:is_dir(filename:join([Dir, F]), + erl_prim_loader)]; + error -> + [] + end. + +%% "asn1-1.6.2" -> {"asn1", "1.6.2"}; "asn1" -> {"asn1", ""} +split_app_name(Name) -> + Pred = + fun(Elem) -> + if + Elem =:= $\. -> true; + Elem >= $0, Elem =< $9 -> true; + true -> false + end + end, + case lists:splitwith(Pred, lists:reverse(Name)) of + {Vsn, [$- | App]} -> + {list_to_atom(lists:reverse(App)), lists:reverse(Vsn)}; + _ -> + {list_to_atom(Name), ""} + end. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +prim_consult(Bin) when is_binary(Bin) -> + case erl_scan:string(binary_to_list(Bin)) of + {ok, Tokens, _EndLine} -> + prim_parse(Tokens, []); + {error, {_ErrorLine, Module, Reason}, _EndLine} -> + {error, Module:format_error(Reason)} + end; +prim_consult(FullName) when is_list(FullName) -> + case erl_prim_loader:get_file(FullName) of + {ok, Bin, _} -> + prim_consult(Bin); + error -> + {error, file:format_error(enoent)} + end. + +prim_parse(Tokens, Acc) -> + case lists:splitwith(fun(T) -> element(1,T) =/= dot end, Tokens) of + {[], []} -> + {ok, lists:reverse(Acc)}; + {Tokens2, [{dot,_} = Dot | Rest]} -> + case erl_parse:parse_term(Tokens2 ++ [Dot]) of + {ok, Term} -> + prim_parse(Rest, [Term | Acc]); + {error, {_ErrorLine, Module, Reason}} -> + {error, Module:format_error(Reason)} + end; + {Tokens2, []} -> + case erl_parse:parse_term(Tokens2) of + {ok, Term} -> + {ok, lists:reverse([Term | Acc])}; + {error, {_ErrorLine, Module, Reason}} -> + {error, Module:format_error(Reason)} + end + end. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +default_rels() -> + Kernel = #rel_app{name = kernel, incl_apps = []}, + Stdlib = #rel_app{name = stdlib, incl_apps = []}, + Sasl = #rel_app{name = sasl, incl_apps = []}, + [ + #rel{name = ?DEFAULT_REL_NAME, + vsn = "1.0", + rel_apps = [Kernel, Stdlib]}, + #rel{name = "start_sasl", + vsn = "1.0", + rel_apps = [Kernel, Sasl, Stdlib]} + ]. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +assign_image_list(ListCtrl) -> + Art = wxImageList:new(16,16), + [wxImageList:add(Art, wxArtProvider:getBitmap(Image, [{size, {16,16}}])) + || Image <- ["wxART_ERROR", + "wxART_WARNING", + "wxART_QUESTION", + "wxART_TICK_MARK", + "wxART_CROSS_MARK", + "wxART_GO_HOME"]], + wxListCtrl:assignImageList(ListCtrl, Art, ?wxIMAGE_LIST_SMALL). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +get_latest_resize(#wx{obj = ObjRef, event = #wxSize{}} = Wx) -> + receive + #wx{obj = ObjRef, event = #wxSize{}} = Wx2 -> + get_latest_resize(Wx2) + after 10 -> + Wx + end. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +mod_conds() -> + ["all (ebin + app file)", "ebin + derived", "app file + derived", "derived", "none"]. + +list_to_mod_cond(List) -> + case List of + "all" ++ _ -> all; + "ebin" ++ _ -> ebin; + "app" ++ _ -> app; + "derived" -> derived; + "none" -> none + end. + +mod_cond_to_index(ModCond) -> + case ModCond of + all -> 0; + ebin -> 1; + app -> 2; + derived -> 3; + undefined -> 3; + none -> 4 + end. + +incl_conds() -> + ["include", "exclude", "derived"]. + +list_to_incl_cond(List) -> + case List of + "include" -> include; + "exclude" -> exclude; + "derived" -> derived + end. + +incl_cond_to_index(ModCond) -> + case ModCond of + include -> 0; + exclude -> 1; + derived -> 2 + end. + +elem_to_index(Elem, List) -> + elem_to_index(Elem, List, 1). + +elem_to_index(Elem, [H | T], Index) -> + case Elem =:= H of + true -> Index; + false -> elem_to_index(Elem, T, Index + 1) + end; +elem_to_index(Elem, [], _) -> + erlang:error({not_found, Elem}). + +app_dir_test(Dir1, Dir2) -> + {Name1, Vsn1, Parent1} = split_app_dir(Dir1), + {Name2, Vsn2, Parent2} = split_app_dir(Dir2), + if + Name1 < Name2 -> true; + Name1 > Name2 -> false; + Vsn1 < Vsn2 -> false; + Vsn1 > Vsn2 -> true; + Parent1 < Parent2 -> true; + true -> false + end. + +split_app_dir(Dir) -> + ParentDir = filename:dirname(Dir), + Base = filename:basename(Dir), + {Name, Vsn} = split_app_name(Base), + Vsn2 = + try + [list_to_integer(N) || N <- string:tokens(Vsn, ".")] + catch + _:_ -> + Vsn + end, + {Name, Vsn2, ParentDir}. + +get_item(ListCtrl) -> + case wxListCtrl:getItemCount(ListCtrl) of + 0 -> + undefined; + _ -> + case wxListCtrl:getNextItem(ListCtrl, + -1, + [{geometry, ?wxLIST_NEXT_ALL}, + {state, ?wxLIST_STATE_SELECTED}]) of + -1 -> + ItemNo = wxListCtrl:getTopItem(ListCtrl), + case wxListCtrl:getItemText(ListCtrl, ItemNo) of + "" -> + undefined; + Text -> + {ItemNo, Text} + end; + ItemNo -> + Text = wxListCtrl:getItemText(ListCtrl, ItemNo), + {ItemNo, Text} + end + end. + +get_items(ListCtrl) -> + case wxListCtrl:getItemCount(ListCtrl) of + 0 -> + []; + Count -> + case get_selected_items(ListCtrl, -1, []) of + [] -> + ItemNo = wxListCtrl:getTopItem(ListCtrl), + case wxListCtrl:getItemText(ListCtrl, ItemNo) of + "" -> + []; + Text when Text =/= ?MISSING_APP_TEXT -> + [{ItemNo, Text}]; + _MissingText when Count > 1 -> + case wxListCtrl:getItemText(ListCtrl, ItemNo + 1) of + "" -> + []; + Text -> + [{ItemNo, Text}] + end; + _MissingText -> + [] + end; + Items -> + Items + end + end. + +get_selected_items(ListCtrl, PrevItem, Acc) -> + case wxListCtrl:getNextItem(ListCtrl, + PrevItem, + [{geometry, ?wxLIST_NEXT_ALL}, + {state, ?wxLIST_STATE_SELECTED}]) of + -1 -> + Acc; + ItemNo -> + case wxListCtrl:getItemText(ListCtrl, ItemNo) of + Text when Text =/= ?MISSING_APP_TEXT -> + get_selected_items(ListCtrl, ItemNo, [{ItemNo, Text} | Acc]); + _Text -> + get_selected_items(ListCtrl, ItemNo, Acc) + end + end. + +select_items(_ListCtrl, _OldItems, []) -> + %% No new items. Nothing to select. + false; +select_items(ListCtrl, [], Items) -> + %% No old selection. Select first. + select_item(ListCtrl, Items); +select_items(ListCtrl, _OldItems, [Item]) -> + %% Only one new item. Select it. + select_item(ListCtrl, [Item]); +select_items(ListCtrl, OldItems, NewItems) -> + %% Try to propagate old selection to new items. + Filter = + fun({_OldItemNo, Text}) -> + case lists:keysearch(Text, 2, NewItems) of + {value, Item} -> {true, Item}; + false -> false + end + end, + case lists:zf(Filter, OldItems) of + [] -> + %% None of the old selections are valid. Select the first. + select_item(ListCtrl, NewItems); + ValidItems -> + %% Some old selections are still valid. Select them again. + lists:foreach(fun(Item) -> select_item(ListCtrl, [Item]) end, ValidItems) + end. + +select_item(ListCtrl, [{ItemNo, Text} | Items]) -> + case Text =:= ?MISSING_APP_TEXT of + true -> + select_item(ListCtrl, Items); + false -> + StateMask = ?wxLIST_STATE_SELECTED, + State = wxListCtrl:getItemState(ListCtrl, ItemNo, StateMask), + State2 = State bor ?wxLIST_STATE_SELECTED, + wxListCtrl:setItemState(ListCtrl, ItemNo, State2, StateMask), + wxListCtrl:refreshItem(ListCtrl, ItemNo) + end; +select_item(_ListCtrl, []) -> + ok. + +safe_keysearch(Key, Pos, List, Mod, Line) -> + case lists:keysearch(Key, Pos, List) of + false -> + io:format("~p(~p): lists:keysearch(~p, ~p, ~p) -> false\n", + [Mod, Line, Key, Pos, List]), + erlang:error({Mod, Line, lists, keysearch, [Key, Pos, List]}); + {value, Val} -> + Val + end. + +print(X, X, Format, Args) -> + io:format(Format, Args); +print(_, _, _, _) -> + ok. + +%% -define(SAFE(M,F,A), safe(M, F, A, ?MODULE, ?LINE)). +%% +%% safe(M, F, A, Mod, Line) -> +%% case catch apply(M, F, A) of +%% {'EXIT', Reason} -> +%% io:format("~p(~p): ~p:~p~p -> ~p\n", [Mod, Line, M, F, A, Reason]), +%% timer:sleep(infinity); +%% Res -> +%% Res +%% end. + +return_first_error(Status, NewError) when is_list(NewError) -> + case Status of + {ok, _Warnings} -> + {error, NewError}; + {error, OldError} -> + {error, OldError} + end. + +add_warning(Status, Warning) -> + case Status of + {ok, Warnings} -> + {ok, [Warning | Warnings]}; + {error, Error} -> + {error, Error} + end. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +create_dir(Dir) -> + filelib:ensure_dir(Dir), + case file:make_dir(Dir) of + ok -> + ok; + {error, eexist} -> + ok; + {error, Reason} -> + Text = file:format_error(Reason), + throw_error("create dir ~s: ~s\n", [Dir, Text]) + end. + +list_dir(Dir) -> + case erl_prim_loader:list_dir(Dir) of + {ok, Files} -> + Files; + error -> + Text = file:format_error(enoent), + throw_error("list dir ~s: ~s\n", [Dir, Text]) + end. + +read_file_info(File) -> + case file:read_file_info(File) of + {ok, Info} -> + Info; + {error, Reason} -> + Text = file:format_error(Reason), + throw_error("read file info ~s: ~s\n", [File, Text]) + end. + +write_file_info(File, Info) -> + case file:write_file_info(File, Info) of + ok -> + ok; + {error, Reason} -> + Text = file:format_error(Reason), + throw_error("write file info ~s: ~s\n", [File, Text]) + end. + +read_file(File) -> + case file:read_file(File) of + {ok, Bin} -> + Bin; + {error, Reason} -> + Text = file:format_error(Reason), + throw_error("read file ~s: ~s\n", [File, Text]) + end. + +write_file(File, IoList) -> + case file:write_file(File, IoList) of + ok -> + ok; + {error, Reason} -> + Text = file:format_error(Reason), + throw_error("write file ~s: ~s\n", [File, Text]) + end. + +recursive_delete(Dir) -> + case filelib:is_dir(Dir) of + true -> + case file:list_dir(Dir) of + {ok, Files} -> + Fun = fun(F) -> recursive_delete(filename:join([Dir, F])) end, + lists:foreach(Fun, Files), + delete(Dir, directory); + {error, enoent} -> + ok; + {error, Reason} -> + Text = file:format_error(Reason), + throw_error("delete file ~s: ~s\n", [Dir, Text]) + end; + false -> + delete(Dir, regular) + end. + +delete(File, Type) -> + case do_delete(File, Type) of + ok -> + ok; + {error, enoent} -> + ok; + {error, Reason} -> + Text = file:format_error(Reason), + throw_error("delete file ~s: ~s\n", [File, Text]) + end. + +do_delete(File, regular) -> + file:delete(File); +do_delete(Dir, directory) -> + file:del_dir(Dir). + +recursive_copy_file(From, To) -> + case erl_prim_loader:list_dir(From) of + {ok, Files} -> + %% Copy all files in the directory + create_dir(To), + Copy = + fun(F) -> + recursive_copy_file(filename:join([From, F]), + filename:join([To, F])) + end, + lists:foreach(Copy, Files); + error -> + %% Copy single file + copy_file(From, To) + end. + +copy_file(From, To) -> + case erl_prim_loader:get_file(From) of + {ok, Bin, _} -> + case file:write_file(To, Bin) of + ok -> + FromInfo = read_file_info(From), + ToInfo = read_file_info(To), + FromMode = FromInfo#file_info.mode, + ToMode = ToInfo#file_info.mode, + ToMode2 = FromMode bor ToMode, + FileInfo = FromInfo#file_info{mode = ToMode2}, + write_file_info(To, FileInfo), + ok; + {error, Reason} -> + Text = file:format_error(Reason), + throw_error("copy file ~s -> ~s: ~s\n", [From, To, Text]) + end; + error -> + Text = file:format_error(enoent), + throw_error("copy file ~s -> ~s: ~s\n", [From, To, Text]) + end. + +throw_error(Format, Args) -> + throw({error, lists:flatten(io_lib:format(Format, Args))}). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +decode_regexps(Key, {add, Regexps}, Old) when is_list(Regexps) -> + do_decode_regexps(Key, Regexps, Old); +decode_regexps(_Key, {del, Regexps}, Old) when is_list(Regexps) -> + [Re || Re <- Old, not lists:member(Re#regexp.source, Regexps)]; +decode_regexps(Key, Regexps, _Old) when is_list(Regexps) -> + do_decode_regexps(Key, Regexps, []); +decode_regexps(Key, Regexps, _Old) when is_list(Regexps) -> + Text = lists:flatten(io_lib:format("~p", [{Key, Regexps}])), + throw({error, "Illegal option: " ++ Text}). + +do_decode_regexps(Key, [Regexp | Regexps], Acc) -> + case catch re:compile(Regexp, []) of + {ok, MP} -> + do_decode_regexps(Key, Regexps, [#regexp{source = Regexp, compiled = MP} | Acc]); + _ -> + Text = lists:flatten(io_lib:format("~p", [{Key, Regexp}])), + throw({error, "Illegal option: " ++ Text}) + end; +do_decode_regexps(_Key, [], Acc) -> + lists:sort(Acc). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +default_val(Val, Default) -> + case Val of + undefined -> Default; + _ -> Val + end. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +call(Name, Msg) when is_atom(Name) -> + call(whereis(Name), Msg); +call(Pid, Msg) when is_pid(Pid) -> + Ref = erlang:monitor(process, Pid), + Pid ! {call, self(), Ref, Msg}, + receive + {Ref, Reply} -> + Reply; + {'EXIT', Pid, Reason} -> + erlang:demonitor(Ref, [flush]), + {error, Reason}; + {'DOWN', Ref, _, _, Reason} -> + {error, Reason} + end. + +cast(Pid, Msg) -> + Pid ! {cast, self(), Msg}, + ok. + +reply(Pid, Ref, Msg) -> + Pid ! {Ref, Msg}. |