1%% =====================================================================
2%% Licensed under the Apache License, Version 2.0 (the "License"); you may
3%% not use this file except in compliance with the License. You may obtain
4%% a copy of the License at <http://www.apache.org/licenses/LICENSE-2.0>
5%%
6%% Unless required by applicable law or agreed to in writing, software
7%% distributed under the License is distributed on an "AS IS" BASIS,
8%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
9%% See the License for the specific language governing permissions and
10%% limitations under the License.
11%%
12%% Alternatively, you may use this file under the terms of the GNU Lesser
13%% General Public License (the "LGPL") as published by the Free Software
14%% Foundation; either version 2.1, or (at your option) any later version.
15%% If you wish to allow use of your version of this file only under the
16%% terms of the LGPL, you should delete the provisions above and replace
17%% them with the notice and other provisions required by the LGPL; see
18%% <http://www.gnu.org/licenses/>. If you do not delete the provisions
19%% above, a recipient may use your version of this file under the terms of
20%% either the Apache License or the LGPL.
21%%
22%% @author Richard Carlsson <carlsson.richard@gmail.com>
23%% @copyright 2001-2006 Richard Carlsson
24%% @see edoc
25%% @end
26%% =====================================================================
27
28%% @doc The standard HTML layout module for EDoc. See the {@link edoc}
29%% module for details on usage.
30
31%% Note that this is written so that it is *not* depending on edoc.hrl!
32
33-module(edoc_layout).
34
35-export([module/2, overview/2, type/1]).
36
37-callback module(edoc:edoc_module(), _) -> binary().
38%% Layout entrypoint.
39
40-import(edoc_report, [report/2]).
41
42-include_lib("xmerl/include/xmerl.hrl").
43
44-define(HTML_EXPORT, xmerl_html).
45-define(DEFAULT_XML_EXPORT, ?HTML_EXPORT).
46-define(OVERVIEW_SUMMARY, "overview-summary.html").
47-define(STYLESHEET, "stylesheet.css").
48-define(NL, "\n").
49-define(DESCRIPTION_TITLE, "Description").
50-define(DESCRIPTION_LABEL, "description").
51-define(DATA_TYPES_TITLE, "Data Types").
52-define(DATA_TYPES_LABEL, "types").
53-define(FUNCTION_INDEX_TITLE, "Function Index").
54-define(FUNCTION_INDEX_LABEL, "index").
55-define(FUNCTIONS_TITLE, "Function Details").
56-define(FUNCTIONS_LABEL, "functions").
57
58%% @doc The layout function.
59%%
60%% Options to the standard layout:
61%% <dl>
62%%  <dt>{@type {index_columns, integer()@}}
63%%  </dt>
64%%  <dd>Specifies the number of column pairs used for the function
65%%      index tables. The default value is 1.
66%%  </dd>
67%%  <dt>{@type {pretty_printer, atom()@}}
68%%  </dt>
69%%  <dd>Specifies how types and specifications are pretty printed.
70%%      If the value `erl_pp' is specified the Erlang pretty printer
71%%      (the module `erl_pp') will be used. The default is to do
72%%      no pretty printing which implies that lines can be very long.
73%%  </dd>
74%%  <dt>{@type {stylesheet, string()@}}
75%%  </dt>
76%%  <dd>Specifies the URI used for referencing the stylesheet. The
77%%      default value is `"stylesheet.css"'. If an empty string is
78%%      specified, no stylesheet reference will be generated.
79%%  </dd>
80%%  <dt>{@type {sort_functions, boolean()@}}
81%%  </dt>
82%%  <dd>If `true', the detailed function descriptions are listed by
83%%      name, otherwise they are listed in the order of occurrence in
84%%      the source file. The default value is `true'.
85%%  </dd>
86%%  <dt>{@type {xml_export, Module::atom()@}}
87%%  </dt>
88%%  <dd>Specifies an {@link //xmerl. `xmerl'} callback module to be
89%%      used for exporting the documentation. See {@link
90%%      //xmerl/xmerl:export_simple/3} for details.
91%%  </dd>
92%% </dl>
93%%
94%% @see edoc:layout/2
95
96%% NEW-OPTIONS: xml_export, index_columns, stylesheet
97
98module(Element, Options) ->
99    XML = layout_module(Element, init_opts(Element, Options)),
100    Export = proplists:get_value(xml_export, Options,
101				 ?DEFAULT_XML_EXPORT),
102    xmerl:export_simple(XML, Export, []).
103
104% Put layout options in a data structure for easier access.
105
106-record(opts, {root,
107               stylesheet,
108               index_columns,
109               sort_functions,
110               encoding,
111               pretty_printer}).
112
113%-type opts() :: #opts{root :: string(),
114%                      stylesheet :: string(),
115%                      index_columns :: integer()}.
116
117init_opts(Element, Options) ->
118    Encoding = case get_attrval(encoding, Element) of
119                   "latin1" -> latin1;
120                   _ -> utf8
121               end,
122    R = #opts{root = get_attrval(root, Element),
123	      index_columns = proplists:get_value(index_columns,
124						  Options, 1),
125	      sort_functions = proplists:get_value(sort_functions,
126						   Options, true),
127              encoding = Encoding,
128              pretty_printer = proplists:get_value(pretty_printer,
129                                                   Options, '')
130	     },
131    case proplists:get_value(stylesheet, Options) of
132	undefined ->
133	    S = edoc_lib:join_uri(R#opts.root, ?STYLESHEET),
134	    R#opts{stylesheet = S};
135	"" ->
136	    R;  % don't use any stylesheet
137	S when is_list(S) ->
138	    R#opts{stylesheet = S};
139	_ ->
140	    report("bad value for option `stylesheet'.", []),
141	    exit(error)
142    end.
143
144
145%% =====================================================================
146%% XML-BASED LAYOUT ENGINE
147%% =====================================================================
148
149%% We assume that we have expanded XML data.
150
151%% <!ELEMENT module (behaviour*, description?, author*, copyright?,
152%%                   version?, since?, deprecated?, see*, reference*,
153%%                   todo?, typedecls?, functions)>
154%% <!ATTLIST module
155%%   name CDATA #REQUIRED
156%%   private NMTOKEN(yes | no) #IMPLIED
157%%   root CDATA #IMPLIED>
158%% <!ELEMENT behaviour (#PCDATA)>
159%% <!ATTLIST behaviour
160%%   href CDATA #IMPLIED>
161%% <!ELEMENT description (briefDescription, fullDescription?)>
162%% <!ELEMENT briefDescription (#PCDATA)>
163%% <!ELEMENT fullDescription (#PCDATA)>
164%% <!ELEMENT author EMPTY>
165%% <!ATTLIST author
166%%   name CDATA #REQUIRED
167%%   email CDATA #IMPLIED
168%%   website CDATA #IMPLIED>
169%% <!ELEMENT version (#PCDATA)>
170%% <!ELEMENT since (#PCDATA)>
171%% <!ELEMENT copyright (#PCDATA)>
172%% <!ELEMENT deprecated (description)>
173%% <!ELEMENT see (#PCDATA)>
174%% <!ATTLIST see
175%%   name CDATA #REQUIRED
176%%   href CDATA #IMPLIED>
177%% <!ELEMENT reference (#PCDATA)>
178%% <!ELEMENT todo (#PCDATA)>
179%% <!ELEMENT typedecls (typedecl+)>
180%% <!ELEMENT functions (function+)>
181
182%% TODO: improve layout of parameterized modules
183
184layout_module(#xmlElement{name = module, content = Es}=E, Opts) ->
185    Args = module_params(get_content(args, Es)),
186    Name = get_attrval(name, E),
187    Title = case get_elem(args, Es) of
188		[] -> ["Module ", Name];
189		_ -> ["Abstract module ", Name, " [", {Args}, "]"]
190	    end,
191    Desc = get_content(description, Es),
192    ShortDesc = get_content(briefDescription, Desc),
193    FullDesc = get_content(fullDescription, Desc),
194    Functions = [{function_name(E, Opts), E} ||
195                    E <- get_content(functions, Es)],
196    Types = [{type_name(E, Opts), E} || E <- get_content(typedecls, Es)],
197    SortedFs = if Opts#opts.sort_functions -> lists:sort(Functions);
198                  true -> Functions
199               end,
200    Body = (navigation("top")
201            ++ [?NL, hr, ?NL, ?NL, {h1, Title}, ?NL]
202	    ++ doc_index(FullDesc, Functions, Types)
203	    ++ ShortDesc
204	    ++ [?NL]
205	    ++ copyright(Es)
206	    ++ deprecated(Es, "module")
207	    ++ [?NL]
208	    ++ version(Es)
209	    ++ since(Es)
210	    ++ behaviours(Es, Name, Opts)
211	    ++ authors(Es)
212	    ++ references(Es)
213	    ++ sees(Es)
214	    ++ todos(Es)
215	    ++ if FullDesc == [] -> [];
216		  true -> [?NL,
217			   {h2, [{a, [{name, "description"}],
218				  ["Description"]}]}
219			   | FullDesc]
220	       end
221	    ++ types(lists:sort(Types), Opts)
222	    ++ function_index(SortedFs, Opts#opts.index_columns)
223	    ++ functions(SortedFs, Opts)
224	    ++ [hr, ?NL]
225	    ++ navigation("bottom")
226	    ++ footer()),
227    Encoding = Opts#opts.encoding,
228    xhtml(Title, stylesheet(Opts), Body, Encoding).
229
230module_params(Es) ->
231    As = [{get_text(argName, Es1),
232	   get_content(fullDescription, get_content(description, Es1))}
233	  || #xmlElement{content = Es1} <- Es],
234    case As of
235	[] -> [];
236	[First | Rest] ->
237	    [element(1, First) | [ {[", ",A]} || {A, _D} <- Rest]]
238    end.
239
240footer() ->
241    [?NL, {p, [{i, ["Generated by EDoc"]}]}, ?NL].
242
243stylesheet(Opts) ->
244    case Opts#opts.stylesheet of
245	undefined ->
246	    [];
247	CSS ->
248	    [{link, [{rel, "stylesheet"},
249		     {type, "text/css"},
250		     {href, CSS},
251		     {title, "EDoc"}], []},
252	     ?NL]
253    end.
254
255navigation(Where) ->
256    [?NL,
257     {'div', [{class, "navbar"}],
258      [{a, [{name, "#navbar_" ++ Where}], []},
259       {table, [{width, "100%"}, {border,0},
260		{cellspacing, 0}, {cellpadding, 2},
261		{summary, "navigation bar"}],
262	[{tr,
263	  [{td, [{a, [{href, ?OVERVIEW_SUMMARY}, {target,"overviewFrame"}],
264		  ["Overview"]}]},
265	   {td, [{a, [{href, "http://www.erlang.org/"}],
266		  [{img, [{src, "erlang.png"}, {align, "right"},
267			  {border, 0}, {alt, "erlang logo"}],
268		    []}]}
269		]}
270	  ]}
271	]}
272      ]}
273    ].
274
275doc_index(FullDesc, Functions, Types) ->
276    case doc_index_rows(FullDesc, Functions, Types) of
277	[] -> [];
278	Rs ->
279	    [{ul, [{class, "index"}],
280	      [{li, [{a, [{href, local_label(R)}], [T]}]}
281	       || {T, R} <- Rs]}]
282    end.
283
284doc_index_rows(FullDesc, Functions, Types) ->
285    (if FullDesc == [] -> [];
286	true -> [{?DESCRIPTION_TITLE, ?DESCRIPTION_LABEL}]
287     end
288     ++ if Types == [] -> [];
289	   true -> [{?DATA_TYPES_TITLE, ?DATA_TYPES_LABEL}]
290	end
291     ++ if Functions == [] -> [];
292	   true -> [{?FUNCTION_INDEX_TITLE, ?FUNCTION_INDEX_LABEL},
293		    {?FUNCTIONS_TITLE, ?FUNCTIONS_LABEL}]
294	end).
295
296function_index(Fs, Cols) ->
297    case function_index_rows(Fs, Cols, []) of
298	[] -> [];
299	Rows ->
300	    [?NL,
301	     {h2, [{a, [{name, ?FUNCTION_INDEX_LABEL}],
302		    [?FUNCTION_INDEX_TITLE]}]},
303	     ?NL,
304	     {table, [{width, "100%"}, {border, 1},
305		      {cellspacing,0}, {cellpadding,2},
306		      {summary, "function index"}],
307	      Rows},
308	     ?NL]
309    end.
310
311function_index_rows(Fs, Cols, Title) ->
312    Rows = (length(Fs) + (Cols - 1)) div Cols,
313    (if Title == [] -> [];
314	true -> [{tr, [{th, [{colspan, Cols * 2}, {align, left}],
315			[Title]}]},
316		 ?NL]
317     end
318     ++ lists:flatmap(fun index_row/1,
319		      edoc_lib:transpose(edoc_lib:segment(Fs, Rows)))).
320
321index_row(Fs) ->
322    [{tr, lists:flatmap(fun index_col/1, Fs)}, ?NL].
323
324index_col({Name, F=#xmlElement{content = Es}}) ->
325    [{td, [{valign, "top"}],
326      label_href(function_header(Name, F, "*"), F)},
327     {td, index_desc(Es)}].
328
329index_desc(Es) ->
330    Desc = get_content(description, Es),
331    (case get_content(deprecated, Es) of
332 	 [] -> [];
333 	 _ -> ["(", {em, ["Deprecated"]}, ".) "]
334     end
335     ++ case get_content(briefDescription, Desc) of
336	    [] ->
337		equiv(Es);    % no description at all if no equiv
338	    ShortDesc ->
339		ShortDesc
340	end).
341
342label_href(Content, F) ->
343    case get_attrval(label, F) of
344	"" -> Content;
345	Ref -> [{a, [{href, local_label(Ref)}], Content}]
346    end.
347
348%% <!ELEMENT function (args, typespec?, returns?, throws?, equiv?,
349%%                     description?, since?, deprecated?, see*, todo?)>
350%% <!ATTLIST function
351%%   name CDATA #REQUIRED
352%%   arity CDATA #REQUIRED
353%%   exported NMTOKEN(yes | no) #REQUIRED
354%%   label CDATA #IMPLIED>
355%% <!ELEMENT args (arg*)>
356%% <!ELEMENT equiv (expr, see?)>
357%% <!ELEMENT expr (#PCDATA)>
358
359functions(Fs, Opts) ->
360    Es = lists:flatmap(fun ({Name, E}) -> function(Name, E, Opts) end, Fs),
361    if Es == [] -> [];
362        true ->
363            [?NL,
364             {h2, [{a, [{name, ?FUNCTIONS_LABEL}], [?FUNCTIONS_TITLE]}]},
365             ?NL | Es]
366    end.
367
368function(Name, E=#xmlElement{content = Es}, Opts) ->
369    ([?NL,
370      {h3, [{class, "function"}],
371       label_anchor(function_header(Name, E, " *"), E)},
372      ?NL]
373     ++ [{'div',  [{class, "spec"}],
374	    case [typespec(T, Opts) || T <- get_contents(typespec, Es)] of
375		[] ->
376            [?NL,{p,
377            signature(get_content(args, Es),
378			      atom(get_attrval(name, E), Opts))
379            },?NL];
380		Specs ->
381            [?NL]++[{p, Spec} || Spec <- Specs]++[?NL]
382	    end
383	  ++ case [params(A) || A <- get_contents(args, Es)] of
384		 [] -> [];
385		 As ->
386             lists:append([[{p, Ps}, ?NL] || Ps <- As])
387	     end
388	  ++ case [returns(Ret) || Ret <- get_contents(returns, Es)] of
389		 [] -> [];
390		 Rets ->
391             lists:append([[{p, Rs}, ?NL] || Rs <- Rets])
392	     end}]
393     ++ throws(Es, Opts)
394     ++ equiv_p(Es)
395     ++ deprecated(Es, "function")
396     ++ fulldesc(Es)
397     ++ since(Es)
398     ++ sees(Es)
399     ++ todos(Es)).
400
401function_name(E, Opts) ->
402    atom(get_attrval(name, E), Opts) ++ "/" ++ get_attrval(arity, E).
403
404function_header(Name, E, Private) ->
405    case is_exported(E) of
406	true -> [Name];
407	false -> [Name, Private]
408    end.
409
410is_exported(E) ->
411    case get_attrval(exported, E) of
412 	"yes" -> true;
413 	_ -> false
414    end.
415
416label_anchor(Content, E) ->
417    case get_attrval(label, E) of
418	"" -> Content;
419	Ref -> [{a, [{name, Ref}], Content}]
420    end.
421
422%% <!ELEMENT args (arg*)>
423%% <!ELEMENT arg (argName, description?)>
424%% <!ELEMENT argName (#PCDATA)>
425
426%% This is currently only done for functions without type spec.
427
428signature(Es, Name) ->
429    [{tt, [Name, "("] ++ seq(fun arg/1, Es) ++ [") -> any()"]}].
430
431arg(#xmlElement{content = Es}) ->
432    [get_text(argName, Es)].
433
434%% parameter and return value descriptions (if any)
435
436params(Es) ->
437    As = [{get_text(argName, Es1),
438	   get_content(fullDescription, get_content(description, Es1))}
439	  || #xmlElement{content = Es1} <- Es],
440    As1 = [A || A <- As, element(2, A) /= []],
441    if As1 == [] ->
442	    [];
443       true ->
444	    [ { [{tt, [A]}, ": "] ++  D ++ [br, ?NL] }
445	      || {A, D} <- As1]
446    end.
447
448returns(Es) ->
449    case get_content(fullDescription, get_content(description, Es)) of
450	[] ->
451	    [];
452	D ->
453	    ["returns: "] ++  D
454    end.
455
456%% <!ELEMENT throws (type, localdef*)>
457
458throws(Es, Opts) ->
459    case get_content(throws, Es) of
460	[] -> [];
461	Es1 ->
462            %% Doesn't use format_type; keep it short!
463	    [{p, (["throws ", {tt, t_utype(get_elem(type, Es1), Opts)}]
464		  ++ local_defs(get_elem(localdef, Es1), Opts))},
465	     ?NL]
466    end.
467
468%% <!ELEMENT typespec (erlangName, type, localdef*)>
469
470typespec([], _Opts) -> [];
471typespec(Es, Opts) ->
472    Name = t_name(get_elem(erlangName, Es), Opts),
473    Defs = get_elem(localdef, Es),
474    [Type] = get_elem(type, Es),
475    format_spec(Name, Type, Defs, Opts) ++ local_defs(Defs, Opts).
476
477%% <!ELEMENT typedecl (typedef, description?)>
478%% <!ELEMENT typedef (erlangName, argtypes, type?, localdef*)>
479
480types([], _Opts) -> [];
481types(Ts, Opts) ->
482    Es = lists:flatmap(fun ({Name, E}) -> typedecl(Name, E, Opts) end, Ts),
483    [?NL,
484     {h2, [{a, [{name, ?DATA_TYPES_LABEL}],
485	    [?DATA_TYPES_TITLE]}]},
486     ?NL | Es].
487
488typedecl(Name, E=#xmlElement{content = Es}, Opts) ->
489    ([?NL, {h3, [{class, "typedecl"}], label_anchor([Name, "()"], E)}, ?NL]
490     ++ [{p, typedef(get_content(typedef, Es), Opts)}, ?NL]
491     ++ fulldesc(Es)).
492
493type_name(#xmlElement{content = Es}, Opts) ->
494    t_name(get_elem(erlangName, get_content(typedef, Es)), Opts).
495
496typedef(Es, Opts) ->
497    Name = ([t_name(get_elem(erlangName, Es), Opts), "("]
498            ++ seq(t_utype_elem_fun(Opts), get_content(argtypes, Es), [")"])),
499    (case get_elem(type, Es) of
500 	 [] -> [{b, ["abstract datatype"]}, ": ", {tt, Name}];
501         Type -> format_type(Name, Name, Type, [], Opts)
502     end
503     ++ local_defs(get_elem(localdef, Es), Opts)).
504
505local_defs(Es, Opts) ->
506    local_defs(Es, [], Opts).
507
508local_defs([], _, _Opts) -> [];
509local_defs(Es0, Last, Opts) ->
510    [E | Es] = lists:reverse(Es0),
511    [?NL,
512     {ul, [{class, "definitions"}],
513      lists:reverse(lists:append([localdef(E1, [], Opts) || E1 <- Es]),
514                    localdef(E, Last, Opts))}].
515
516localdef(E = #xmlElement{content = Es}, Last, Opts) ->
517    Name = case get_elem(typevar, Es) of
518               [] ->
519                   label_anchor(N0 = t_abstype(get_content(abstype, Es),
520                                               Opts),
521                                E);
522               [V] ->
523                   N0 = t_var(V)
524           end,
525    [{li, format_type(Name, N0, get_elem(type, Es), Last, Opts)}].
526
527%% Use the default formatting of EDoc, which creates references, and
528%% then insert newlines and indentation according to erl_pp (the
529%% (fast) Erlang pretty printer).
530format_spec(Name, Type, Defs, #opts{pretty_printer = erl_pp}=Opts) ->
531    try
532        L = t_clause(Name, Type, Opts),
533        O = pp_clause(Name, Type, Opts),
534        {R, ".\n"} = etypef(L, O, Opts),
535        [{pre, R}]
536    catch _:_ ->
537        %% Should not happen.
538        format_spec(Name, Type, Defs, Opts#opts{pretty_printer=''})
539    end;
540format_spec(Sep, Type, Defs, Opts) ->
541    %% Very limited formatting.
542    Br = if Defs =:= [] -> br; true -> [] end,
543    [{tt, t_clause(Sep, Type, Opts)}, Br].
544
545t_clause(Name, Type, Opts) ->
546    #xmlElement{content = [#xmlElement{name = 'fun', content = C}]} = Type,
547    [Name] ++ t_fun(C, Opts).
548
549pp_clause(Pre, Type, Opts) ->
550    Types = ot_utype([Type]),
551    Atom = lists:duplicate(string:length(Pre), $a),
552    Attr = {attribute,0,spec,{{list_to_atom(Atom),0},[Types]}},
553    L1 = erl_pp:attribute(erl_parse:new_anno(Attr),
554                          [{encoding, Opts#opts.encoding}]),
555    "-spec " ++ L2 = lists:flatten(L1),
556    L3 = Pre ++ lists:nthtail(length(Atom), L2),
557    re:replace(L3, "\n      ", "\n", [{return,list},global,unicode]).
558
559format_type(Prefix, Name, Type, Last, #opts{pretty_printer = erl_pp}=Opts) ->
560    try
561        L = t_utype(Type, Opts),
562        O = pp_type(Name, Type, Opts),
563        {R, ".\n"} = etypef(L, O, Opts),
564        [{pre, Prefix ++ [" = "] ++ R ++ Last}]
565    catch _:_ ->
566        %% Example: "t() = record(a)."
567        format_type(Prefix, Name, Type, Last, Opts#opts{pretty_printer =''})
568    end;
569format_type(Prefix, _Name, Type, Last, Opts) ->
570    [{tt, Prefix ++ [" = "] ++ t_utype(Type, Opts) ++ Last}].
571
572pp_type(Prefix, Type, Opts) ->
573    Atom = list_to_atom(lists:duplicate(string:length(Prefix), $a)),
574    Attr = {attribute,0,type,{Atom,ot_utype(Type),[]}},
575    L1 = erl_pp:attribute(erl_parse:new_anno(Attr),
576                          [{encoding, Opts#opts.encoding}]),
577    {L2,N} = case lists:dropwhile(fun(C) -> C =/= $: end, lists:flatten(L1)) of
578                 ":: " ++ L3 -> {L3,9}; % compensation for extra "()" and ":"
579                 "::\n" ++ L3 -> {"\n"++L3,6}
580             end,
581    Ss = lists:duplicate(N, $\s),
582    re:replace(L2, "\n"++Ss, "\n", [{return,list},global,unicode]).
583
584etypef(L, O0, Opts) ->
585    {R, O} = etypef(L, [], O0, [], Opts),
586    {lists:reverse(R), O}.
587
588etypef([C | L], St, [C | O], R, Opts) ->
589    etypef(L, St, O, [[C] | R], Opts);
590etypef(" "++L, St, O, R, Opts) ->
591    etypef(L, St, O, R, Opts);
592etypef("", [Cs | St], O, R, Opts) ->
593    etypef(Cs, St, O, R, Opts);
594etypef("", [], O, R, _Opts) ->
595    {R, O};
596etypef(L, St, " "++O, R, Opts) ->
597    etypef(L, St, O, [" " | R], Opts);
598etypef(L, St, "\n"++O, R, Opts) ->
599    Ss = lists:takewhile(fun(C) -> C =:= $\s end, O),
600    etypef(L, St, lists:nthtail(length(Ss), O), ["\n"++Ss | R], Opts);
601etypef([{a, HRef, S0} | L], St, O0, R, Opts) ->
602    {S, O} = etypef(S0, app_fix(O0, Opts), Opts),
603    etypef(L, St, O, [{a, HRef, S} | R], Opts);
604etypef("="++L, St, "::"++O, R, Opts) ->
605    %% EDoc uses "=" for record field types; Erlang types use "::".
606    %% Maybe there should be an option for this, possibly affecting
607    %% other similar discrepancies.
608    etypef(L, St, O, ["=" | R], Opts);
609etypef([Cs | L], St, O, R, Opts) ->
610    etypef(Cs, [L | St], O, R, Opts).
611
612app_fix(L, Opts) ->
613    try
614        {"//" ++ R1,L2} = app_fix1(L, 1),
615        [App, Mod] = string:lexemes(R1, "/"),
616        "//" ++ atom(App, Opts) ++ "/" ++ atom(Mod, Opts) ++ L2
617    catch _:_ -> L
618    end.
619
620app_fix1(L, I) -> % a bit slow
621    {L1, L2} = lists:split(I, L),
622    case erl_scan:tokens([], L1 ++ ". ", 1) of
623        {done, {ok,[{atom,_,Atom}|_],_}, _} -> {atom_to_list(Atom), L2};
624        _ -> app_fix1(L, I+1)
625    end.
626
627fulldesc(Es) ->
628    case get_content(fullDescription, get_content(description, Es)) of
629	[] -> [?NL];
630	Desc -> [{p, Desc}, ?NL]
631    end.
632
633sees(Es) ->
634    case get_elem(see, Es) of
635	[] -> [];
636	Es1 ->
637	    [{p, [{b, ["See also:"]}, " "] ++ seq(fun see/1, Es1, ["."])},
638	     ?NL]
639    end.
640
641see(E=#xmlElement{content = Es}) ->
642    see(E, Es).
643
644see(E, Es) ->
645    case href(E) of
646	[] -> Es;
647	Ref ->
648	    [{a, Ref, Es}]
649    end.
650
651href(E) ->
652    case get_attrval(href, E) of
653	"" -> [];
654	URI ->
655	    T = case get_attrval(target, E) of
656		    "" -> [];
657		    S -> [{target, S}]
658		end,
659	    [{href, URI} | T]
660    end.
661
662equiv_p(Es) ->
663    equiv(Es, true).
664
665equiv(Es) ->
666    equiv(Es, false).
667
668equiv(Es, P) ->
669    case get_content(equiv, Es) of
670	[] -> [];
671	Es1 ->
672	    case get_content(expr, Es1) of
673		[] -> [];
674		[Expr] ->
675		    Expr1 = [{tt, [Expr]}],
676		    Expr2 = case get_elem(see, Es1) of
677				[] ->
678				    Expr1;
679				[E=#xmlElement{}] ->
680				    see(E, Expr1)
681			    end,
682		    Txt = ["Equivalent to "] ++ Expr2 ++ ["."],
683		    (case P of
684			 true -> [{p, Txt}];
685			 false -> Txt
686		     end
687		     ++ [?NL])
688	    end
689    end.
690
691copyright(Es) ->
692    case get_content(copyright, Es) of
693	[] -> [];
694	Es1 ->
695	    [{p, ["Copyright \251 " | Es1]}, ?NL]
696    end.
697
698version(Es) ->
699    case get_content(version, Es) of
700	[] -> [];
701	Es1 ->
702	    [{p, [{b, ["Version:"]}, " " | Es1]}, ?NL]
703    end.
704
705since(Es) ->
706    case get_content(since, Es) of
707	[] -> [];
708	Es1 ->
709	    [{p, [{b, ["Introduced in:"]}, " " | Es1]}, ?NL]
710    end.
711
712deprecated(Es, S) ->
713    Es1 = get_content(description, get_content(deprecated, Es)),
714    case get_content(fullDescription, Es1) of
715	[] -> [];
716	Es2 ->
717	    [{p, [{b, ["This " ++ S ++ " is deprecated:"]}, " " | Es2]},
718	     ?NL]
719    end.
720
721behaviours(Es, Name, Opts) ->
722    CBs = get_content(callbacks, Es),
723    OCBs = get_content(optional_callbacks, Es),
724    (case get_elem(behaviour, Es) of
725	 [] -> [];
726	 Es1 ->
727	     [{p, ([{b, ["Behaviours:"]}, " "]
728		   ++ seq(fun behaviour/1, Es1, ["."]))},
729	      ?NL]
730     end
731     ++
732     if CBs =:= [], OCBs =:= [] ->
733             [];
734	 true ->
735             CBFun = fun(E) -> callback(E, Opts) end,
736             Req = if CBs =:= [] ->
737                       [];
738                       true ->
739                           [br, " Required callback functions: "]
740                           ++ seq(CBFun, CBs, ["."])
741                   end,
742             Opt = if OCBs =:= [] ->
743                       [];
744                       true ->
745                           [br, " Optional callback functions: "]
746                           ++ seq(CBFun, OCBs, ["."])
747                   end,
748	     [{p, ([{b, ["This module defines the ", {tt, [Name]},
749			 " behaviour."]}]
750                   ++ Req ++ Opt)},
751	      ?NL]
752     end).
753
754behaviour(E=#xmlElement{content = Es}) ->
755    see(E, [{tt, Es}]).
756
757callback(E=#xmlElement{}, Opts) ->
758    Name = get_attrval(name, E),
759    Arity = get_attrval(arity, E),
760    [{tt, [atom(Name, Opts), "/", Arity]}].
761
762authors(Es) ->
763    case get_elem(author, Es) of
764	[] -> [];
765	Es1 ->
766	    [{p, [{b, ["Authors:"]}, " "] ++ seq(fun author/1, Es1, ["."])},
767	     ?NL]
768    end.
769
770atom(String, #opts{encoding = latin1}) ->
771    io_lib:write_atom_as_latin1(list_to_atom(String));
772atom(String, #opts{encoding = utf8}) ->
773    io_lib:write_atom(list_to_atom(String)).
774
775%% <!ATTLIST author
776%%   name CDATA #REQUIRED
777%%   email CDATA #IMPLIED
778%%   website CDATA #IMPLIED>
779
780author(E=#xmlElement{}) ->
781    Name = get_attrval(name, E),
782    Mail = get_attrval(email, E),
783    URI = get_attrval(website, E),
784    (if Name == Mail ->
785	     [{a, [{href, "mailto:" ++ Mail}],[{tt, [Mail]}]}];
786	true ->
787	     if Mail == "" -> [Name];
788		true -> [Name, " (", {a, [{href, "mailto:" ++ Mail}],
789				      [{tt, [Mail]}]}, ")"]
790	     end
791     end
792     ++ if URI == "" ->
793		[];
794	   true ->
795		[" [", {em, ["web site:"]}, " ",
796		 {tt, [{a, [{href, URI}, {target, "_top"}], [URI]}]},
797		 "]"]
798	end).
799
800references(Es) ->
801    case get_elem(reference, Es) of
802	[] -> [];
803	Es1 ->
804	    [{p, [{b, ["References"]},
805		  {ul, [{li, C} || #xmlElement{content = C} <- Es1]}]},
806	     ?NL]
807    end.
808
809todos(Es) ->
810    case get_elem(todo, Es) of
811	[] -> [];
812	Es1 ->
813	    Todos = [{li, [{font, [{color,red}], C}]}
814		     || #xmlElement{content = C} <- Es1],
815	    [{p, [{b, [{font, [{color,red}], ["To do"]}]},
816		  {ul, Todos}]},
817	     ?NL]
818    end.
819
820t_name([E], Opts) ->
821    N = get_attrval(name, E),
822    case get_attrval(module, E) of
823	"" -> atom(N, Opts);
824	M ->
825	    S = atom(M, Opts) ++ ":" ++ atom(N, Opts),
826	    case get_attrval(app, E) of
827		"" -> S;
828		A -> "//" ++ atom(A, Opts) ++ "/" ++ S
829	    end
830    end.
831
832t_utype([E], Opts) ->
833    t_utype_elem(E, Opts).
834
835t_utype_elem_fun(Opts) ->
836    fun(E) -> t_utype_elem(E, Opts) end.
837
838t_utype_elem(E=#xmlElement{content = Es}, Opts) ->
839    case get_attrval(name, E) of
840	"" -> t_type(Es, Opts);
841	Name ->
842	    T = t_type(Es, Opts),
843	    case T of
844		[Name] -> T;    % avoid generating "Foo::Foo"
845		T -> [Name] ++ ["::"] ++ T
846	    end
847    end.
848
849t_type([E=#xmlElement{name = typevar}], _Opts) ->
850    t_var(E);
851t_type([E=#xmlElement{name = atom}], Opts) ->
852    t_atom(E, Opts);
853t_type([E=#xmlElement{name = integer}], _Opts) ->
854    t_integer(E);
855t_type([E=#xmlElement{name = range}], _Opts) ->
856    t_range(E);
857t_type([E=#xmlElement{name = binary}], _Opts) ->
858    t_binary(E);
859t_type([E=#xmlElement{name = float}], _Opts) ->
860    t_float(E);
861t_type([#xmlElement{name = nil}], _Opts) ->
862    t_nil();
863t_type([#xmlElement{name = paren, content = Es}], Opts) ->
864    t_paren(Es, Opts);
865t_type([#xmlElement{name = list, content = Es}], Opts) ->
866    t_list(Es, Opts);
867t_type([#xmlElement{name = nonempty_list, content = Es}], Opts) ->
868    t_nonempty_list(Es, Opts);
869t_type([#xmlElement{name = map, content = Es}], Opts) ->
870    t_map(Es, Opts);
871t_type([#xmlElement{name = tuple, content = Es}], Opts) ->
872    t_tuple(Es, Opts);
873t_type([#xmlElement{name = 'fun', content = Es}], Opts) ->
874    ["fun("] ++ t_fun(Es, Opts) ++ [")"];
875t_type([E = #xmlElement{name = record, content = Es}], Opts) ->
876    t_record(E, Es, Opts);
877t_type([E = #xmlElement{name = abstype, content = Es}], Opts) ->
878    t_abstype(E, Es, Opts);
879t_type([#xmlElement{name = union, content = Es}], Opts) ->
880    t_union(Es, Opts).
881
882t_var(E) ->
883    [get_attrval(name, E)].
884
885t_atom(E, Opts) ->
886    [atom(get_attrval(value, E), Opts)].
887
888t_integer(E) ->
889    [get_attrval(value, E)].
890
891t_range(E) ->
892    [get_attrval(value, E)].
893
894t_binary(E) ->
895    [get_attrval(value, E)].
896
897t_float(E) ->
898    [get_attrval(value, E)].
899
900t_nil() ->
901    ["[]"].
902
903t_paren(Es, Opts) ->
904    ["("] ++ t_utype(get_elem(type, Es), Opts) ++ [")"].
905
906t_list(Es, Opts) ->
907    ["["] ++ t_utype(get_elem(type, Es), Opts) ++ ["]"].
908
909t_nonempty_list(Es, Opts) ->
910    ["["] ++ t_utype(get_elem(type, Es), Opts) ++ [", ...]"].
911
912t_tuple(Es, Opts) ->
913    ["{"] ++ seq(t_utype_elem_fun(Opts), Es, ["}"]).
914
915t_fun(Es, Opts) ->
916    ["("] ++ seq(t_utype_elem_fun(Opts), get_content(argtypes, Es),
917		 [") -> "] ++ t_utype(get_elem(type, Es), Opts)).
918
919t_map(Es, Opts) ->
920    Fs = get_elem(map_field, Es),
921    ["#{"] ++ seq(fun(E) -> t_map_field(E, Opts) end, Fs, ["}"]).
922
923t_map_field(#xmlElement{content = [K,V]}=E, Opts) ->
924    KElem = t_utype_elem(K, Opts),
925    VElem = t_utype_elem(V, Opts),
926    AS = case get_attrval(assoc_type, E) of
927             "assoc" -> " => ";
928             "exact" -> " := "
929         end,
930    KElem ++ [AS] ++ VElem.
931
932t_record(E, Es, Opts) ->
933    Name = ["#"] ++ t_type(get_elem(atom, Es), Opts),
934    case get_elem(field, Es) of
935        [] ->
936            see(E, [Name, "{}"]);
937        Fs ->
938            see(E, Name) ++ ["{"] ++ seq(fun(F) -> t_field(F, Opts) end,
939                                         Fs, ["}"])
940    end.
941
942t_field(#xmlElement{content = Es}, Opts) ->
943    (t_type(get_elem(atom, Es), Opts) ++ [" = "] ++
944     t_utype(get_elem(type, Es), Opts)).
945
946t_abstype(E, Es, Opts) ->
947    Name = t_name(get_elem(erlangName, Es), Opts),
948    case get_elem(type, Es) of
949        [] ->
950            see(E, [Name, "()"]);
951        Ts ->
952            see(E, [Name]) ++ ["("] ++ seq(t_utype_elem_fun(Opts), Ts, [")"])
953    end.
954
955t_abstype(Es, Opts) ->
956    ([t_name(get_elem(erlangName, Es), Opts), "("]
957     ++ seq(t_utype_elem_fun(Opts), get_elem(type, Es), [")"])).
958
959t_union(Es, Opts) ->
960    seq(t_utype_elem_fun(Opts), Es, " | ", []).
961
962seq(F, Es) ->
963    seq(F, Es, []).
964
965seq(F, Es, Tail) ->
966    seq(F, Es, ", ", Tail).
967
968seq(F, [E], _Sep, Tail) ->
969    F(E) ++ Tail;
970seq(F, [E | Es], Sep, Tail) ->
971    F(E) ++ [Sep] ++ seq(F, Es, Sep, Tail);
972seq(_F, [], _Sep, Tail) ->
973    Tail.
974
975get_elem(Name, Es) ->
976    [E || #xmlElement{name=N}=E <- Es, N=:=Name].
977
978get_attr(Name, [#xmlAttribute{name = Name} = A | As]) ->
979    [A | get_attr(Name, As)];
980get_attr(Name, [_ | As]) ->
981    get_attr(Name, As);
982get_attr(_, []) ->
983    [].
984
985get_attrval(Name, #xmlElement{attributes = As}) ->
986    case get_attr(Name, As) of
987	[#xmlAttribute{value = V}] ->
988	    V;
989	[] -> ""
990    end.
991
992get_contents(Name, Es) ->
993    case get_elem(Name, Es) of
994        [] -> [];
995        Elems ->
996            [Es1 || #xmlElement{content = Es1} <- Elems]
997    end.
998
999get_content(Name, Es) ->
1000    case get_elem(Name, Es) of
1001	[#xmlElement{content = Es1}] ->
1002	    Es1;
1003	[] -> []
1004    end.
1005
1006get_text(Name, Es) ->
1007    case get_content(Name, Es) of
1008	[#xmlText{value = Text}] ->
1009	    Text;
1010	[] -> ""
1011    end.
1012
1013local_label(R) ->
1014    "#" ++ R.
1015
1016xhtml(Title, CSS, Body, Encoding) ->
1017    EncString = case Encoding of
1018                    latin1 -> "ISO-8859-1";
1019                    utf8 -> "UTF-8"
1020                end,
1021    [{html, [?NL,
1022	     {head, [?NL,
1023		     {meta, [{'http-equiv',"Content-Type"},
1024			     {content, "text/html; charset="++EncString}],
1025		      []},
1026		     ?NL,
1027		     {title, Title},
1028		     ?NL] ++ CSS},
1029	     ?NL,
1030	     {body, [{bgcolor, "white"}], Body},
1031	     ?NL]
1032     },
1033     ?NL].
1034
1035%% ---------------------------------------------------------------------
1036
1037type(E) ->
1038    Opts = init_opts(E, []),
1039    type(E, [], Opts).
1040
1041type(E, Ds, Opts) ->
1042    xmerl:export_simple_content(t_utype_elem(E, Opts) ++ local_defs(Ds, Opts),
1043				?HTML_EXPORT).
1044
1045overview(E=#xmlElement{name = overview, content = Es}, Options) ->
1046    Opts = init_opts(E, Options),
1047    Title = [get_text(title, Es)],
1048    Desc = get_content(description, Es),
1049%    ShortDesc = get_content(briefDescription, Desc),
1050    FullDesc = get_content(fullDescription, Desc),
1051    Body = (navigation("top")
1052	    ++ [?NL, {h1, [Title]}, ?NL]
1053%	    ++ ShortDesc
1054	    ++ copyright(Es)
1055	    ++ version(Es)
1056	    ++ since(Es)
1057	    ++ authors(Es)
1058	    ++ references(Es)
1059	    ++ sees(Es)
1060	    ++ todos(Es)
1061	    ++ FullDesc
1062	    ++ [?NL, hr]
1063	    ++ navigation("bottom")
1064	    ++ footer()),
1065    Encoding = Opts#opts.encoding,
1066    XML = xhtml(Title, stylesheet(Opts), Body, Encoding),
1067    xmerl:export_simple(XML, ?HTML_EXPORT, []).
1068
1069%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% NYTT
1070
1071ot_utype([E]) ->
1072    ot_utype_elem(E).
1073
1074ot_utype_elem(E=#xmlElement{content = Es}) ->
1075    case get_attrval(name, E) of
1076	"" -> ot_type(Es);
1077	N ->
1078            Name = {var,0,list_to_atom(N)},
1079	    T = ot_type(Es),
1080	    case T of
1081		Name -> T;
1082                T -> {ann_type,0,[Name, T]}
1083	    end
1084    end.
1085
1086ot_type([E=#xmlElement{name = typevar}]) ->
1087    ot_var(E);
1088ot_type([E=#xmlElement{name = atom}]) ->
1089    ot_atom(E);
1090ot_type([E=#xmlElement{name = integer}]) ->
1091    ot_integer(E);
1092ot_type([E=#xmlElement{name = range}]) ->
1093    ot_range(E);
1094ot_type([E=#xmlElement{name = binary}]) ->
1095    ot_binary(E);
1096ot_type([E=#xmlElement{name = float}]) ->
1097    ot_float(E);
1098ot_type([#xmlElement{name = nil}]) ->
1099    ot_nil();
1100ot_type([#xmlElement{name = paren, content = Es}]) ->
1101    ot_paren(Es);
1102ot_type([#xmlElement{name = list, content = Es}]) ->
1103    ot_list(Es);
1104ot_type([#xmlElement{name = nonempty_list, content = Es}]) ->
1105    ot_nonempty_list(Es);
1106ot_type([#xmlElement{name = tuple, content = Es}]) ->
1107    ot_tuple(Es);
1108ot_type([#xmlElement{name = map, content = Es}]) ->
1109    ot_map(Es);
1110ot_type([#xmlElement{name = 'fun', content = Es}]) ->
1111    ot_fun(Es);
1112ot_type([#xmlElement{name = record, content = Es}]) ->
1113    ot_record(Es);
1114ot_type([#xmlElement{name = abstype, content = Es}]) ->
1115     ot_abstype(Es);
1116ot_type([#xmlElement{name = union, content = Es}]) ->
1117    ot_union(Es).
1118
1119ot_var(E) ->
1120    {var,0,list_to_atom(get_attrval(name, E))}.
1121
1122ot_atom(E) ->
1123    Name = list_to_atom(get_attrval(value, E)),
1124    {atom,erl_anno:new(0),Name}.
1125
1126ot_integer(E) ->
1127    {integer,0,list_to_integer(get_attrval(value, E))}.
1128
1129ot_range(E) ->
1130    [I1, I2] = string:lexemes(get_attrval(value, E), "."),
1131    {type,0,range,[{integer,0,list_to_integer(I1)},
1132                   {integer,0,list_to_integer(I2)}]}.
1133
1134ot_binary(E) ->
1135    {Base, Unit} =
1136        case string:lexemes(get_attrval(value, E), ",:*><") of
1137            [] ->
1138                {0, 0};
1139            ["_",B] ->
1140                {list_to_integer(B), 0};
1141            ["_","_",U] ->
1142                {0, list_to_integer(U)};
1143            ["_",B,_,"_",U] ->
1144                {list_to_integer(B), list_to_integer(U)}
1145        end,
1146    {type,0,binary,[{integer,0,Base},{integer,0,Unit}]}.
1147
1148ot_float(E) ->
1149    {float,0,list_to_float(get_attrval(value, E))}.
1150
1151ot_nil() ->
1152    {nil,0}.
1153
1154ot_paren(Es) ->
1155    {paren_type,0,[ot_utype(get_elem(type, Es))]}.
1156
1157ot_list(Es) ->
1158    {type,0,list,[ot_utype(get_elem(type, Es))]}.
1159
1160ot_nonempty_list(Es) ->
1161    {type,0,nonempty_list,[ot_utype(get_elem(type, Es))]}.
1162
1163ot_tuple(Es) ->
1164    {type,0,tuple,[ot_utype_elem(E) || E <- Es]}.
1165
1166ot_map(Es) ->
1167    {type,0,map,[ot_map_field(E) || E <- get_elem(map_field,Es)]}.
1168
1169ot_map_field(#xmlElement{content=[K,V]}=E) ->
1170    A = case get_attrval(assoc_type, E) of
1171            "assoc" -> map_field_assoc;
1172            "exact" -> map_field_exact
1173        end,
1174    {type,0,A,[ot_utype_elem(K), ot_utype_elem(V)]}.
1175
1176ot_fun(Es) ->
1177    Range = ot_utype(get_elem(type, Es)),
1178    Args = [ot_utype_elem(A) || A <- get_content(argtypes, Es)],
1179    {type,0,'fun',[{type,0,product,Args},Range]}.
1180
1181ot_record(Es) ->
1182    {type,0,record,[ot_type(get_elem(atom, Es)) |
1183                    [ot_field(F) || F <- get_elem(field, Es)]]}.
1184
1185ot_field(#xmlElement{content = Es}) ->
1186    {type,0,field_type,
1187     [ot_type(get_elem(atom, Es)), ot_utype(get_elem(type, Es))]}.
1188
1189ot_abstype(Es) ->
1190    ot_name(get_elem(erlangName, Es),
1191            [ot_utype_elem(Elem) || Elem <- get_elem(type, Es)]).
1192
1193ot_union(Es) ->
1194    {type,0,union,[ot_utype_elem(E) || E <- Es]}.
1195
1196ot_name(Es, T) ->
1197    case ot_name(Es) of
1198        [Mod, ":", Atom] ->
1199            {remote_type,0,[{atom,0,list_to_atom(Mod)},
1200                            {atom,0,list_to_atom(Atom)},T]};
1201        "tuple" when T =:= [] ->
1202            {type,0,tuple,any};
1203        "map" when T =:= [] ->
1204            {type,0,map,any};
1205        Atom ->
1206            {type,0,list_to_atom(Atom),T}
1207    end.
1208
1209ot_name([E]) ->
1210    Atom = get_attrval(name, E),
1211    case get_attrval(module, E) of
1212	"" -> Atom;
1213	M ->
1214	    case get_attrval(app, E) of
1215		"" ->
1216                    [M, ":", Atom];
1217                A ->
1218                    ["//"++A++"/" ++ M, ":", Atom] % EDoc only!
1219	    end
1220    end.
1221