Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
tree: ad6f168ba4
Fetching contributors…

Cannot retrieve contributors at this time

350 lines (302 sloc) 9.067 kB
%%%----------------------------------------------------------------------
%%% File : fdoc.erl
%%% Author : Luke Gorrie <luke@bluetail.com>
%%% Purpose : Heuristic sourcecode documentation extractor
%%% (A poor man's 'edoc')
%%% Created : 26 Feb 2003 by Luke Gorrie <luke@bluetail.com>
%%%----------------------------------------------------------------------
-module(fdoc).
-author('luke@bluetail.com').
-import(lists,
[reverse/1, splitwith/2, takewhile/2, flatten/1, map/2,
foreach/2, member/2, sort/1, any/2]).
%% Server-based interface
-export([apropos/1, get_apropos/1,
describe/1, describe/2, describe/3,
description/1, description/2, description/3,
stop/0]).
%% Function-based interface
-export([describe_file/1, file/1, string/1]).
-export([describe2/1, describe2/2, describe2/3]).
%% Internal server exports
-export([init/0,loop/0]).
%% ----------------------------------------------------------------------
%% Server half. Calling these functions causes a server to be created,
%% which scans the sources for all loaded modules. You can use stop()
%% to shut it down, so that the next request will rebuild the database.
%% ----------------------------------------------------------------------
%% Interface
%% Print apropos information by regexp.
apropos(Regexp) ->
case get_apropos(Regexp) of
{ok, Matches} ->
print_matches(Matches);
Err ->
Err
end.
get_apropos(Regexp) ->
ensure_started(),
case regexp:parse(Regexp) of
{ok, RE} ->
fdoc ! {apropos, self(), RE},
receive
{apropos, Matches} ->
{ok, Matches}
end;
Err ->
Err
end.
%% Print a description of all functions matching Module, Function, and
%% Arity. Function and module arguments are optional.
describe(M) ->
describe(M, '_', '_').
describe(M, F) ->
describe(M, F, '_').
describe(M, F, A) ->
{ok, Matches} = description(M, F, A),
print_matches(Matches).
description(M) ->
description(M, '_', '_').
description(M, F) ->
description(M, F, '_').
description(M, F, A) ->
ensure_started(),
fdoc ! {describe, self(), M, F, A},
receive
{describe, Matches} -> {ok, Matches}
end.
%% This function does not use the cache
describe2(M) ->
describe2(M, '_', '_').
describe2(M, F) ->
describe2(M, F, '_').
describe2(M, F, A) ->
case distel:find_source(M) of
{ok, Sourcefile} ->
case file(Sourcefile) of
{ok, Docs} ->
{ok, lists:zf(fun({Fn, Arity, DocStr}) when F=='_'; Fn==F ->
if A == '_'; A == Arity ->
{true, {M,Fn, Arity, DocStr}};
true ->
false
end;
(_) ->
false
end, Docs)};
Error ->
Error
end;
Error ->
Error
end.
%% Stop the fdoc server. You can use this to flush the database.
stop() ->
catch (fdoc ! {stop, self()}),
receive {stop, ok} -> ok end.
%% Internals
print_matches(Ms) ->
foreach(fun({Mod, Fn, Arity, Doc}) ->
io:format("~p:~p/~p:~n~s~n",
[Mod, Fn, Arity, indent(Doc, " ")])
end,
sort(Ms)).
%% Ensure that the 'fdoc' server has started.
ensure_started() ->
case whereis(?MODULE) of
undefined ->
Pid = proc_lib:spawn(?MODULE, init, []),
register(?MODULE, Pid),
{ok, Pid};
Pid ->
{ok, Pid}
end.
init() ->
init_db(),
loop().
init_db() ->
ets:new(?MODULE, [public, bag, named_table]),
foreach(fun import_module/1, [M || {M, _Objfile} <- code:all_loaded()]).
loop() ->
receive
{stop, From} ->
From ! {stop, ok},
ok;
{apropos, From, RE} ->
Matches = [{M,F,A,D} || {M,F,A,D} <- ets:tab2list(?MODULE),
any(fun(S) ->
regexp:match(S, RE) /= nomatch
end,
[D,
atom_to_list(M),
atom_to_list(F)])],
From ! {apropos, Matches},
?MODULE:loop();
{describe, From, M, F, A} ->
case code:is_loaded(M) of
false ->
%% Have to reload the database first..
code:ensure_loaded(M),
ets:delete(?MODULE),
init_db();
_ ->
ok
end,
From ! {describe, ets:match_object(?MODULE, {M, F, A, '_'})},
?MODULE:loop()
end.
import_module(Mod) ->
case distel:find_source(Mod) of
{ok, Sourcefile} ->
case file(Sourcefile) of
{ok, Docs} ->
foreach(fun({Fn, Arity, DocStr}) ->
ets:insert(?MODULE,{Mod,Fn,Arity,DocStr})
end,
just_exports(Mod, Docs));
{error, _Reason} ->
skipped
end;
{error, _Reason} ->
skipped
end.
just_exports(Mod, Docs) ->
[{F,A,D} || {F,A,D} <- Docs,
member({F, A}, Mod:module_info(exports))].
%% ----------------------------------------------------------------------
%% Function half, for extracting documentation from files and strings.
%% ----------------------------------------------------------------------
%% Interface
%% Print a description of all the documented exported functions in a
%% file.
describe_file(Name) ->
case file(Name) of
{ok, Docs} ->
foreach(fun({Fn, Arity, Doc}) ->
io:format("~p/~p:~n~s~n",
[Fn, Arity, indent(Doc, " ")])
end,
Docs);
{error, Rsn} ->
{error, Rsn}
end.
%% Return a description of all documented exported functions in
%% a file.
%% Returns: {Function, Arity, Documentation}
file(Name) ->
case file:read_file(Name) of
{ok, Bin} ->
{ok, string(binary_to_list(Bin))};
{error, Reason} ->
{error, Reason}
end.
%% Return a description of all documented exported functions in
%% a string.
%% Returns: {Function, Arity, Documentation}
string(S) ->
remove_dups(scan_lines(S, [])).
%% Internals
%% If we have multiple definitions of the same function/arity, just
%% keep the first one.
remove_dups([{F,A,Doc}, {F,A,_} | T]) ->
remove_dups([{F,A,Doc}|T]);
remove_dups([H|T]) ->
[H|remove_dups(T)];
remove_dups([]) ->
[].
scan_lines([], _) ->
[];
scan_lines(S0, Acc) when hd(S0) == $% ->
{CommentLine, S1} = take_line(S0),
scan_lines(S1, [CommentLine|Acc]);
scan_lines("\n"++S, _Acc) when hd(S) == $% ->
%% Blank followed by a new comment: flush old comment
scan_lines(S, []);
scan_lines("\n"++S, Acc) ->
%% Blank not followed by a comment: keep the current comment
scan_lines(S, Acc);
scan_lines(S0, Acc) ->
case function_start_char(hd(S0)) of
true ->
scan_function(S0, comments_to_doc(reverse(Acc)));
false ->
scan_lines(drop_line(S0), [])
end.
scan_function(S0, Comments) ->
case take_function_head(S0) of
{ok, Head, S1} ->
S2 = drop_line(S1), % skip to next fresh line
case parse_function_head(Head) of
{ok, Function, Arity} ->
if Comments == [] ->
scan_lines(S2, []);
true ->
[{Function, Arity, Comments} | scan_lines(S2, [])]
end;
error ->
scan_lines(S2, [])
end;
eos ->
[]
end.
function_start_char(Ch) when Ch >= $a, Ch =< $z -> true;
function_start_char(Ch) when Ch >= $A, Ch =< $Z -> true;
function_start_char($') -> true;
function_start_char(_) -> false.
%% Parse a function head into name and arity.
%% Returns: {ok, Name, Arity} | error
parse_function_head(S0) ->
%% Poor man's approach: rewind back to the closing ')', tack on a
%% '.', and see if we can parse it as a function call.
S1 = takewhile(fun(Ch) -> Ch /= $) end, S0) ++ ").",
case erl_scan:string(S1) of
{ok, Scan, _} ->
case erl_parse:parse_exprs(Scan) of
{ok, [{call,_,{atom,_,Fname},Args}]} ->
{ok, Fname, length(Args)};
_ ->
error
end;
_ ->
error
end.
%% Keep going until we see a "->". FIXME, should be clever about "->"
%% appearing inside comments, atoms, or strings.
take_function_head(S) -> take_function_head(S, []).
take_function_head("->"++S, Acc) ->
{ok, reverse(Acc), S};
take_function_head("%"++S0, Acc) ->
{_, S1} = take_line(S0),
take_function_head(S1, Acc);
take_function_head([H|T], Acc) ->
take_function_head(T, [H|Acc]);
take_function_head([], _Acc) ->
eos.
%% Returns: {Line, Rest}
take_line(S) -> take_line(S, []).
take_line([], Acc) -> {reverse(Acc), []};
take_line([$\n|S], Acc) -> {reverse("\n"++Acc), S};
take_line([H|T], Acc) -> take_line(T, [H|Acc]).
drop_line(S0) ->
{_, S1} = take_line(S0),
S1.
comments_to_doc([]) ->
[];
%% FIXME: we should really generate nothing here, since zillions
%% of these "undocumented" strings will match e.g. an apropos
%% search for "documented" :-) -luke
% "(undocumented)\n";
comments_to_doc(Comments) ->
flatten([Line || Line <- map(fun clean_comment/1, Comments),
not boring_comment(Line)]).
boring_comment("\n") -> true;
boring_comment(S) ->
%% Matches "%% ----------" lines
lists:all(fun(Ch) -> Ch == $- end, S -- "\n").
clean_comment("% "++S) -> S;
clean_comment("%"++S) -> clean_comment(S);
clean_comment(S) -> S.
indent(S, Pad) -> flatten([Pad | indent1(S, Pad)]).
indent1("\n"++S, Pad) -> ["\n", Pad, indent1(S, Pad)];
indent1([H|T], Pad) -> [H|indent1(T, Pad)];
indent1([], _) -> [].
Jump to Line
Something went wrong with that request. Please try again.