aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorBadlop <badlop@process-one.net>2009-10-23 15:12:16 +0000
committerBadlop <badlop@process-one.net>2009-10-23 15:12:16 +0000
commitabcb3f22a8f1459be0ca9804acac43c17c07f26f (patch)
tree8bcc81e875b98551cc7b676aaf4273f2d96dc47a
parentMove overview.edoc to src/ dir. (diff)
Add escobar_hilite.erl and escobar.css.
SVN Revision: 2698
-rw-r--r--doc/devdoc/escobar.css13
-rw-r--r--doc/devdoc/escobar_hilite.erl329
2 files changed, 342 insertions, 0 deletions
diff --git a/doc/devdoc/escobar.css b/doc/devdoc/escobar.css
new file mode 100644
index 000000000..49a55dc21
--- /dev/null
+++ b/doc/devdoc/escobar.css
@@ -0,0 +1,13 @@
+.comment {color: brown}
+.export {color: darkorchid}
+.import {color: darkorchid}
+.string {color: maroon}
+.builtin {color: dodgerblue}
+.guard {color: mediumturquoise}
+.function {color: blue}
+.variable {color: green}
+.macro {color: mediumpurple}
+.record {color: orangered}
+.call {color: purple}
+.attribute {color: firebrick}
+.error{color: red}
diff --git a/doc/devdoc/escobar_hilite.erl b/doc/devdoc/escobar_hilite.erl
new file mode 100644
index 000000000..a6c773975
--- /dev/null
+++ b/doc/devdoc/escobar_hilite.erl
@@ -0,0 +1,329 @@
+%%%-------------------------------------------------------------------
+%%% File : escobar_tree.erl
+%%% Author : Mats Cronqvist <etxmacr@mwux005>
+%%% Description :
+%%%
+%%% Created : 6 Jun 2005 by Mats Cronqvist <etxmacr@mwux005>
+%%%-------------------------------------------------------------------
+-module(escobar_hilite).
+
+-export([file/1,tree/1,string/1,out/2]).
+
+-define(LOG(T),escobar:log(process_info(self()),T)).
+
+-import(erl_syntax,
+ [get_ann/1,add_ann/2,subtrees/1,update_tree/2,type/1,get_pos/1,
+ application/2,application_arguments/1,application_operator/1,
+ arity_qualifier_argument/1,arity_qualifier_body/1,
+ atom_name/1,atom_value/1,
+ attribute/2,attribute_name/1,attribute_arguments/1,
+ clause/3,clause_patterns/1,clause_guard/1,clause_body/1,
+ comment/2,comment_text/1,comment_padding/1,
+ function/2,function_name/1,function_clauses/1,function_arity/1,
+ integer_literal/1,
+ list/1,list_elements/1,
+ macro/2,macro_name/1,macro_arguments/1,
+ module_qualifier_body/1, module_qualifier_argument/1,
+ string_value/1,string_literal/1,
+ variable_literal/1,variable_name/1,
+ record_access/3, record_access_argument/1,
+ record_access_field/1,record_access_type/1,
+ record_expr/3, record_expr_argument/1,
+ record_expr_fields/1, record_expr_type/1,
+ record_index_expr/2, record_index_expr_field/1,
+ record_index_expr_type/1,
+ form_list/1,
+ get_precomments/1,get_postcomments/1,has_comments/1,
+ copy_comments/2,remove_comments/1]).
+
+-import(prettypr,
+ [above/2,follow/2,beside/2,empty/0,
+ null_text/1,break/1,floating/3,text/1,floating/1]).
+
+-import(lists,[flatten/1,duplicate/2,keysearch/3,member/2,usort/1,reverse/1]).
+
+-import(filename,[join/1,basename/1]).
+
+out(File,HtmlString) ->
+ {ok,FD}=file:open(File,[write]),
+ try
+ io:fwrite(FD,"<html>",[]),
+ io:fwrite(FD,"<link rel=\"stylesheet\" type=\"text/css\"",[]),
+ io:fwrite(FD,"href=\"escobar.css\"></link><body><pre>",[]),
+ io:fwrite(FD,"~s",[HtmlString]),
+ io:fwrite(FD,"</pre></body></html>",[])
+ after
+ file:close(FD)
+ end.
+
+string(Str) ->
+ tree(form_list(scan_and_parse(Str,1,[]))).
+
+scan_and_parse([],_Line,Forms) -> reverse(Forms);
+scan_and_parse(Text,Line,Forms) ->
+ {done,{ok,Toks,NLine},Cont} = erl_scan:tokens([],Text,Line),
+ {ok,Form} = erl_parse:parse_form(Toks),
+ scan_and_parse(Cont,NLine,[Form|Forms]).
+
+file(FileName) ->
+ case filelib:is_regular(FileName) of
+ true ->
+ case filename:extension(FileName) of
+ ".beam"-> tree(get_tree_beam(FileName));
+ ".erl" -> tree(get_comm_tree_erl(FileName));
+ ".hrl" -> tree(get_comm_tree_erl(FileName));
+ X -> erlang:error({unknown_extension,X})
+ end;
+ false->
+ erlang:error({no_file,FileName})
+ end.
+
+get_comm_tree_erl(Filename) ->
+ Comms = erl_comment_scan:file(Filename),
+ Forms = get_forms_erl(Filename),
+ erl_recomment:recomment_forms(Forms,Comms).
+
+get_tree_beam(Filename) ->
+ case beam_lib:chunks(Filename,["Abst"]) of
+ {ok,{_,[{"Abst",AChunk}]}} ->
+ {_,Forms} = binary_to_term(AChunk),
+ form_list(Forms);
+ _ ->
+ erlang:error({no_debuginfo,Filename})
+ end.
+
+get_forms_erl(Filename) ->
+ {ok,Fs} = epp_dodger:parse_file(Filename,[{no_fail, true}]),
+ Fs.
+
+%%% # tree
+%%% turn a syntax tree into html by annotating and pretty-printing
+%%% with a hook function
+
+tree(Tree) ->
+ pout(ann(type(Tree),Tree)).
+
+%%lists:foldl(fun(Form,Acc) -> [pout(ann(Form))|Acc] end, [], Tree).
+
+pout(Form) ->
+ erl_prettypr:format(Form,[{hook,fun tag/3},{paper,90},{ribbon,650}]).
+
+%%% ## formatting
+%%% ### 'tag' - the format hook function
+tag(Node,Ctxt,Cont) ->
+ Tags = get_ann(Node),
+ case member(has_comment,Tags) of
+ true ->
+ PreC = get_precomments(Node),
+ PostC = get_postcomments(Node),
+ Nod = remove_comments(Node),
+ Doc0 = tagit(Tags--[has_comment],Cont(Nod,Ctxt)),
+ postcomment(precomment(Doc0,PreC),PostC);
+ false ->
+ Doc0 = Cont(Node,Ctxt),
+ tagit(Tags,Doc0)
+ end.
+
+tagit([],Doc0) ->
+ Doc0;
+tagit(["binary"],{beside,_,{beside,Doc,_}}) ->
+ beside(floating(text("&lt;&lt;")),beside(Doc,floating(text("&gt;&gt;"))));
+tagit([Tag],Doc0) ->
+ beside(null_text(Tag),beside(Doc0,null_text(etag(Tag)))).
+
+etag("<"++Tag) -> "</"++hd(string:tokens(Tag," "))++">".
+
+%%%### comment stuff
+precomment(Doc,PreC) ->
+ above(floating(break(stack(PreC)), -1, -1), Doc).
+postcomment(Doc,PostC) ->
+ beside(Doc, floating(break(stack(PostC)), 1, 0)).
+
+stack([]) -> empty();
+stack([Comm|Comms]) ->
+ Doc = maybe_pad(stack_comment_lines(comment_text(Comm)),Comm),
+ case Comms of
+ [] -> Doc;
+ _ -> above(Doc, stack(Comms))
+ end.
+
+maybe_pad(Doc,Comm) ->
+ case comment_padding(Comm) of
+ I when is_integer(I), 0 < I -> beside(text(duplicate(I,$ )), Doc);
+ _ -> Doc
+ end.
+
+%%% stolen with pride from erl_prettypr
+%%% Stack lines of text above each other and prefix each string in
+%%% the list with a single `%' character.
+
+stack_comment_lines([S | Ss]) ->
+ D = tagit([dehtml('span', [{class,comment}])],text("%"++debracket(S))),
+ case Ss of
+ [] -> D;
+ _ -> above(D, stack_comment_lines(Ss))
+ end;
+stack_comment_lines([]) ->
+ empty().
+
+%%% annotate nodes that should be hilited
+%%% the annotation is put on the subtree that should be marked up
+%%% the annotation is;
+%%% has_comments|Markup
+%%% if a node already has an annotation the new one is dropped, except
+%%% if either the new or the old one is has_comments
+
+ann(binary,Tree) ->
+ new_tree(Tree,add_anno("binary",Tree));
+ann(application,Tree) ->
+ Op = application_operator(Tree),
+ Args = application_arguments(Tree),
+ new_tree(Tree,application(add_anno(mu(application,Tree),Op),Args));
+ann(attribute,Tree) ->
+ Name = attribute_name(Tree),
+ case atom_value(Name) of
+ export ->
+ AQs = list_elements(hd(attribute_arguments(Tree))),
+ Args = [list([add_anno(mu(export,Tree),AQ) || AQ <- AQs])];
+ import ->
+ [ImportMod,ImportFAs] = attribute_arguments(Tree),
+ AQs = list_elements(ImportFAs),
+ Args = [ImportMod,list([add_anno(mu(import,Tree),AQ) || AQ <- AQs])];
+ define ->
+ [Macro|Rest] = attribute_arguments(Tree),
+ case type(Macro) of
+ application ->
+ Op = application_operator(Macro),
+ As = application_arguments(Macro),
+ Args = [application(add_anno(mu(macro,Tree),Op),As)|Rest];
+ _ ->
+ Args = [add_anno(mu(macro,Tree),Macro)|Rest]
+ end;
+ record ->
+ [Rec|Rest] = attribute_arguments(Tree),
+ Args = [add_anno(mu(record,Tree),Rec)|Rest];
+ _ ->
+ Args = attribute_arguments(Tree)
+ end,
+ new_tree(Tree,attribute(add_anno(mu(attribute,Tree),Name),Args));
+ann(record_access,Tree) ->
+ Arg = record_access_argument(Tree),
+ Type = record_access_type(Tree),
+ Field = record_access_field(Tree),
+ new_tree(Tree,record_access(Arg,add_anno(mu(record,Tree),Type),Field));
+ann(record_expr,Tree) ->
+ Arg = record_expr_argument(Tree),
+ Type = record_expr_type(Tree),
+ Fields = record_expr_fields(Tree),
+ new_tree(Tree,record_expr(Arg,add_anno(mu(record,Tree),Type),Fields));
+ann(record_index_expr,Tree) ->
+ Type = record_index_expr_type(Tree),
+ Field = record_index_expr_field(Tree),
+ new_tree(Tree,record_index_expr(add_anno(mu(record,Tree),Type),Field));
+ann(function,Tree) ->
+ Name = function_name(Tree),
+ Clauses = function_clauses(Tree),
+ new_tree(Tree,function(add_anno(mu(function,Tree),Name),Clauses));
+ann(macro,Tree) ->
+ Name = macro_name(Tree),
+ Args = macro_arguments(Tree),
+ new_tree(Tree,macro(add_anno(mu(macro,Tree),Name), Args));
+ann(string,OTree) ->
+ Tree = erl_syntax:string(debracket(string_value(OTree))),
+ new_tree(OTree,add_anno(mu(string,OTree),Tree));
+ann(variable,Tree) ->
+ new_tree(Tree,add_anno(mu(variable,Tree),Tree));
+ann(text,Tree) ->
+ new_tree(Tree,add_anno(mu(error,Tree),Tree));
+ann(comment,OTree) ->
+ Pad = comment_padding(OTree),
+ Text = [debracket(S) || S <- comment_text(OTree)],
+ Tree = comment(Pad,Text),
+ new_tree(OTree,add_anno(mu(comment,OTree),Tree));
+ann(_Typ,Tree) ->
+ new_tree(Tree,Tree).
+
+new_tree(OTree,NTree) ->
+ Tree =
+ case has_comments(OTree) of
+ true -> add_ann(has_comment,copy_comments(OTree,NTree));
+ false -> NTree
+ end,
+ SubTrees = subtrees(Tree),
+ case [[ann(type(SubT),SubT) || SubT<-Group] || Group<-SubTrees] of
+ [] -> Tree;
+ NSubtrees -> update_tree(Tree,NSubtrees)
+ end.
+
+debracket([]) -> [];
+debracket([$>|Str]) -> "&gt;"++debracket(Str);
+debracket([$<|Str]) -> "&lt;"++debracket(Str);
+debracket([C|Str]) -> [C|debracket(Str)].
+
+add_anno(nil,Tree) -> Tree;
+add_anno(Ann,Tree) ->
+ case get_ann(Tree) of
+ [] -> add_ann(Ann,Tree);
+ [has_comment] -> add_ann(Ann,Tree);
+ _OAnn -> Tree
+ end.
+
+%%%### the markups
+mu(application,Node) ->
+ Op = application_operator(Node),
+ Ar = length(application_arguments(Node)),
+ case type(Op) of
+%% variable ->
+%% dehtml('span', [{class,variable}]);
+ atom ->
+ case is_guard_or_builtin(atom_value(Op),Ar) of
+ guard -> dehtml('span', [{class,guard}]);
+ builtin->dehtml('span', [{class,builtin}]);
+ neither->dehtml('span', [{class,call}])
+ end;
+ module_qualifier ->
+ Mod = module_qualifier_argument(Op),
+ Fun = module_qualifier_body(Op),
+ case {type(Mod),type(Fun)} of
+ {atom,atom} ->
+ case atom_value(Mod) of
+ erlang -> dehtml('span', [{class,builtin}]);
+ _ -> dehtml('span', [{class,call}])
+ end;
+ _ ->
+ nil
+ end;
+ _ ->
+ nil
+ end;
+mu(Class,_Node) ->
+ dehtml('span', [{class,Class}]).
+
+dehtml(Tag,Atts) ->
+ flatten([$<,str(Tag),$ ,[[str(A),"=\"",str(V),"\" "]||{A,V}<-Atts],$>]).
+
+str(I) when integer(I) -> integer_to_list(I);
+str(A) when atom(A) -> atom_to_list(A);
+str(L) when list(L) -> L.
+
+is_guard_or_builtin(atom,1) ->guard;
+is_guard_or_builtin(binary,1) ->guard;
+is_guard_or_builtin(constant,1) ->guard;
+is_guard_or_builtin(float,1) ->guard;
+is_guard_or_builtin(function,1) ->guard;
+is_guard_or_builtin(function,2) ->guard;
+is_guard_or_builtin(integer,1) ->guard;
+is_guard_or_builtin(list,1) ->guard;
+is_guard_or_builtin(number,1) ->guard;
+is_guard_or_builtin(pid,1) ->guard;
+is_guard_or_builtin(port,1) ->guard;
+is_guard_or_builtin(reference,1) ->guard;
+is_guard_or_builtin(tuple,1) ->guard;
+is_guard_or_builtin(record,2) ->guard;
+is_guard_or_builtin(record,3) ->guard;
+is_guard_or_builtin(F,A) ->
+ case erlang:function_exported(erlang,F,A) orelse
+ erlang:is_builtin(erlang,F,A) of
+ true -> builtin;
+ false-> neither
+ end.