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-2014, 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, +OutStream, +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(+, +, :).
  55
  56
  57/** <module> HTML source pretty-printer
  58
  59This module colourises Prolog  source  using   HTML+CSS  using  the same
  60cross-reference based technology as used by PceEmacs.
  61
  62@tbd    Create hyper-links to documentation and definitions.
  63@author Jan Wielemaker
  64*/
  65
  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
  79
  80%!  source_to_html(+In:filename, +Out, :Options) is det.
  81%
  82%   Colourise Prolog source as HTML. The idea   is to first create a
  83%   sequence of fragments and  then  to   apply  these  to the code.
  84%   Options are:
  85%
  86%     * format_comments(+Boolean)
  87%     If =true= (default), use PlDoc formatting for structured
  88%     comments.
  89%
  90%   Other options are passed to the following predicates:
  91%
  92%     * print_html_head/2
  93%     * print_html_footer/2.
  94%     * html_fragments/6
  95%
  96%   @param In       A filename.  Can also be an abstract name,
  97%                   which is subject to library(prolog_source)
  98%                   abstract file handling. See
  99%                   prolog_open_source/2.  Note that this cannot
 100%                   be a stream as we need to read the file three
 101%                   times: (1) xref, (2) assign colours and (3)
 102%                   generate HTML.
 103%   @param Out      Term stream(Stream) or file-name specification
 104
 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).
 144
 145%!  print_html_head(+Out:stream, +Options) is det.
 146%
 147%   Print the =DOCTYPE= line and HTML header.  Options:
 148%
 149%           * header(Bool)
 150%           Only print the header if Bool is not =false=
 151%
 152%           * title(Title)
 153%           Title of the HTML document
 154%
 155%           * stylesheets(List)
 156%           Reference to the CSS style-sheets.
 157%
 158%           * format_comments(Bool)
 159%           If =true= (default), format structured comments.
 160%
 161%           * skin(Closure)
 162%           Called using call(Closure, Where, Out), where Where
 163%           is one of =header= or =footer=.  These calls are made
 164%           just after opening =body= and before closing =body=.
 165
 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
 185print_html_footer(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(_, _, _).
 199
 200
 201%!  html_fragments(+Fragments, +In, +Out, +State, +Options) is det.
 202%
 203%   Copy In to Out, inserting HTML elements using Fragments.
 204
 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).
 209
 210%!  html_fragment(+Fragment, +In, +Out,
 211%!                +StateIn, -StateOut, +Options) is det.
 212%
 213%   Print from current position upto the end of Fragment.  First
 214%   clause deals with structured comments.
 215
 216html_fragment(fragment(Start, End, structured_comment, []),
 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).
 316
 317
 318%!  anchor(+Class, -Label) is semidet.
 319%
 320%   True when Label is the =id= we   must  assign to the fragment of
 321%   class Class. This that  the  first   definition  of  a head with
 322%   the id _name/arity_.
 323
 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    ).
 347
 348%!  copy_to(+In:stream, +End:int, +Out:stream, +State) is det.
 349%
 350%   Copy data from In to Out   upto  character-position End. Inserts
 351%   HTML entities for HTML the reserved characters =|<&>|=. If State
 352%   does not include a =pre= environment,   create  one and skip all
 353%   leading blank lines.
 354
 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).
 376
 377
 378%!  copy_full_stop(+In, +Out) is det.
 379%
 380%   Copy upto and including the .
 381
 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).
 393
 394
 395%!  delete_leading_white_lines(+CodesIn, -CodesOut, +LineIn, -Line) is det.
 396%
 397%   Delete leading white lines. Used  after structured comments. The
 398%   last two arguments update the  start-line   number  of the <pre>
 399%   block that is normally created.
 400
 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).
 408
 409%!  copy_without_trailing_white_lines(+In, +End, +StateIn, -StateOut) is det.
 410%
 411%   Copy input, but skip trailing white-lines. Used to copy the text
 412%   leading to a structured comment.
 413
 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).
 432
 433%!  append(-First, -FirstTail, ?Rest, +List) is nondet.
 434%
 435%   Split List.  First part is the difference-list First-FirstTail.
 436
 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).
 460
 461%!  write_codes(+Codes, +Line, +Out) is det.
 462%
 463%   Write codes that have been read starting at Line.
 464
 465write_codes([], _, _).
 466write_codes([H|T], L0, Out) :-
 467    content_escape(H, Out, L0, L1),
 468    write_codes(T, L1, Out).
 469
 470%!  content_escape(+Code, +Out, +Line0, -Line) is det
 471%
 472%   Write Code to Out, while taking care of.
 473%
 474%           * Use HTML entities for =|<&>|=
 475%           * If a line-no-tag is requested, write it
 476%           * On \n, post a line-no request.  If nonl/0 is set,
 477%             do _not_ emit a newline as it is implied by the
 478%             closed environment.
 479
 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, '&lt;', []).
 498content_escape(0'>, Out, L, L) :-
 499    !,
 500    format(Out, '&gt;', []).
 501content_escape(0'&, Out, L, L) :-
 502    !,
 503    format(Out, '&amp;', []).
 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~4+</span>', [LineNo]).
 509
 510%!  copy_rest(+In, +Out, +StateIn, -StateOut) is det.
 511%
 512%   Copy upto the end of the input In.
 513
 514copy_rest(In, Out, State0, State) :-
 515    copy_to(In, -1, Out, State0, State).
 516
 517%!  read_n_codes(+In, +N, -Codes)
 518%
 519%   Read the next N codes from In as a list of codes. If N < 0, read
 520%   upto the end of stream In.
 521
 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).
 536
 537
 538%!  element(+Class, -HTMLElement, -CSSClass) is nondet.
 539%
 540%   Map classified objects to an  HTML   element  and CSS class. The
 541%   actual  clauses  are  created   from    the   1st   argument  of
 542%   prolog_src_style/2.
 543
 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