aboutsummaryrefslogtreecommitdiffstats
path: root/lib
diff options
context:
space:
mode:
Diffstat (limited to 'lib')
-rw-r--r--lib/compiler/src/cerl.erl32
-rw-r--r--lib/eunit/doc/overview.edoc11
-rw-r--r--lib/eunit/include/eunit.hrl16
-rw-r--r--lib/observer/src/observer_lib.erl19
-rw-r--r--lib/observer/src/observer_procinfo.erl8
-rw-r--r--lib/observer/src/observer_sys_wx.erl98
-rw-r--r--lib/observer/src/observer_wx.erl58
-rw-r--r--lib/observer/test/observer_SUITE.erl2
-rw-r--r--lib/os_mon/c_src/cpu_sup.c57
-rwxr-xr-xlib/public_key/priv/generate2
-rw-r--r--lib/ssl/src/ssl_connection.erl86
-rw-r--r--lib/stdlib/doc/src/ets.xml4
-rw-r--r--lib/tools/emacs/erlang-test.el107
-rw-r--r--lib/tools/emacs/erlang.el249
14 files changed, 525 insertions, 224 deletions
diff --git a/lib/compiler/src/cerl.erl b/lib/compiler/src/cerl.erl
index 6dc162db40..61abae344c 100644
--- a/lib/compiler/src/cerl.erl
+++ b/lib/compiler/src/cerl.erl
@@ -1955,7 +1955,7 @@ is_c_var(_) ->
false.
-%% @spec c_fname(Name::atom(), Arity::integer()) -> cerl()
+%% @spec c_fname(Name::atom(), Arity::arity()) -> cerl()
%% @equiv c_var({Name, Arity})
%% @see fname_id/1
%% @see fname_arity/1
@@ -1963,18 +1963,18 @@ is_c_var(_) ->
%% @see ann_c_fname/3
%% @see update_c_fname/3
--spec c_fname(atom(), non_neg_integer()) -> c_var().
+-spec c_fname(atom(), arity()) -> c_var().
c_fname(Atom, Arity) ->
c_var({Atom, Arity}).
-%% @spec ann_c_fname(As::[term()], Name::atom(), Arity::integer()) ->
+%% @spec ann_c_fname(As::[term()], Name::atom(), Arity::arity()) ->
%% cerl()
%% @equiv ann_c_var(As, {Atom, Arity})
%% @see c_fname/2
--spec ann_c_fname([term()], atom(), non_neg_integer()) -> c_var().
+-spec ann_c_fname([term()], atom(), arity()) -> c_var().
ann_c_fname(As, Atom, Arity) ->
ann_c_var(As, {Atom, Arity}).
@@ -1992,13 +1992,13 @@ update_c_fname(#c_var{name = {_, Arity}, anno = As}, Atom) ->
#c_var{name = {Atom, Arity}, anno = As}.
-%% @spec update_c_fname(Old::cerl(), Name::atom(), Arity::integer()) ->
+%% @spec update_c_fname(Old::cerl(), Name::atom(), Arity::arity()) ->
%% cerl()
%% @equiv update_c_var(Old, {Atom, Arity})
%% @see update_c_fname/2
%% @see c_fname/2
--spec update_c_fname(c_var(), atom(), integer()) -> c_var().
+-spec update_c_fname(c_var(), atom(), arity()) -> c_var().
update_c_fname(Node, Atom, Arity) ->
update_c_var(Node, {Atom, Arity}).
@@ -2047,14 +2047,14 @@ fname_id(#c_var{name={A,_}}) ->
A.
-%% @spec fname_arity(cerl()) -> byte()
+%% @spec fname_arity(cerl()) -> arity()
%%
%% @doc Returns the arity part of an abstract function name variable.
%%
%% @see fname_id/1
%% @see c_fname/2
--spec fname_arity(c_var()) -> byte().
+-spec fname_arity(c_var()) -> arity().
fname_arity(#c_var{name={_,N}}) ->
N.
@@ -2500,7 +2500,7 @@ fun_body(Node) ->
Node#c_fun.body.
-%% @spec fun_arity(Node::cerl()) -> integer()
+%% @spec fun_arity(Node::cerl()) -> arity()
%%
%% @doc Returns the number of parameter subtrees of an abstract
%% fun-expression.
@@ -2511,7 +2511,7 @@ fun_body(Node) ->
%% @see c_fun/2
%% @see fun_vars/1
--spec fun_arity(c_fun()) -> non_neg_integer().
+-spec fun_arity(c_fun()) -> arity().
fun_arity(Node) ->
length(fun_vars(Node)).
@@ -3418,7 +3418,7 @@ apply_args(Node) ->
Node#c_apply.args.
-%% @spec apply_arity(Node::cerl()) -> integer()
+%% @spec apply_arity(Node::cerl()) -> arity()
%%
%% @doc Returns the number of argument subtrees of an abstract
%% function application.
@@ -3430,7 +3430,7 @@ apply_args(Node) ->
%% @see c_apply/2
%% @see apply_args/1
--spec apply_arity(c_apply()) -> non_neg_integer().
+-spec apply_arity(c_apply()) -> arity().
apply_arity(Node) ->
length(apply_args(Node)).
@@ -3536,7 +3536,7 @@ call_args(Node) ->
Node#c_call.args.
-%% @spec call_arity(Node::cerl()) -> integer()
+%% @spec call_arity(Node::cerl()) -> arity()
%%
%% @doc Returns the number of argument subtrees of an abstract
%% inter-module call.
@@ -3548,7 +3548,7 @@ call_args(Node) ->
%% @see c_call/3
%% @see call_args/1
--spec call_arity(c_call()) -> non_neg_integer().
+-spec call_arity(c_call()) -> arity().
call_arity(Node) ->
length(call_args(Node)).
@@ -3640,7 +3640,7 @@ primop_args(Node) ->
Node#c_primop.args.
-%% @spec primop_arity(Node::cerl()) -> integer()
+%% @spec primop_arity(Node::cerl()) -> arity()
%%
%% @doc Returns the number of argument subtrees of an abstract
%% primitive operation call.
@@ -3652,7 +3652,7 @@ primop_args(Node) ->
%% @see c_primop/2
%% @see primop_args/1
--spec primop_arity(c_primop()) -> non_neg_integer().
+-spec primop_arity(c_primop()) -> arity().
primop_arity(Node) ->
length(primop_args(Node)).
diff --git a/lib/eunit/doc/overview.edoc b/lib/eunit/doc/overview.edoc
index ca7ffb83a4..3a46e991cb 100644
--- a/lib/eunit/doc/overview.edoc
+++ b/lib/eunit/doc/overview.edoc
@@ -690,11 +690,12 @@ it like `debugMsg'. The result is always `ok'.</dd>
<dt>`debugVal(Expr)'</dt>
<dd>Prints both the source code for `Expr' and its current value. E.g.,
`?debugVal(f(X))' might be displayed as "`f(X) = 42'". (Large terms are
-shown truncated.) The result is always the value of `Expr', so this
-macro can be wrapped around any expression to display its value when
-the code is compiled with debugging enabled.</dd>
-<dt>`debugValAll(Expr)'</dt>
-<dd>This is almost same as `debugVal(Expr)`, but doesn't truncate terms to print.</dd>
+truncated to the depth given by the macro `EUNIT_DEBUG_VAL_DEPTH', which
+defaults to 15 but can be overridden by the user.) The result is always the
+value of `Expr', so this macro can be wrapped around any expression to
+display its value when the code is compiled with debugging enabled.</dd>
+<dt>`debugVal(Expr, Depth)'</dt>
+<dd>Like `debugVal(Expr)', but prints terms truncated to the given depth.</dd>
<dt>`debugTime(Text,Expr)'</dt>
<dd>Prints `Text' and the wall clock time for evaluation of `Expr'. The
result is always the value of `Expr', so this macro can be wrapped
diff --git a/lib/eunit/include/eunit.hrl b/lib/eunit/include/eunit.hrl
index b6dbe2d706..7fd6c206a4 100644
--- a/lib/eunit/include/eunit.hrl
+++ b/lib/eunit/include/eunit.hrl
@@ -223,20 +223,18 @@
end).
-define(debugHere, (?debugMsg("<-"))).
-define(debugFmt(S, As), (?debugMsg(io_lib:format((S), (As))))).
--define(debugVal(E),
+-define(debugVal(E, D),
begin
((fun (__V) ->
- ?debugFmt(<<"~ts = ~tP">>, [(??E), __V, 15]),
- __V
- end)(E))
- end).
--define(debugValAll(E),
- begin
- ((fun (__V) ->
- ?debugFmt(<<"~ts = ~tp">>, [(??E), __V]),
+ ?debugFmt(<<"~ts = ~tP">>,
+ [(??E), __V, D]),
__V
end)(E))
end).
+-ifndef(EUNIT_DEBUG_VAL_DEPTH).
+-define(EUNIT_DEBUG_VAL_DEPTH, 15).
+-endif.
+-define(debugVal(E), ?debugVal(E, ?EUNIT_DEBUG_VAL_DEPTH)).
-define(debugTime(S, E),
begin
((fun () ->
diff --git a/lib/observer/src/observer_lib.erl b/lib/observer/src/observer_lib.erl
index c6a1c73c83..7c1337025f 100644
--- a/lib/observer/src/observer_lib.erl
+++ b/lib/observer/src/observer_lib.erl
@@ -128,8 +128,8 @@ display_info(Frame, Info) ->
Add = fun(BoxInfo) ->
case create_box(Panel, BoxInfo) of
{Box, InfoFs} ->
- wxSizer:add(Sizer, Box, [{flag, ?wxEXPAND bor ?wxALL},
- {border, 5}]),
+ wxSizer:add(Sizer, Box,
+ [{flag, ?wxEXPAND bor ?wxALL}, {border, 5}]),
wxSizer:addSpacer(Sizer, 5),
InfoFs;
undefined ->
@@ -453,14 +453,19 @@ create_box(Parent, Data) ->
link_entry(Panel,Value);
_ ->
Value = to_str(Value0),
- TCtrl = wxStaticText:new(Panel, ?wxID_ANY,Value),
- length(Value) > 50 andalso
- wxWindow:setToolTip(TCtrl,wxToolTip:new(Value)),
- TCtrl
+ case length(Value) > 100 of
+ true ->
+ Shown = lists:sublist(Value, 80),
+ TCtrl = wxStaticText:new(Panel, ?wxID_ANY, [Shown,"..."]),
+ wxWindow:setToolTip(TCtrl,wxToolTip:new(Value)),
+ TCtrl;
+ false ->
+ wxStaticText:new(Panel, ?wxID_ANY, Value)
+ end
end,
wxSizer:add(Line, 10, 0), % space of size 10 horisontally
wxSizer:add(Line, Field, RightProportion),
- wxSizer:add(Box, Line, [{proportion,1},{flag,?wxEXPAND}]),
+ wxSizer:add(Box, Line, [{proportion,1}]),
Field;
(undefined) ->
undefined
diff --git a/lib/observer/src/observer_procinfo.erl b/lib/observer/src/observer_procinfo.erl
index cff5fbb474..fe2aa11450 100644
--- a/lib/observer/src/observer_procinfo.erl
+++ b/lib/observer/src/observer_procinfo.erl
@@ -370,7 +370,7 @@ process_info_fields(Pid) ->
{"Priority", priority},
{"Trap Exit", trap_exit},
{"Reductions", reductions},
- {"Binary", binary},
+ {"Binary", fun(Data) -> stringify_bins(Data) end},
{"Last Calls", last_calls},
{"Catch Level", catchlevel},
{"Trace", trace},
@@ -437,6 +437,11 @@ filter_monitor_info() ->
[Pid || {process, Pid} <- Ms]
end.
+stringify_bins(Data) ->
+ Bins = proplists:get_value(binary, Data),
+ [lists:flatten(io_lib:format("<< ~s, refc ~w>>", [observer_lib:to_str({bytes,Sz}),Refc]))
+ || {_Ptr, Sz, Refc} <- Bins].
+
local_pid_str(Pid) ->
%% observer can observe remote nodes
%% There is no function to get the local
@@ -449,7 +454,6 @@ local_pid_str(Pid) ->
global_pid_node_pref(Pid) ->
%% Global PID node prefix : X of <X.Y.Z>
string:strip(string:sub_word(pid_to_list(Pid),1,$.),left,$<).
-
io_get_data(Pid) ->
Pid ! {self(), get_data_and_close},
diff --git a/lib/observer/src/observer_sys_wx.erl b/lib/observer/src/observer_sys_wx.erl
index b9b407cb0a..fa824995f7 100644
--- a/lib/observer/src/observer_sys_wx.erl
+++ b/lib/observer/src/observer_sys_wx.erl
@@ -48,40 +48,51 @@ start_link(Notebook, Parent) ->
init([Notebook, Parent]) ->
SysInfo = observer_backend:sys_info(),
- {Info, Stat} = info_fields(),
+ {Sys, Mem, Cpu, Stats} = info_fields(),
Panel = wxPanel:new(Notebook),
Sizer = wxBoxSizer:new(?wxVERTICAL),
- TopSizer = wxBoxSizer:new(?wxHORIZONTAL),
- {FPanel0, _FSizer0, Fields0} =
- observer_lib:display_info(Panel, observer_lib:fill_info(Info, SysInfo)),
- {FPanel1, _FSizer1, Fields1} =
- observer_lib:display_info(Panel, observer_lib:fill_info(Stat, SysInfo)),
- wxSizer:add(TopSizer, FPanel0, [{flag, ?wxEXPAND}, {proportion, 1}]),
- wxSizer:add(TopSizer, FPanel1, [{flag, ?wxEXPAND}, {proportion, 1}]),
+ HSizer0 = wxBoxSizer:new(?wxHORIZONTAL),
+ {FPanel0, _FSizer0, Fields0} = observer_lib:display_info(Panel, observer_lib:fill_info(Sys, SysInfo)),
+ {FPanel1, _FSizer1, Fields1} = observer_lib:display_info(Panel, observer_lib:fill_info(Mem, SysInfo)),
+ wxSizer:add(HSizer0, FPanel0, [{flag, ?wxEXPAND}, {proportion, 1}]),
+ wxSizer:add(HSizer0, FPanel1, [{flag, ?wxEXPAND}, {proportion, 1}]),
+
+ HSizer1 = wxBoxSizer:new(?wxHORIZONTAL),
+ {FPanel2, _FSizer2, Fields2} = observer_lib:display_info(Panel, observer_lib:fill_info(Cpu, SysInfo)),
+ {FPanel3, _FSizer3, Fields3} = observer_lib:display_info(Panel, observer_lib:fill_info(Stats, SysInfo)),
+ wxSizer:add(HSizer1, FPanel2, [{flag, ?wxEXPAND}, {proportion, 1}]),
+ wxSizer:add(HSizer1, FPanel3, [{flag, ?wxEXPAND}, {proportion, 1}]),
+
BorderFlags = ?wxLEFT bor ?wxRIGHT,
- wxSizer:add(Sizer, TopSizer, [{flag, ?wxEXPAND bor BorderFlags bor ?wxTOP},
- {proportion, 0}, {border, 5}]),
+ wxSizer:add(Sizer, HSizer0, [{flag, ?wxEXPAND bor BorderFlags bor ?wxTOP},
+ {proportion, 0}, {border, 5}]),
+ wxSizer:add(Sizer, HSizer1, [{flag, ?wxEXPAND bor BorderFlags bor ?wxBOTTOM},
+ {proportion, 0}, {border, 5}]),
wxPanel:setSizer(Panel, Sizer),
Timer = observer_lib:start_timer(10),
{Panel, #sys_wx_state{parent=Parent,
parent_notebook=Notebook,
panel=Panel, sizer=Sizer,
- timer=Timer, fields=Fields0 ++ Fields1}}.
+ timer=Timer, fields=Fields0 ++ Fields1++Fields2++Fields3}}.
create_sys_menu(Parent) ->
View = {"View", [#create_menu{id = ?ID_REFRESH, text = "Refresh\tCtrl-R"},
#create_menu{id = ?ID_REFRESH_INTERVAL, text = "Refresh interval"}]},
observer_wx:create_menus(Parent, [View]).
+update_syspage(#sys_wx_state{node = undefined}) -> ignore;
update_syspage(#sys_wx_state{node = Node, fields=Fields, sizer=Sizer}) ->
SysInfo = observer_wx:try_rpc(Node, observer_backend, sys_info, []),
- {Info, Stat} = info_fields(),
- observer_lib:update_info(Fields, observer_lib:fill_info(Info, SysInfo) ++
- observer_lib:fill_info(Stat, SysInfo)),
+ {Sys, Mem, Cpu, Stats} = info_fields(),
+ observer_lib:update_info(Fields,
+ observer_lib:fill_info(Sys, SysInfo) ++
+ observer_lib:fill_info(Mem, SysInfo) ++
+ observer_lib:fill_info(Cpu, SysInfo) ++
+ observer_lib:fill_info(Stats, SysInfo)),
wxSizer:layout(Sizer).
info_fields() ->
- Info = [{"System and Architecture",
+ Sys = [{"System and Architecture",
[{"System Version", otp_release},
{"ERTS Version", version},
{"Compiled for", system_architecture},
@@ -90,34 +101,35 @@ info_fields() ->
{"SMP Support", smp_support},
{"Thread Support", threads},
{"Async thread pool size", thread_pool_size}
- ]},
- {"CPU's and Threads",
- [{"Logical CPU's", logical_processors},
- {"Online Logical CPU's", logical_processors_online},
- {"Available Logical CPU's", logical_processors_available},
- {"Schedulers", schedulers},
- {"Online schedulers", schedulers_online},
- {"Available schedulers", schedulers_available}
- ]}
- ],
- Stat = [{"Memory Usage", right,
- [{"Total", {bytes, total}},
- {"Processes", {bytes, processes}},
- {"Atoms", {bytes, atom}},
- {"Binaries", {bytes, binary}},
- {"Code", {bytes, code}},
- {"ETS", {bytes, ets}}
- ]},
- {"Statistics", right,
- [{"Up time", {time_ms, uptime}},
- {"Max Processes", process_limit},
- {"Processes", process_count},
- {"Run Queue", run_queue},
- {"IO Input", {bytes, io_input}},
- {"IO Output", {bytes, io_output}}
- ]}
- ],
- {Info, Stat}.
+ ]}],
+
+ Cpu = [{"CPU's and Threads",
+ [{"Logical CPU's", logical_processors},
+ {"Online Logical CPU's", logical_processors_online},
+ {"Available Logical CPU's", logical_processors_available},
+ {"Schedulers", schedulers},
+ {"Online schedulers", schedulers_online},
+ {"Available schedulers", schedulers_available}
+ ]}
+ ],
+ Mem = [{"Memory Usage", right,
+ [{"Total", {bytes, total}},
+ {"Processes", {bytes, processes}},
+ {"Atoms", {bytes, atom}},
+ {"Binaries", {bytes, binary}},
+ {"Code", {bytes, code}},
+ {"ETS", {bytes, ets}}
+ ]}],
+ Stats = [{"Statistics", right,
+ [{"Up time", {time_ms, uptime}},
+ {"Max Processes", process_limit},
+ {"Processes", process_count},
+ {"Run Queue", run_queue},
+ {"IO Input", {bytes, io_input}},
+ {"IO Output", {bytes, io_output}}
+ ]}
+ ],
+ {Sys, Mem, Cpu, Stats}.
%%%%%%%%%%%%%%%%%%%%%%% Callbacks %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
diff --git a/lib/observer/src/observer_wx.erl b/lib/observer/src/observer_wx.erl
index eba603eab5..30bd4043e4 100644
--- a/lib/observer/src/observer_wx.erl
+++ b/lib/observer/src/observer_wx.erl
@@ -65,7 +65,8 @@
node,
nodes,
prev_node="",
- log = false
+ log = false,
+ reply_to=false
}).
start() ->
@@ -229,14 +230,13 @@ handle_event(#wx{id = ?ID_CDV, event = #wxCommand{type = command_menu_selected}}
spawn(crashdump_viewer, start, []),
{noreply, State};
-handle_event(#wx{event = #wxClose{}}, #state{log=LogOn} = State) ->
- LogOn andalso rpc:block_call(State#state.node, rb, stop, []),
- {stop, normal, State};
+handle_event(#wx{event = #wxClose{}}, State) ->
+ stop_servers(State),
+ {noreply, State};
-handle_event(#wx{id = ?wxID_EXIT, event = #wxCommand{type = command_menu_selected}},
- #state{log=LogOn} = State) ->
- LogOn andalso rpc:block_call(State#state.node, rb, stop, []),
- {stop, normal, State};
+handle_event(#wx{id = ?wxID_EXIT, event = #wxCommand{type = command_menu_selected}}, State) ->
+ stop_servers(State),
+ {noreply, State};
handle_event(#wx{id = ?wxID_HELP, event = #wxCommand{type = command_menu_selected}}, State) ->
External = "http://www.erlang.org/doc/apps/observer/index.html",
@@ -379,9 +379,9 @@ handle_call({get_attrib, Attrib}, _From, State) ->
handle_call(get_tracer, _From, State=#state{trace_panel=TraceP}) ->
{reply, TraceP, State};
-handle_call(stop, _, State = #state{frame = Frame}) ->
- wxFrame:destroy(Frame),
- {stop, normal, ok, State};
+handle_call(stop, From, State) ->
+ stop_servers(State),
+ {noreply, State#state{reply_to=From}};
handle_call(log_status, _From, State) ->
{reply, State#state.log, State};
@@ -426,17 +426,45 @@ handle_info({get_debug_info, From}, State = #state{notebook=Notebook, active_tab
From ! {observer_debug, wx:get_env(), Notebook, Pid},
{noreply, State};
-handle_info({'EXIT', Pid, _Reason}, State) ->
- io:format("Child (~s) crashed exiting: ~p ~p~n",
- [pid2panel(Pid, State), Pid,_Reason]),
+handle_info({'EXIT', Pid, Reason}, State) ->
+ case Reason of
+ normal ->
+ {noreply, State};
+ _ ->
+ io:format("Observer: Child (~s) crashed exiting: ~p ~p~n",
+ [pid2panel(Pid, State), Pid, Reason]),
+ {stop, normal, State}
+ end;
+
+handle_info({stop, Me}, State) when Me =:= self() ->
{stop, normal, State};
handle_info(_Info, State) ->
{noreply, State}.
-terminate(_Reason, #state{frame = Frame}) ->
+stop_servers(#state{node=Node, log=LogOn, sys_panel=Sys, pro_panel=Procs, tv_panel=TVs,
+ trace_panel=Trace, app_panel=Apps, perf_panel=Perfs,
+ allc_panel=Alloc} = _State) ->
+ LogOn andalso rpc:block_call(Node, rb, stop, []),
+ Me = self(),
+ Tabs = [Sys, Procs, TVs, Trace, Apps, Perfs, Alloc],
+ Stop = fun() ->
+ try
+ _ = [wx_object:stop(Panel) || Panel <- Tabs],
+ ok
+ catch _:_ -> ok
+ end,
+ Me ! {stop, Me}
+ end,
+ spawn(Stop).
+
+terminate(_Reason, #state{frame = Frame, reply_to=From}) ->
wxFrame:destroy(Frame),
wx:destroy(),
+ case From of
+ false -> ignore;
+ _ -> gen_server:reply(From, ok)
+ end,
ok.
code_change(_, _, State) ->
diff --git a/lib/observer/test/observer_SUITE.erl b/lib/observer/test/observer_SUITE.erl
index 3dc3e4772b..ae8111dcd6 100644
--- a/lib/observer/test/observer_SUITE.erl
+++ b/lib/observer/test/observer_SUITE.erl
@@ -38,7 +38,7 @@
]).
%% Default timetrap timeout (set in init_per_testcase)
--define(default_timeout, ?t:minutes(1)).
+-define(default_timeout, ?t:minutes(2)).
suite() -> [{ct_hooks,[ts_install_cth]}].
diff --git a/lib/os_mon/c_src/cpu_sup.c b/lib/os_mon/c_src/cpu_sup.c
index 353c7e674e..17ef48c26e 100644
--- a/lib/os_mon/c_src/cpu_sup.c
+++ b/lib/os_mon/c_src/cpu_sup.c
@@ -603,6 +603,35 @@ static void util_measure(unsigned int **result_vec, int *result_sz) {
#endif
/* ---------------------------- *
+ * Utils for OSX and FreeBSD *
+ * ---------------------------- */
+
+#if (defined(__APPLE__) && defined(__MACH__)) || defined(__FreeBSD__)
+
+#define EXIT_WITH(msg) (rich_error(msg, __FILE__, __LINE__))
+#define RICH_BUFLEN (213) /* left in error(char*) */
+
+void rich_error(const char *reason, const char *file, const int line) {
+ char buf[RICH_BUFLEN];
+ snprintf(buf, RICH_BUFLEN, "%s (%s:%i)", reason, file, line);
+ error(buf);
+}
+#undef RICH_BUFLEN
+
+void getsysctl(const char *name, void *ptr, size_t len)
+{
+ size_t gotlen = len;
+ if (sysctlbyname(name, ptr, &gotlen, NULL, 0) != 0) {
+ EXIT_WITH("sysctlbyname failed");
+ }
+ if (gotlen != len) {
+ EXIT_WITH("sysctlbyname: unexpected length");
+ }
+}
+#endif
+
+
+/* ---------------------------- *
* FreeBSD stat functions *
* ---------------------------- */
@@ -645,34 +674,6 @@ static void util_measure(unsigned int **result_vec, int *result_sz) {
}
#endif
-/* ---------------------------- *
- * Utils for OSX and FreeBSD *
- * ---------------------------- */
-
-#if (defined(__APPLE__) && defined(__MACH__)) || defined(__FreeBSD__)
-
-#define EXIT_WITH(msg) (rich_error(msg, __FILE__, __LINE__))
-#define RICH_BUFLEN (213) /* left in error(char*) */
-
-void rich_error(const char *reason, const char *file, const int line) {
- char buf[RICH_BUFLEN];
- snprintf(buf, RICH_BUFLEN, "%s (%s:%i)", reason, file, line);
- error(buf);
-}
-#undef RICH_BUFLEN
-
-void getsysctl(const char *name, void *ptr, size_t len)
-{
- size_t gotlen = len;
- if (sysctlbyname(name, ptr, &gotlen, NULL, 0) != 0) {
- EXIT_WITH("sysctlbyname failed");
- }
- if (gotlen != len) {
- EXIT_WITH("sysctlbyname: unexpected length");
- }
-}
-#endif
-
/* ---------------------------- *
* Generic functions *
diff --git a/lib/public_key/priv/generate b/lib/public_key/priv/generate
index fd185bfd52..69bb2263f4 100755
--- a/lib/public_key/priv/generate
+++ b/lib/public_key/priv/generate
@@ -1,4 +1,4 @@
-#!/bin/bash
+#!/usr/bin/env bash
# Generate ssh moduli files for the sizes in $moduli
diff --git a/lib/ssl/src/ssl_connection.erl b/lib/ssl/src/ssl_connection.erl
index 26c371a8ea..089b3615c6 100644
--- a/lib/ssl/src/ssl_connection.erl
+++ b/lib/ssl/src/ssl_connection.erl
@@ -875,48 +875,14 @@ handle_call({get_opts, OptTags}, From, _,
socket_options = SockOpts}, _) ->
OptsReply = get_socket_opts(Transport, Socket, OptTags, SockOpts, []),
{keep_state_and_data, [{reply, From, OptsReply}]};
-handle_call({set_opts, Opts0}, From, connection = StateName0,
+handle_call({set_opts, Opts0}, From, StateName,
#state{socket_options = Opts1,
- protocol_cb = Connection,
socket = Socket,
- transport_cb = Transport,
- user_data_buffer = Buffer} = State0, _) ->
+ transport_cb = Transport} = State0, _) ->
{Reply, Opts} = set_socket_opts(Transport, Socket, Opts0, Opts1, []),
- State1 = State0#state{socket_options = Opts},
- if
- Opts#socket_options.active =:= false ->
- hibernate_after(StateName0, State1, [{reply, From, Reply}]);
- Buffer =:= <<>>, Opts1#socket_options.active =:= false ->
- %% Need data, set active once
- {Record, State2} = Connection:next_record_if_active(State1),
- %% Note: Renogotiation may cause StateName0 =/= StateName
- case Connection:next_event(StateName0, Record, State2) of
- {next_state, StateName, State} ->
- hibernate_after(StateName, State, [{reply, From, Reply}]);
- {next_state, StateName, State, Actions} ->
- hibernate_after(StateName, State, [{reply, From, Reply} | Actions]);
- {stop, Reason, State} ->
- {stop, Reason, State}
- end;
- Buffer =:= <<>> ->
- %% Active once already set
- hibernate_after(StateName0, State1, [{reply, From, Reply}]);
- true ->
- case Connection:read_application_data(<<>>, State1) of
- {stop, Reason, State} ->
- {stop, Reason, State};
- {Record, State2} ->
- %% Note: Renogotiation may cause StateName0 =/= StateName
- case Connection:next_event(StateName0, Record, State2) of
- {next_state, StateName, State} ->
- hibernate_after(StateName, State, [{reply, From, Reply}]);
- {next_state, StateName, State, Actions} ->
- hibernate_after(StateName, State, [{reply, From, Reply} | Actions]);
- {stop, _, _} = Stop ->
- Stop
- end
- end
- end;
+ State = State0#state{socket_options = Opts},
+ handle_active_option(Opts#socket_options.active, StateName, From, Reply, State);
+
handle_call(renegotiate, From, StateName, _, _) when StateName =/= connection ->
{keep_state_and_data, [{reply, From, {error, already_renegotiating}}]};
handle_call({prf, Secret, Label, Seed, WantedLength}, From, _,
@@ -1876,9 +1842,12 @@ start_or_recv_cancel_timer(infinity, _RecvFrom) ->
start_or_recv_cancel_timer(Timeout, RecvFrom) ->
erlang:send_after(Timeout, self(), {cancel_start_or_recv, RecvFrom}).
-hibernate_after(StateName, #state{ssl_options=#ssl_options{hibernate_after = HibernateAfter}} = State,
+hibernate_after(connection = StateName,
+ #state{ssl_options=#ssl_options{hibernate_after = HibernateAfter}} = State,
Actions) ->
- {next_state, StateName, State, [{timeout, HibernateAfter, hibernate} | Actions]}.
+ {next_state, StateName, State, [{timeout, HibernateAfter, hibernate} | Actions]};
+hibernate_after(StateName, State, Actions) ->
+ {next_state, StateName, State, Actions}.
terminate_alert(normal, Version, ConnectionStates) ->
ssl_alert:encode(?ALERT_REC(?WARNING, ?CLOSE_NOTIFY),
@@ -2032,4 +2001,39 @@ ssl_options_list([ciphers = Key | Keys], [Value | Values], Acc) ->
ssl_options_list([Key | Keys], [Value | Values], Acc) ->
ssl_options_list(Keys, Values, [{Key, Value} | Acc]).
+handle_active_option(false, connection = StateName, To, Reply, State) ->
+ hibernate_after(StateName, State, [{reply, To, Reply}]);
+
+handle_active_option(_, connection = StateName0, To, Reply, #state{protocol_cb = Connection,
+ user_data_buffer = <<>>} = State0) ->
+ %% Need data, set active once
+ {Record, State1} = Connection:next_record_if_active(State0),
+ %% Note: Renogotiation may cause StateName0 =/= StateName
+ case Connection:next_event(StateName0, Record, State1) of
+ {next_state, StateName, State} ->
+ hibernate_after(StateName, State, [{reply, To, Reply}]);
+ {next_state, StateName, State, Actions} ->
+ hibernate_after(StateName, State, [{reply, To, Reply} | Actions]);
+ {stop, Reason, State} ->
+ {stop, Reason, State}
+ end;
+handle_active_option(_, StateName, To, Reply, #state{user_data_buffer = <<>>} = State) ->
+ %% Active once already set
+ {next_state, StateName, State, [{reply, To, Reply}]};
+%% user_data_buffer =/= <<>>
+handle_active_option(_, StateName0, To, Reply, #state{protocol_cb = Connection} = State0) ->
+ case Connection:read_application_data(<<>>, State0) of
+ {stop, Reason, State} ->
+ {stop, Reason, State};
+ {Record, State1} ->
+ %% Note: Renogotiation may cause StateName0 =/= StateName
+ case Connection:next_event(StateName0, Record, State1) of
+ {next_state, StateName, State} ->
+ hibernate_after(StateName, State, [{reply, To, Reply}]);
+ {next_state, StateName, State, Actions} ->
+ hibernate_after(StateName, State, [{reply, To, Reply} | Actions]);
+ {stop, _, _} = Stop ->
+ Stop
+ end
+ end.
diff --git a/lib/stdlib/doc/src/ets.xml b/lib/stdlib/doc/src/ets.xml
index ad7591e214..9fb7d227a3 100644
--- a/lib/stdlib/doc/src/ets.xml
+++ b/lib/stdlib/doc/src/ets.xml
@@ -98,10 +98,10 @@
All updates to single objects are guaranteed to be both <em>atomic</em>
and <em>isolated</em>. This means that an updating operation towards
a single object will either succeed or fail completely without any
- effect at all (atomicy).
+ effect at all (atomicity).
Nor can any intermediate results of the update be seen by other
processes (isolation). Some functions that update several objects
- state that they even guarantee atomicy and isolation for the entire
+ state that they even guarantee atomicity and isolation for the entire
operation. In database terms the isolation level can be seen as
"serializable", as if all isolated operations were carried out serially,
one after the other in a strict order.</p>
diff --git a/lib/tools/emacs/erlang-test.el b/lib/tools/emacs/erlang-test.el
new file mode 100644
index 0000000000..a5aab04953
--- /dev/null
+++ b/lib/tools/emacs/erlang-test.el
@@ -0,0 +1,107 @@
+;;; erlang-test.el -*- lexical-binding: t; coding: utf-8-unix -*-
+
+;;; Unit tests for erlang.el.
+
+;; Author: Johan Claesson
+;; Created: 2016-05-07
+;; Keywords: erlang, languages
+
+;; %CopyrightBegin%
+;;
+;; Copyright Ericsson AB 2016. All Rights Reserved.
+;;
+;; Licensed under the Apache License, Version 2.0 (the "License");
+;; you may not use this file except in compliance with the License.
+;; You may obtain a copy of the License at
+;;
+;; http://www.apache.org/licenses/LICENSE-2.0
+;;
+;; Unless required by applicable law or agreed to in writing, software
+;; distributed under the License is distributed on an "AS IS" BASIS,
+;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+;; See the License for the specific language governing permissions and
+;; limitations under the License.
+;;
+;; %CopyrightEnd%
+
+
+;;; Commentary:
+
+;; This library require GNU Emacs 25 or later.
+
+;;; Code:
+
+(require 'ert)
+(require 'cl-lib)
+
+(defvar erlang-test-code
+ '((nil . "-module(erlang_test).")
+ (nil . "-import(lists, [map/2]).")
+ (nil . "-compile(export_all).")
+ ("SYMBOL" . "-define(SYMBOL, value).")
+ ("MACRO" . "-define(MACRO(X), X + X).")
+ ("struct" . "-record(struct, {until,maps,are,everywhere}).")
+ ("function". "function() -> #struct{}."))
+ "Alist of erlang test code.
+Each entry have the format (TAGNAME . ERLANG_CODE). If TAGNAME
+is nil there is no definitions in the ERLANG_CODE. The
+ERLANG_CODE is a single line of erlang code. These lines will be
+concatenated to form an erlang file to test on.")
+
+
+(ert-deftest erlang-test-tags ()
+ (let* ((dir (make-temp-file "erlang-test" t))
+ (erlang-file (expand-file-name "erlang_test.erl" dir))
+ (tags-file (expand-file-name "TAGS" dir))
+ tags-file-name tags-table-list erlang-buffer)
+ (unwind-protect
+ (progn
+ (erlang-test-create-erlang-file erlang-file)
+ (erlang-test-compile-tags erlang-file tags-file)
+ (setq erlang-buffer (find-file-noselect erlang-file))
+ (with-current-buffer erlang-buffer
+ (setq-local tags-file-name tags-file))
+ ;; PENDING - setting global tags-file-name is a workaround
+ ;; for GNU Emacs bug23164.
+ (setq tags-file-name tags-file)
+ (erlang-test-xref-find-definitions erlang-file erlang-buffer))
+ (when (buffer-live-p erlang-buffer)
+ (kill-buffer erlang-buffer))
+ (let ((tags-buffer (find-buffer-visiting tags-file)))
+ (when (buffer-live-p tags-buffer)
+ (kill-buffer tags-buffer)))
+ (when (file-exists-p dir)
+ (delete-directory dir t)))))
+
+(defun erlang-test-create-erlang-file (erlang-file)
+ (with-temp-file erlang-file
+ (cl-loop for (_ . code) in erlang-test-code
+ do (insert code "\n"))))
+
+(defun erlang-test-compile-tags (erlang-file tags-file)
+ (should (zerop (call-process "etags" nil nil nil
+ "-o" tags-file
+ erlang-file))))
+
+(defun erlang-test-xref-find-definitions (erlang-file erlang-buffer)
+ (cl-loop for (tagname . code) in erlang-test-code
+ for line = 1 then (1+ line)
+ do (when tagname
+ (switch-to-buffer erlang-buffer)
+ (xref-find-definitions tagname)
+ (erlang-test-verify-pos erlang-file line)
+ (xref-find-definitions (concat "erlang_test:" tagname))
+ (erlang-test-verify-pos erlang-file line)))
+ (xref-find-definitions "erlang_test:")
+ (erlang-test-verify-pos erlang-file 1))
+
+(defun erlang-test-verify-pos (expected-file expected-line)
+ (should (string-equal (file-truename expected-file)
+ (file-truename (buffer-file-name))))
+ (should (eq expected-line (line-number-at-pos)))
+ (should (= (point-at-bol) (point))))
+
+
+(provide 'erlang-test)
+
+;;; erlang-test.el ends here
diff --git a/lib/tools/emacs/erlang.el b/lib/tools/emacs/erlang.el
index 4f656e3ae4..aff2c4b2c9 100644
--- a/lib/tools/emacs/erlang.el
+++ b/lib/tools/emacs/erlang.el
@@ -70,8 +70,8 @@
;; `debug-on-error' to `t'. Repeat the error and enclose the debug
;; information in your bug-report.
;;
-;; To set the variable you can use the following command:
-;; M-x set-variable RET debug-on-error RET t RET
+;; To toggle the variable you can use the following command:
+;; M-x toggle-debug-on-error RET
;;; Code:
(eval-when-compile (require 'cl))
@@ -1068,8 +1068,14 @@ behaviour.")
"Font lock keyword highlighting a function header.")
(defface erlang-font-lock-exported-function-name-face
- '((default (:inherit font-lock-function-name-face)))
- "Face used for highlighting exported functions.")
+ (if (featurep 'xemacs)
+ (progn
+ (require 'font-lock)
+ `((t (:foreground ,(face-foreground 'font-lock-function-name-face))
+ (:background ,(face-background 'font-lock-function-name-face)))))
+ '((default (:inherit font-lock-function-name-face))))
+ "Face used for highlighting exported functions."
+ :group 'erlang)
(defvar erlang-font-lock-exported-function-name-face
'erlang-font-lock-exported-function-name-face)
@@ -1338,11 +1344,15 @@ Lock syntax table. The effect is that `apply' in the atom
(defun erlang-version ()
"Return the current version of Erlang mode."
(interactive)
- (if (interactive-p)
+ (if (erlang-interactive-p)
(message "Erlang mode version %s, written by Anders Lindgren"
erlang-version))
erlang-version)
+(defun erlang-interactive-p ()
+ (if (fboundp 'called-interactively-p)
+ (called-interactively-p 'interactive)
+ (funcall (symbol-function 'interactive-p))))
;;;###autoload
(define-derived-mode erlang-mode prog-mode "Erlang"
@@ -1415,7 +1425,11 @@ Other commands:
(erlang-tags-init)
(erlang-font-lock-init)
(erlang-skel-init)
- (tempo-use-tag-list 'erlang-tempo-tags)
+ (when (fboundp 'tempo-use-tag-list)
+ (tempo-use-tag-list 'erlang-tempo-tags))
+ (when (boundp 'xref-backend-functions)
+ (add-hook 'xref-backend-functions #'erlang-etags--xref-backend nil t))
+ (run-hooks 'erlang-mode-hook)
(if (zerop (buffer-size))
(run-hooks 'erlang-new-file-hook)))
@@ -1536,7 +1550,9 @@ Other commands:
table)))
(set (make-local-variable 'font-lock-syntax-table)
erlang-font-lock-syntax-table)
- (set (make-local-variable 'font-lock-beginning-of-syntax-function)
+ (set (make-local-variable (if (boundp 'syntax-begin-function)
+ 'syntax-begin-function
+ 'font-lock-beginning-of-syntax-function))
'erlang-beginning-of-clause)
(make-local-variable 'font-lock-keywords)
(let ((level (cond ((boundp 'font-lock-maximum-decoration)
@@ -2244,6 +2260,7 @@ mode with the command `M-x erlang-mode RET'.")))
;; This code is based on the package `tempo' which is part of modern
;; Emacsen. (GNU Emacs 19.25 (?) and XEmacs 19.14.)
+(defvar erlang-skel)
(defun erlang-skel-init ()
"Generate the skeleton functions and menu items.
The variable `erlang-skel' contains the name and descriptions of
@@ -3813,20 +3830,19 @@ exported function."
(defun erlang-check-module-name-init ()
"Initialize the functionality to compare file and module names.
-Unless we have `before-save-hook', we redefine the function
+Unless we have `before-save-hook', we advice the function
`set-visited-file-name' since it clears the variable
-`local-write-file-hooks'. The original function definition is
-stored in `erlang-orig-set-visited-file-name'."
+`local-write-file-hooks'."
(if (boundp 'before-save-hook)
- ;; If we have that, `make-local-hook' is obsolete.
(add-hook 'before-save-hook 'erlang-check-module-name nil t)
(require 'advice)
- (unless (ad-advised-definition-p 'set-visited-file-name)
- (defadvice set-visited-file-name (after erlang-set-visited-file-name
- activate)
- (if (eq major-mode 'erlang-mode)
- (add-hook 'local-write-file-hooks 'erlang-check-module-name))))
- (add-hook 'local-write-file-hooks 'erlang-check-module-name)))
+ (when (fboundp 'ad-advised-definition-p)
+ (unless (ad-advised-definition-p 'set-visited-file-name)
+ (defadvice set-visited-file-name (after erlang-set-visited-file-name
+ activate)
+ (if (eq major-mode 'erlang-mode)
+ (add-hook 'local-write-file-hooks 'erlang-check-module-name))))
+ (add-hook 'local-write-file-hooks 'erlang-check-module-name))))
(defun erlang-check-module-name ()
@@ -3903,7 +3919,7 @@ non-whitespace characters following the point on the current line."
(newline)
(if (condition-case nil
(progn (erlang-indent-line) t)
- (error (if (bolp) (delete-backward-char 1))))
+ (error (if (bolp) (delete-char -1))))
(if (not (bolp))
(save-excursion
(insert " ->"))
@@ -3915,7 +3931,7 @@ non-whitespace characters following the point on the current line."
(beginning-of-line)
(newline
erlang-electric-semicolon-insert-blank-lines))))
- (error (if (bolp) (delete-backward-char 1))))))))
+ (error (if (bolp) (delete-char -1))))))))
(defun erlang-electric-comma (&optional arg)
@@ -3945,7 +3961,7 @@ non-whitespace characters following the point on the current line."
(newline)
(condition-case nil
(erlang-indent-line)
- (error (if (bolp) (delete-backward-char 1))))))
+ (error (if (bolp) (delete-char -1))))))
(defun erlang-electric-lt (&optional arg)
"Insert a less-than sign, and optionally mark it as an open paren."
@@ -4031,7 +4047,7 @@ non-whitespace characters following the point on the current line."
(newline)
(condition-case nil
(erlang-indent-line)
- (error (if (bolp) (delete-backward-char 1))))))
+ (error (if (bolp) (delete-char -1))))))
;; Then it's just a plain greater-than.
(t
@@ -4071,7 +4087,7 @@ After being split/merged into `erlang-after-arrow' and
(newline)
(condition-case nil
(erlang-indent-line)
- (error (if (bolp) (delete-backward-char 1)))))))
+ (error (if (bolp) (delete-char -1)))))))
(defun erlang-electric-newline (&optional arg)
@@ -4547,6 +4563,11 @@ Tags can be given on the forms `tag', `module:', `module:tag'."
(current-buffer))) ; Return the new buffer.
+
+
+
+
+
;; Process interactive arguments for erlang-find-tag-*.
;;
;; Negative arguments work only for `etags', not `tags'. This is not
@@ -4747,7 +4768,7 @@ for a tag on the form `module:tag'."
(and found
(or (null mod)
(string= mod (erlang-get-module-from-file-name
- (file-of-tag)))))))
+ (funcall (symbol-function 'file-of-tag))))))))
;;; Tags completion, Emacs 19 `etags' specific.
@@ -4787,10 +4808,10 @@ about Erlang modules."
(cond ((and erlang-tags-installed
(fboundp 'etags-tags-completion-table)
(fboundp 'tags-lazy-completion-table)) ; Emacs 23.1+
- ;; This depends on the advice called erlang-replace-tags-table
- ;; above. It is not enough to let-bind
- ;; tags-completion-table-function since that will not override
- ;; the buffer-local value in the TAGS buffer.
+ ;; This depends on the advice called
+ ;; erlang-replace-tags-table above. It is not enough to
+ ;; let-bind tags-completion-table-function since that may be
+ ;; overwritten in etags-recognize-tags-table.
(let ((find-tag-default-function 'erlang-find-tag-for-completion))
(complete-tag)))
((and erlang-tags-installed
@@ -4912,6 +4933,132 @@ about Erlang modules."
(progress-reporter-update progress-reporter (point))))))
table))
+
+;;; Xref backend erlang-etags
+
+;; In GNU Emacs 25 xref was introduced. It is a framework for cross
+;; referencing commands, in particular commands for finding
+;; definitions. It does not replace etags. It rather resides on top
+;; of it and provides user-friendly commands. The idea is that the
+;; user commands should be the same regardless of what backend does
+;; the actual finding of definitions.
+
+;; The backend below is a wrapper around the built-in etags backend.
+;; It adds awareness of the module:tag syntax in a similar way that is
+;; done above for the old etags commands.
+
+
+(defun erlang-etags--xref-backend () 'erlang-etags)
+
+(defun erlang-soft-require (feature)
+ (when (locate-library (symbol-name feature))
+ (require feature)))
+
+(and (erlang-soft-require 'xref)
+ (erlang-soft-require 'cl-generic)
+ ;; The purpose of using eval here is to avoid compilation
+ ;; warnings in emacsen without cl-defmethod.
+ (eval
+ '(progn
+ (cl-defmethod xref-backend-identifier-at-point
+ ((_backend (eql erlang-etags)))
+ (erlang-find-tag-default))
+
+ (cl-defmethod xref-backend-definitions
+ ((_backend (eql erlang-etags)) identifier)
+ (erlang-xref-find-definitions identifier))
+
+ (cl-defmethod xref-backend-apropos
+ ((_backend (eql erlang-etags)) identifier)
+ (erlang-xref-find-definitions identifier t))
+
+ ;; PENDING - This remains to be properly implemented.
+ (cl-defmethod xref-backend-identifier-completion-table
+ ((_backend (eql erlang-etags)))
+ (tags-lazy-completion-table)))))
+
+
+(defun erlang-xref-find-definitions (identifier &optional is-regexp)
+ (let ((id-list (split-string identifier ":")))
+ (cond
+ ;; Handle "tag"
+ ((null (cdr id-list))
+ (erlang-xref-find-definitions-tag identifier is-regexp))
+ ;; Handle "module:"
+ ((string-equal (cadr id-list) "")
+ (erlang-xref-find-definitions-module (car id-list)))
+ ;; Handle "module:tag"
+ (t
+ (erlang-xref-find-definitions-module-tag (car id-list)
+ (cadr id-list)
+ is-regexp)))))
+
+(defun erlang-xref-find-definitions-tag (tag is-regexp)
+ "Find all definitions of TAG and reorder them so that
+definitions in the currently visited file comes first."
+ (when (fboundp 'etags--xref-find-definitions)
+ (let* ((current-file (and (buffer-file-name)
+ (file-truename (buffer-file-name))))
+ (xrefs (etags--xref-find-definitions tag is-regexp))
+ local-xrefs non-local-xrefs)
+ (while xrefs
+ (if (string-equal (erlang-xref-truename-file (car xrefs))
+ current-file)
+ (push (car xrefs) local-xrefs)
+ (push (car xrefs) non-local-xrefs))
+ (setq xrefs (cdr xrefs)))
+ (append (reverse local-xrefs)
+ (reverse non-local-xrefs)))))
+
+(defun erlang-xref-find-definitions-module (module)
+ (and (fboundp 'xref-make)
+ (fboundp 'xref-make-file-location)
+ (let* ((first-time t)
+ xrefs matching-files)
+ (save-excursion
+ (while (visit-tags-table-buffer (not first-time))
+ (setq first-time nil)
+ (let ((files (tags-table-files)))
+ (while files
+ (let* ((file (car files))
+ (m (erlang-get-module-from-file-name file)))
+ (when (and m (string-equal m module))
+ (unless (member file matching-files)
+ (push file
+ matching-files)
+ (push (xref-make file
+ (xref-make-file-location file 1 0))
+ xrefs))))
+ (setq files (cdr files))))))
+ (nreverse xrefs))))
+
+(defun erlang-xref-find-definitions-module-tag (module tag is-regexp)
+ "Find all definitions of TAG and filter away definitions
+outside of MODULE."
+ (when (fboundp 'etags--xref-find-definitions)
+ (let ((xrefs (etags--xref-find-definitions tag is-regexp))
+ xrefs-in-module)
+ (while xrefs
+ (when (string-equal module (erlang-xref-module (car xrefs)))
+ (push (car xrefs) xrefs-in-module))
+ (setq xrefs (cdr xrefs)))
+ xrefs-in-module)))
+
+(defun erlang-xref-module (xref)
+ (erlang-get-module-from-file-name (erlang-xref-file xref)))
+
+(defun erlang-xref-truename-file (xref)
+ (let ((file (erlang-xref-file xref)))
+ (and file
+ (file-truename file))))
+
+(defun erlang-xref-file (xref)
+ (and (fboundp 'xref-location-group)
+ (fboundp 'xref-item-location)
+ (xref-location-group (xref-item-location xref))))
+
+
+
;;;
;;; Prepare for other methods to run an Erlang slave process.
;;;
@@ -5310,8 +5457,7 @@ frame will become deselected before the next command."
()
(or (inferior-erlang-running-p)
(error "No inferior Erlang shell is running"))
- (save-excursion
- (set-buffer inferior-erlang-buffer)
+ (with-current-buffer inferior-erlang-buffer
(let ((msg nil))
(while (save-excursion
(goto-char (process-mark inferior-erlang-process))
@@ -5331,8 +5477,7 @@ frame will become deselected before the next command."
The empty command resembles hitting RET. This is useful in some
situations, for instance if a crash or error report from sasl
has been printed after the last prompt."
- (save-excursion
- (set-buffer inferior-erlang-buffer)
+ (with-current-buffer inferior-erlang-buffer
(if (> (point-max) 1)
;; make sure we get a prompt if buffer contains data
(if (save-excursion
@@ -5398,7 +5543,7 @@ Return the position after the newly inserted command."
(boundp 'comint-last-output-start))
(save-excursion
(goto-char
- (if (interactive-p)
+ (if (erlang-interactive-p)
(symbol-value 'comint-last-input-end)
(symbol-value 'comint-last-output-start)))
(while (progn (skip-chars-forward "^\C-h")
@@ -5417,7 +5562,7 @@ Return the position after the newly inserted command."
(let ((pmark (process-mark (get-buffer-process (current-buffer)))))
(save-excursion
(goto-char
- (if (interactive-p)
+ (if (erlang-interactive-p)
(symbol-value 'comint-last-input-end)
(symbol-value 'comint-last-output-start)))
(while (re-search-forward "\r+$" pmark t)
@@ -5444,23 +5589,21 @@ There exists two workarounds for this bug:
(save-some-buffers)
(inferior-erlang-prepare-for-input)
(let* ((dir (inferior-erlang-compile-outdir))
-;;; (file (file-name-nondirectory (buffer-file-name)))
(noext (substring (erlang-local-buffer-file-name) 0 -4))
(opts (append (list (cons 'outdir dir))
(if current-prefix-arg
(list 'debug_info 'export_all))
erlang-compile-extra-opts))
end)
- (save-excursion
- (set-buffer inferior-erlang-buffer)
- (compilation-forget-errors))
+ (with-current-buffer inferior-erlang-buffer
+ (when (fboundp 'compilation-forget-errors)
+ (compilation-forget-errors)))
(setq end (inferior-erlang-send-command
(inferior-erlang-compute-compile-command noext opts)
nil))
(sit-for 0)
(inferior-erlang-wait-prompt)
- (save-excursion
- (set-buffer inferior-erlang-buffer)
+ (with-current-buffer inferior-erlang-buffer
(setq compilation-error-list nil)
(set-marker compilation-parsing-end end))
(setq compilation-last-buffer inferior-erlang-buffer)))
@@ -5500,7 +5643,8 @@ unless the optional NO-DISPLAY is non-nil."
(let ((ccfn erlang-compile-command-function-alist)
(res (inferior-erlang-compute-erl-compile-command module-name opts))
ccfn-entry
- done)
+ done
+ result)
(if (not (null (erlang-local-buffer-file-name)))
(while (and (not done) (not (null ccfn)))
(setq ccfn-entry (car ccfn))
@@ -5630,12 +5774,14 @@ unless the optional NO-DISPLAY is non-nil."
(tramp-tramp-file-p (buffer-file-name))))
(defun erlang-tramp-get-localname ()
- (let ((tramp-info (tramp-dissect-file-name (buffer-file-name))))
- (if (fboundp 'tramp-file-name-localname)
- (tramp-file-name-localname tramp-info)
- ;; In old versions of tramp, it was `tramp-file-name-path'
- ;; instead of the newer `tramp-file-name-localname'
- (tramp-file-name-path tramp-info))))
+ (when (fboundp 'tramp-dissect-file-name)
+ (let ((tramp-info (tramp-dissect-file-name (buffer-file-name))))
+ (if (fboundp 'tramp-file-name-localname)
+ (tramp-file-name-localname tramp-info)
+ ;; In old versions of tramp, it was `tramp-file-name-path'
+ ;; instead of the newer `tramp-file-name-localname'
+ (when (fboundp 'tramp-file-name-path)
+ (tramp-file-name-path tramp-info))))))
;; `next-error' only accepts buffers with major mode `compilation-mode'
;; or with the minor mode `compilation-minor-mode' activated.
@@ -5652,16 +5798,14 @@ Capable of finding error messages in an inferior Erlang buffer."
(and (boundp 'compilation-last-buffer)
compilation-last-buffer))))
(if (and (bufferp buf)
- (save-excursion
- (set-buffer buf)
+ (with-current-buffer buf
(and (eq major-mode 'erlang-shell-mode)
(setq major-mode 'compilation-mode))))
(unwind-protect
(progn
(setq done t)
(next-error argp))
- (save-excursion
- (set-buffer buf)
+ (with-current-buffer buf
(setq major-mode 'erlang-shell-mode))))
(or done
(next-error argp))))
@@ -5764,7 +5908,7 @@ Simplified version of a combination `defalias' and `make-obsolete',
it assumes that NEWDEF is loaded."
(defalias sym (symbol-function newdef))
(if (fboundp 'make-obsolete)
- (make-obsolete sym newdef)))
+ (make-obsolete sym newdef "long ago")))
(erlang-obsolete 'calculate-erlang-indent 'erlang-calculate-indent)
@@ -5782,11 +5926,8 @@ it assumes that NEWDEF is loaded."
(erlang-obsolete 'name-of-erlang-function 'erlang-name-of-function)
-;; Fixme: shouldn't redefine `set-visited-file-name' anyhow -- see above.
(defconst erlang-unload-hook
(list (lambda ()
- (defalias 'set-visited-file-name
- 'erlang-orig-set-visited-file-name)
(when (featurep 'advice)
(ad-unadvise 'Man-notify-when-ready)
(ad-unadvise 'set-visited-file-name)))))
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-02 07:44:35 +0000