diff options
Diffstat (limited to 'lib/xmerl/doc/examples/test_html.erl')
| -rwxr-xr-x | lib/xmerl/doc/examples/test_html.erl | 225 |
1 files changed, 225 insertions, 0 deletions
diff --git a/lib/xmerl/doc/examples/test_html.erl b/lib/xmerl/doc/examples/test_html.erl new file mode 100755 index 0000000000..3ca15f30f8 --- /dev/null +++ b/lib/xmerl/doc/examples/test_html.erl @@ -0,0 +1,225 @@ +%%% The contents of this file are subject to the Erlang Public License, +%%% Version 1.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.erlang.org/license/EPL1_0.txt +%%% +%%% 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. +%%% +%%% The Original Code is xmerl-0.7 +%%% +%%% The Initial Developer of the Original Code is Ericsson Telecom +%%% AB. Portions created by Ericsson are Copyright (C), 1998, Ericsson +%%% Telecom AB. All Rights Reserved. +%%% +%%% Contributor(s): ______________________________________. +%%% +%%%---------------------------------------------------------------------- +%%% #0. BASIC INFORMATION +%%%---------------------------------------------------------------------- +%%% File: test_html.erl +%%% Author : Ulf Wiger <[email protected]> + +%%% Description : Callback module for exporting XML to HTML with support +%%% for special Erlang-related tags. (Experimental) +%%% +%%% Modules used : lists, io_lib +%%% +%%%---------------------------------------------------------------------- + +-module(test_html). +-author('[email protected]'). + + +-export(['#xml-inheritance#'/0]). + +%%% special Erlang forms +-export(['EXIT'/4, + 'tuple_list'/4]). + +-export(['#root#'/4, + title/4, + heading/4, + section/4, + table/4, + row/4, + col/4, + data/4, + p/4, para/4, 'P'/4, + emphasis/4]). + +-include("xmerl.hrl"). + + +'#xml-inheritance#'() -> [xmerl_xml]. + + + +%% The '#root#' tag is called when the entire structure has been exported. +%% It does not appear in the structure itself. +'#root#'(Data, Attrs, [], E) -> + Title = + case find_attribute(title, Attrs) of + {value, T} -> + ["<title>", T, "</title>"]; + false -> + [] + end, + ["<!DOCTYPE HTML PUBLIC \"-//IETF//DTD HTML//EN\">\n" + "<html>\n", + "<head>\n", Title, "</head>\n" + "<body>\n", Data, "</body>\n"]. + + + + +%%% Special token: EXIT +'EXIT'(Reason, Attrs = [], Parents = [], E) -> + %% This happens e.g. if a request function crashes completely. + ["<pre>\n", mk_string({'EXIT', Reason}), "</pre>"]. + + +title(Str, Attrs, Parents, E) -> + ["<h1>", Str, "</h1>\n"]. + + +%%% section/3 is to be used instead of headings. +section(Data, Attrs, [{section,_}, {section,_}, {section,_} | _], E) -> + opt_heading(Attrs, "<h4>", "</h4>", Data); +section(Data, Attrs, [{section,_}, {section,_} | _], E) -> + opt_heading(Attrs, "<h3>", "</h3>", Data); +section(Data, Attrs, [{section,_} | _], E) -> + opt_heading(Attrs, "<h2>", "</h2>", Data); +section(Data, Attrs, Parents, E) -> + opt_heading(Attrs, "<h1>", "</h1>", Data). + +opt_heading(Attrs, StartTag, EndTag, Data) -> + case find_attribute(heading, Attrs) of + {value, Text} -> + [StartTag, Text, EndTag, "\n" | Data]; + false -> + Data + end. + + +%% tables +%% e.g. {table, [{heading, [{col, H1}, {col, H2}]}, +%% {row, [{col, C11}, {col, C12}]}, +%% {row, [{col, C21}, {col, C22}]}]}. + +table(Data, Attrs, Parents, E) -> + Border = case find_attribute(border, Attrs) of + false -> + " border=1"; + {value, N} -> + [" border=", mk_string(N)] + end, + ["<table", Border, ">\n", Data, "\n</table>\n"]. + +row(Data, Attrs, [{table,_}|_], E) -> + ["<tr>", Data, "</tr>\n"]. + +heading(Data, Attrs, [{table,_}|_], E) -> + ["<tr>", Data, "</tr>\n"]. + + +%% Context-sensitive columns (heading- or row columns) +col(Data, Attrs, [{heading,_}, {table,_} | _], E) -> + ["<th>", nbsp_if_empty(Data), "</th>\n"]; +col(Data, Attrs, [{row,_}, {table,_} | _], E) -> + ["<td>", nbsp_if_empty(Data), "</td>\n"]. + + +tuple_list(List, Attrs, Parents, E) -> + Elems = case find_attribute(elements, Attrs) of + {value, Es} -> + Es; + false -> + case List of + [H|_] -> + lists:seq(1,size(H)); + [] -> + [] + end + end, + TableData = [{row, [{col, {element(P, Rec)}} || P <- Elems]} || + Rec <- List], + Table = case find_attribute(heading, Attrs) of + {value, Cols} -> + Head = {heading, [{col, C} || C <- Cols]}, + {table, [Head | TableData]}; + false -> + {table, TableData} + end, + {'#xml-redefine#', Table}. + + +data(Data, Pos, Attrs, Parents) -> + mk_string(Data). + + + +p(Data, Pos, Attrs, Parents) -> + {'#xml-alias#', 'P'}. + +para(Data, Pos, Attrs, Parents) -> + {'#xml-alias#', 'P'}. + +'P'(Data, Pos, Attrs, Parents) -> + ["<p>", mk_string(Data), "</p>\n"]. + + +emphasis(Str, Pos, Attrs, Parents) -> + ["<strong>", Str, "</strong>"]. + + +nbsp_if_empty(Data) when binary(Data), size(Data) == 0 -> + " "; +nbsp_if_empty(Data) when list(Data) -> + case catch list_to_binary(Data) of + {'EXIT', _} -> + nbsp_if_empty_term(Data); + B when size(B) == 0 -> + " "; + _ -> + Data + end; +nbsp_if_empty(Data) -> + nbsp_if_empty_term(Data). + +nbsp_if_empty_term(Data) -> + Str = io_lib:format("~p", [Data]), + case list_to_binary(Str) of + B when size(B) == 0 -> + " "; + _ -> + Str + end. + + +mk_string(I) when integer(I) -> + integer_to_list(I); +mk_string(A) when atom(A) -> + atom_to_list(A); +mk_string(L) when list(L) -> + %% again, we can't regognize a string without "parsing" it + case catch list_to_binary(L) of + {'EXIT',_} -> + io_lib:format("~p", [L]); + _ -> + L + end; +mk_string(Term) -> + io_lib:format("~p", [Term]). + + + +find_attribute(Name, Attrs) -> + case lists:keysearch(Name, #xmlAttribute.name, Attrs) of + {value, #xmlAttribute{value = V}} -> + {value, V}; + false -> + false + end. |