1/* Part of SWI-Prolog 2 3 Author: Jan Wielemaker 4 E-mail: J.Wielemaker@vu.nl 5 WWW: http://www.swi-prolog.org 6 Copyright (c) 2006-2017, University of Amsterdam 7 VU University Amsterdam 8 All rights reserved. 9 10 Redistribution and use in source and binary forms, with or without 11 modification, are permitted provided that the following conditions 12 are met: 13 14 1. Redistributions of source code must retain the above copyright 15 notice, this list of conditions and the following disclaimer. 16 17 2. Redistributions in binary form must reproduce the above copyright 18 notice, this list of conditions and the following disclaimer in 19 the documentation and/or other materials provided with the 20 distribution. 21 22 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 23 "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 24 LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 25 FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 26 COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, 27 INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, 28 BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 29 LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 30 CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 31 LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN 32 ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 33 POSSIBILITY OF SUCH DAMAGE. 34*/ 35 36:- module(pldoc_htmlsrc, 37 [ source_to_html/3 % +Source, +Out, +Options 38 ]). 39:- use_module(library(apply)). 40:- use_module(library(option)). 41:- use_module(library(debug)). 42:- use_module(library(lists)). 43:- use_module(library(prolog_colour)). 44:- use_module(doc_colour). 45:- use_module(doc_html). 46:- use_module(doc_wiki). 47:- use_module(doc_modes). 48:- use_module(doc_process). 49:- use_module(library(http/html_write)). 50:- use_module(library(http/http_path)). 51:- use_module(library(prolog_xref)). 52 53:- meta_predicate 54 source_to_html(, , ).
66:- predicate_options(source_to_html/3, 3, 67 [ format_comments(boolean), 68 header(boolean), 69 skin(callable), 70 stylesheets(list), 71 title(atom) 72 ]). 73 74 75:- thread_local 76 lineno/0, % print line-no on next output 77 nonl/0, % previous tag implies nl (block level) 78 id/1. % Emitted ids
true (default), use PlDoc formatting for structured
comments.Other options are passed to the following predicates:
105source_to_html(Src, stream(Out), MOptions) :- 106 !, 107 meta_options(is_meta, MOptions, Options), 108 ( option(title(_), Options) 109 -> HeadOptions = Options 110 ; file_base_name(Src, Title), 111 HeadOptions = [title(Title)|Options] 112 ), 113 retractall(lineno), % play safe 114 retractall(nonl), % play safe 115 retractall(id(_)), 116 colour_fragments(Src, Fragments), 117 setup_call_cleanup( 118 ( open_source(Src, In), 119 asserta(user:thread_message_hook(_,_,_), Ref) 120 ), 121 ( print_html_head(Out, HeadOptions), 122 html_fragments(Fragments, In, Out, [], State, Options), 123 copy_rest(In, Out, State, State1), 124 pop_state(State1, Out, In) 125 ), 126 ( erase(Ref), 127 close(In) 128 )), 129 print_html_footer(Out, Options). 130source_to_html(Src, FileSpec, Options) :- 131 absolute_file_name(FileSpec, OutFile, [access(write)]), 132 setup_call_cleanup( 133 open(OutFile, write, Out, [encoding(utf8)]), 134 source_to_html(Src, stream(Out), Options), 135 close(Out)). 136 137open_source(Id, Stream) :- 138 prolog:xref_open_source(Id, Stream), 139 !. 140open_source(File, Stream) :- 141 open(File, read, Stream). 142 143is_meta(skin).
DOCTYPE line and HTML header. Options:
falsetrue (default), format structured comments.call(Closure, Where, Out), where Where
is one of header or footer. These calls are made
just after opening body and before closing body.166print_html_head(Out, Options) :- 167 option(header(true), Options, true), 168 !, 169 option(title(Title), Options, 'Prolog source'), 170 http_absolute_location(pldoc_resource('pldoc.css'), PlDocCSS, []), 171 http_absolute_location(pldoc_resource('pllisting.css'), PlListingCSS, []), 172 option(stylesheets(Sheets), Options, [PlListingCSS, PlDocCSS]), 173 format(Out, '<!DOCTYPE html', []), 174 format(Out, '<html>~n', []), 175 format(Out, ' <head>~n', []), 176 format(Out, ' <title>~w</title>~n', [Title]), 177 forall(member(Sheet, Sheets), 178 format(Out, ' <link rel="stylesheet" type="text/css" href="~w">~n', [Sheet])), 179 format(Out, ' </head>~n', []), 180 format(Out, '<body>~n', []), 181 skin_hook(Out, header, Options). 182print_html_head(Out, Options) :- 183 skin_hook(Out, header, Options). 184 (Out, Options) :- 186 option(header(true), Options, true), 187 !, 188 skin_hook(Out, footer, Options), 189 format(Out, '~N</body>~n', []), 190 format(Out, '</html>', []). 191print_html_footer(Out, Options) :- 192 skin_hook(Out, footer, Options). 193 194skin_hook(Out, Where, Options) :- 195 option(skin(Skin), Options), 196 call(Skin, Where, Out), 197 !. 198skin_hook(_, _, _).
205html_fragments([], _, _, State, State, _). 206html_fragments([H|T], In, Out, State0, State, Options) :- 207 html_fragment(H, In, Out, State0, State1, Options), 208 html_fragments(T, In, Out, State1, State, Options).
216html_fragment(fragment(Start, End, comment(structured), []), 217 In, Out, State0, [], Options) :- 218 option(format_comments(true), Options, true), 219 !, 220 copy_without_trailing_white_lines(In, Start, Out, State0, State1), 221 pop_state(State1, Out, In), 222 Len is End - Start, 223 read_n_codes(In, Len, Comment), 224 is_structured_comment(Comment, Prefix), 225 indented_lines(Comment, Prefix, Lines0), 226 ( section_comment_header(Lines0, Header, Lines1) 227 -> wiki_lines_to_dom(Lines1, [], DOM), 228 phrase(pldoc_html:html(div(class(comment), 229 [Header|DOM])), Tokens), 230 print_html(Out, Tokens) 231 ; stream_property(In, file_name(File)), 232 line_count(In, Line), 233 ( xref_module(File, Module) 234 -> true 235 ; Module = user 236 ), 237 process_modes(Lines0, Module, File:Line, Modes, Args, Lines1), 238 maplist(assert_seen_mode, Modes), 239 DOM = [\pred_dt(Modes, pubdef, []), dd(class=defbody, DOM1)], 240 wiki_lines_to_dom(Lines1, Args, DOM0), 241 strip_leading_par(DOM0, DOM1), 242 phrase(pldoc_html:html(DOM), Tokens), % HACK 243 format(Out, '<dl class="comment">~n', [Out]), 244 print_html(Out, Tokens), 245 format(Out, '</dl>~n', [Out]) 246 ). 247html_fragment(fragment(Start, End, structured_comment, []), 248 In, Out, State0, State, _Options) :- 249 !, 250 copy_to(In, Start, Out, State0, State1), 251 line_count(In, StartLine), 252 Len is End - Start, 253 read_n_codes(In, Len, Comment), 254 is_structured_comment(Comment, Prefix), 255 indented_lines(Comment, Prefix, Lines), 256 ( section_comment_header(Lines, _Header, _RestSectionLines) 257 -> true 258 ; stream_property(In, file_name(File)), 259 line_count(In, Line), 260 ( xref_module(File, Module) 261 -> true 262 ; Module = user 263 ), 264 process_modes(Lines, Module, File:Line, Modes, _Args, _Lines1), 265 maplist(mode_anchor(Out), Modes) 266 ), 267 start_fragment(structured_comment, In, Out, State1, State2), 268 copy_codes(Comment, StartLine, Out, State2, State3), 269 end_fragment(Out, In, State3, State). 270html_fragment(fragment(Start, End, Class, Sub), 271 In, Out, State0, State, Options) :- 272 copy_to(In, Start, Out, State0, State1), 273 start_fragment(Class, In, Out, State1, State2), 274 html_fragments(Sub, In, Out, State2, State3, Options), 275 copy_to(In, End, Out, State3, State4), % TBD: pop-to? 276 end_fragment(Out, In, State4, State). 277 278start_fragment(atom, In, Out, State0, State) :- 279 !, 280 ( peek_code(In, C), 281 C == 39 282 -> start_fragment(quoted_atom, In, Out, State0, State) 283 ; State = [nop|State0] 284 ). 285start_fragment(Class, _, Out, State, [Push|State]) :- 286 element(Class, Tag, CSSClass), 287 !, 288 Push =.. [Tag,class(CSSClass)], 289 ( anchor(Class, ID) 290 -> format(Out, '<~w id="~w" class="~w">', [Tag, ID, CSSClass]) 291 ; format(Out, '<~w class="~w">', [Tag, CSSClass]) 292 ). 293start_fragment(Class, _, Out, State, [span(class(SpanClass))|State]) :- 294 functor(Class, SpanClass, _), 295 format(Out, '<span class="~w">', [SpanClass]). 296 297end_fragment(_, _, [nop|State], State) :- !. 298end_fragment(Out, In, [span(class(directive))|State], State) :- 299 !, 300 copy_full_stop(In, Out), 301 format(Out, '</span>', []), 302 ( peek_code(In, 10), 303 \+ nonl 304 -> assert(nonl) 305 ; true 306 ). 307end_fragment(Out, _, [Open|State], State) :- 308 retractall(nonl), 309 functor(Open, Element, _), 310 format(Out, '</~w>', [Element]). 311 312pop_state([], _, _) :- !. 313pop_state(State, Out, In) :- 314 end_fragment(Out, In, State, State1), 315 pop_state(State1, Out, In).
id we must assign to the fragment of
class Class. This that the first definition of a head with
the id name/arity.324anchor(head(_, Head), Id) :- 325 callable(Head), 326 functor(Head, Name, Arity), 327 format(atom(Id), '~w/~w', [Name, Arity]), 328 ( id(Id) 329 -> fail 330 ; assertz(id(Id)) 331 ). 332 333mode_anchor(Out, Mode) :- 334 mode_anchor_name(Mode, Id), 335 ( id(Id) 336 -> true 337 ; format(Out, '<span id="~w"><span>', [Id]), 338 assertz(id(Id)) 339 ). 340 341assert_seen_mode(Mode) :- 342 mode_anchor_name(Mode, Id), 343 ( id(Id) 344 -> true 345 ; assertz(id(Id)) 346 ).
<&>. If State
does not include a pre environment, create one and skip all
leading blank lines.355copy_to(In, End, Out, State, State) :- 356 member(pre(_), State), 357 !, 358 copy_to(In, End, Out). 359copy_to(In, End, Out, State, [pre(class(listing))|State]) :- 360 format(Out, '<pre class="listing">~n', [Out]), 361 line_count(In, Line0), 362 read_to(In, End, Codes0), 363 delete_leading_white_lines(Codes0, Codes, Line0, Line), 364 assert(lineno), 365 write_codes(Codes, Line, Out). 366 367copy_codes(Codes, Line, Out, State, State) :- 368 member(pre(_), State), 369 !, 370 write_codes(Codes, Line, Out). 371copy_codes(Codes0, Line0, Out, State, State) :- 372 format(Out, '<pre class="listing">~n', [Out]), 373 delete_leading_white_lines(Codes0, Codes, Line0, Line), 374 assert(lineno), 375 write_codes(Codes, Line, Out).
382copy_full_stop(In, Out) :- 383 get_code(In, C0), 384 copy_full_stop(C0, In, Out). 385 386copy_full_stop(0'., _, Out) :- 387 !, 388 put_code(Out, 0'.). 389copy_full_stop(C, In, Out) :- 390 put_code(Out, C), 391 get_code(In, C2), 392 copy_full_stop(C2, In, Out).
401delete_leading_white_lines(Codes0, Codes, Line0, Line) :- 402 append(LineCodes, [10|Rest], Codes0), 403 all_spaces(LineCodes), 404 !, 405 Line1 is Line0 + 1, 406 delete_leading_white_lines(Rest, Codes, Line1, Line). 407delete_leading_white_lines(Codes, Codes, Line, Line).
414copy_without_trailing_white_lines(In, End, Out, State, State) :- 415 member(pre(_), State), 416 !, 417 line_count(In, Line), 418 read_to(In, End, Codes0), 419 delete_trailing_white_lines(Codes0, Codes), 420 write_codes(Codes, Line, Out). 421copy_without_trailing_white_lines(In, End, Out, State0, State) :- 422 copy_to(In, End, Out, State0, State). 423 424delete_trailing_white_lines(Codes0, []) :- 425 all_spaces(Codes0), 426 !. 427delete_trailing_white_lines(Codes0, Codes) :- 428 append(Codes, Tail, [10|Rest], Codes0), 429 !, 430 delete_trailing_white_lines(Rest, Tail). 431delete_trailing_white_lines(Codes, Codes).
437append(T, T, L, L). 438append([H|T0], Tail, L, [H|T]) :- 439 append(T0, Tail, L, T). 440 441all_spaces([]). 442all_spaces([H|T]) :- 443 code_type(H, space), 444 all_spaces(T). 445 446copy_to(In, End, Out) :- 447 line_count(In, Line), 448 read_to(In, End, Codes), 449 ( debugging(htmlsrc) 450 -> length(Codes, Count), 451 debug(htmlsrc, 'Copy ~D chars: ~s', [Count, Codes]) 452 ; true 453 ), 454 write_codes(Codes, Line, Out). 455 456read_to(In, End, Codes) :- 457 character_count(In, Here), 458 Len is End - Here, 459 read_n_codes(In, Len, Codes).
465write_codes([], _, _). 466write_codes([H|T], L0, Out) :- 467 content_escape(H, Out, L0, L1), 468 write_codes(T, L1, Out).
<&>480content_escape(_, Out, L, _) :- 481 ( lineno 482 -> retractall(lineno), 483 write_line_no(L, Out), 484 fail 485 ; fail 486 ). 487content_escape(0'\n, Out, L0, L) :- 488 !, 489 L is L0 + 1, 490 ( retract(nonl) 491 -> true 492 ; nl(Out) 493 ), 494 assert(lineno). 495content_escape(0'<, Out, L, L) :- 496 !, 497 format(Out, '<', []). 498content_escape(0'>, Out, L, L) :- 499 !, 500 format(Out, '>', []). 501content_escape(0'&, Out, L, L) :- 502 !, 503 format(Out, '&', []). 504content_escape(C, Out, L, L) :- 505 put_code(Out, C). 506 507write_line_no(LineNo, Out) :- 508 format(Out, '<span class="line-no">~|~t~d~5+</span>', [LineNo]).
514copy_rest(In, Out, State0, State) :-
515 copy_to(In, -1, Out, State0, State).522read_n_codes(_, N, Codes) :- 523 N =< 0, 524 !, 525 Codes = []. 526read_n_codes(In, N, Codes) :- 527 get_code(In, C0), 528 read_n_codes(N, C0, In, Codes). 529 530read_n_codes(_, -1, _, []) :- !. 531read_n_codes(1, C, _, [C]) :- !. 532read_n_codes(N, C, In, [C|T]) :- 533 get_code(In, C2), 534 N2 is N - 1, 535 read_n_codes(N2, C2, In, T).
544term_expansion(element(_,_,_), Clauses) :- 545 findall(C, element_clause(C), Clauses). 546 547%element_tag(directive, div) :- !. 548element_tag(_, span). 549 550element_clause(element(Term, Tag, CSS)) :- 551 span_term(Term, CSS), 552 element_tag(Term, Tag). 553 554span_term(Classification, Class) :- 555 syntax_colour(Classification, _Attributes), 556 css_class(Classification, Class). 557 558css_class(Class, Class) :- 559 atom(Class), 560 !. 561css_class(Term, Class) :- 562 Term =.. [P1,A|_], 563 ( var(A) 564 -> Class = P1 565 ; css_class(A, P2), 566 atomic_list_concat([P1, -, P2], Class) 567 ). 568 569element(_,_,_). % term expanded
HTML source pretty-printer
This module colourises Prolog source using HTML+CSS using the same cross-reference based technology as used by PceEmacs.