1/* Part of SWI-Prolog 2 3 Author: Jan Wielemaker and Anjo Anjewierden 4 E-mail: J.Wielemaker@vu.nl 5 WWW: http://www.swi-prolog.org 6 Copyright (c) 2002-2020, 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(html_write, 37 [ reply_html_page/2, % :Head, :Body 38 reply_html_page/3, % +Style, :Head, :Body 39 40 % Basic output routines 41 page//1, % :Content 42 page//2, % :Head, :Body 43 page//3, % +Style, :Head, :Body 44 html//1, % :Content 45 46 % Option processing 47 html_set_options/1, % +OptionList 48 html_current_option/1, % ?Option 49 50 % repositioning HTML elements 51 html_post//2, % +Id, :Content 52 html_receive//1, % +Id 53 html_receive//2, % +Id, :Handler 54 xhtml_ns//2, % +Id, +Value 55 html_root_attribute//2, % +Name, +Value 56 57 html/4, % {|html||quasi quotations|} 58 59 % Useful primitives for expanding 60 html_begin//1, % +EnvName[(Attribute...)] 61 html_end//1, % +EnvName 62 html_quoted//1, % +Text 63 html_quoted_attribute//1, % +Attribute 64 65 % Emitting the HTML code 66 print_html/1, % +List 67 print_html/2, % +Stream, +List 68 html_print_length/2, % +List, -Length 69 70 % Extension support 71 (html_meta)/1, % +Spec 72 op(1150, fx, html_meta) 73 ]). 74:- use_module(html_quasiquotations, [html/4]). 75:- autoload(library(apply),[maplist/3,maplist/4]). 76:- autoload(library(debug),[debug/3]). 77:- autoload(library(error), 78 [must_be/2,domain_error/2,instantiation_error/1]). 79:- autoload(library(lists), 80 [permutation/2,selectchk/3,append/3,select/4,list_to_set/2]). 81:- autoload(library(option),[option/2]). 82:- autoload(library(pairs),[group_pairs_by_key/2]). 83:- autoload(library(sgml),[xml_quote_cdata/3,xml_quote_attribute/3]). 84:- autoload(library(uri),[uri_encoded/3]). 85:- autoload(library(url),[www_form_encode/2]). 86:- autoload(library(http/http_dispatch), [http_location_by_id/2]). 87 88% Quote output 89:- set_prolog_flag(generate_debug_info, false). 90 91:- meta_predicate 92 reply_html_page( , , ), 93 reply_html_page( , ), 94 html( , , ), 95 page( , , ), 96 page( , , , ), 97 pagehead( , , , ), 98 pagebody( , , , ), 99 html_receive( , , , ), 100 html_post( , , , ). 101 102:- multifile 103 expand//1, % +HTMLElement 104 expand_attribute_value//1. % +HTMLAttributeValue
141 /******************************* 142 * SETTINGS * 143 *******************************/
html4
, xhtml
or html5
(default). For
compatibility reasons, html
is accepted as an
alias for html4
.<|DOCTYPE
DocType >
line for page//1 and
page//2.Content-type
for reply_html_page/3
Note that the doctype and content_type flags are covered by
distinct prolog flags: html4_doctype
, xhtml_doctype
and
html5_doctype
and similar for the content type. The Dialect
must be switched before doctype and content type.
169html_set_options(Options) :- 170 must_be(list, Options), 171 set_options(Options). 172 173set_options([]). 174set_options([H|T]) :- 175 html_set_option(H), 176 set_options(T). 177 178html_set_option(dialect(Dialect0)) :- 179 !, 180 must_be(oneof([html,html4,xhtml,html5]), Dialect0), 181 ( html_version_alias(Dialect0, Dialect) 182 -> true 183 ; Dialect = Dialect0 184 ), 185 set_prolog_flag(html_dialect, Dialect). 186html_set_option(doctype(Atom)) :- 187 !, 188 must_be(atom, Atom), 189 current_prolog_flag(html_dialect, Dialect), 190 dialect_doctype_flag(Dialect, Flag), 191 set_prolog_flag(Flag, Atom). 192html_set_option(content_type(Atom)) :- 193 !, 194 must_be(atom, Atom), 195 current_prolog_flag(html_dialect, Dialect), 196 dialect_content_type_flag(Dialect, Flag), 197 set_prolog_flag(Flag, Atom). 198html_set_option(O) :- 199 domain_error(html_option, O). 200 201html_version_alias(html, html4).
207html_current_option(dialect(Dialect)) :- 208 current_prolog_flag(html_dialect, Dialect). 209html_current_option(doctype(DocType)) :- 210 current_prolog_flag(html_dialect, Dialect), 211 dialect_doctype_flag(Dialect, Flag), 212 current_prolog_flag(Flag, DocType). 213html_current_option(content_type(ContentType)) :- 214 current_prolog_flag(html_dialect, Dialect), 215 dialect_content_type_flag(Dialect, Flag), 216 current_prolog_flag(Flag, ContentType). 217 218dialect_doctype_flag(html4, html4_doctype). 219dialect_doctype_flag(html5, html5_doctype). 220dialect_doctype_flag(xhtml, xhtml_doctype). 221 222dialect_content_type_flag(html4, html4_content_type). 223dialect_content_type_flag(html5, html5_content_type). 224dialect_content_type_flag(xhtml, xhtml_content_type). 225 226option_default(html_dialect, html5). 227option_default(html4_doctype, 228 'HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" \c 229 "http://www.w3.org/TR/html4/loose.dtd"'). 230option_default(html5_doctype, 231 'html'). 232option_default(xhtml_doctype, 233 'html PUBLIC "-//W3C//DTD XHTML 1.0 \c 234 Transitional//EN" \c 235 "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd"'). 236option_default(html4_content_type, 'text/html; charset=UTF-8'). 237option_default(html5_content_type, 'text/html; charset=UTF-8'). 238option_default(xhtml_content_type, 'application/xhtml+xml; charset=UTF-8').
244init_options :- 245 ( option_default(Name, Value), 246 ( current_prolog_flag(Name, _) 247 -> true 248 ; create_prolog_flag(Name, Value, []) 249 ), 250 fail 251 ; true 252 ). 253 254:- init_options.
260xml_header('<?xml version=\'1.0\' encoding=\'UTF-8\'?>').
266ns(xhtml, 'http://www.w3.org/1999/xhtml'). 267 268 269 /******************************* 270 * PAGE * 271 *******************************/
<!DOCTYPE>
header. The
actual doctype is read from the option doctype
as defined by
html_set_options/1.280page(Content) --> 281 doctype, 282 html(html(Content)). 283 284page(Head, Body) --> 285 page(default, Head, Body). 286 287page(Style, Head, Body) --> 288 doctype, 289 content_type, 290 html_begin(html), 291 pagehead(Style, Head), 292 pagebody(Style, Body), 293 html_end(html).
<DOCTYPE ...
header. The doctype comes from the
option doctype(DOCTYPE)
(see html_set_options/1). Setting the
doctype to '' (empty atom) suppresses the header completely.
This is to avoid a IE bug in processing AJAX output ...302doctype --> 303 { html_current_option(doctype(DocType)), 304 DocType \== '' 305 }, 306 !, 307 [ '<!DOCTYPE ', DocType, '>' ]. 308doctype --> 309 []. 310 311content_type --> 312 { html_current_option(content_type(Type)) 313 }, 314 !, 315 html_post(head, meta([ 'http-equiv'('content-type'), 316 content(Type) 317 ], [])). 318content_type --> 319 { html_current_option(dialect(html5)) }, 320 !, 321 html_post(head, meta('charset=UTF-8')). 322content_type --> 323 []. 324 325pagehead(_, Head) --> 326 { functor(Head, head, _) 327 }, 328 !, 329 html(Head). 330pagehead(Style, Head) --> 331 { strip_module(Head, M, _), 332 hook_module(M, HM, head//2) 333 }, 334 HM:head(Style, Head), 335 !. 336pagehead(_, Head) --> 337 { strip_module(Head, M, _), 338 hook_module(M, HM, head//1) 339 }, 340 HM:head(Head), 341 !. 342pagehead(_, Head) --> 343 html(head(Head)). 344 345 346pagebody(_, Body) --> 347 { functor(Body, body, _) 348 }, 349 !, 350 html(Body). 351pagebody(Style, Body) --> 352 { strip_module(Body, M, _), 353 hook_module(M, HM, body//2) 354 }, 355 HM:body(Style, Body), 356 !. 357pagebody(_, Body) --> 358 { strip_module(Body, M, _), 359 hook_module(M, HM, body//1) 360 }, 361 HM:body(Body), 362 !. 363pagebody(_, Body) --> 364 html(body(Body)). 365 366 367hook_module(M, M, PI) :- 368 current_predicate(M:PI), 369 !. 370hook_module(_, user, PI) :- 371 current_predicate(user:PI).
378html(Spec) --> 379 { strip_module(Spec, M, T) }, 380 qhtml(T, M). 381 382qhtml(Var, _) --> 383 { var(Var), 384 !, 385 instantiation_error(Var) 386 }. 387qhtml([], _) --> 388 !, 389 []. 390qhtml([H|T], M) --> 391 !, 392 html_expand(H, M), 393 qhtml(T, M). 394qhtml(X, M) --> 395 html_expand(X, M). 396 397html_expand(Var, _) --> 398 { var(Var), 399 !, 400 instantiation_error(Var) 401 }. 402html_expand(Term, Module) --> 403 do_expand(Term, Module), 404 !. 405html_expand(Term, _Module) --> 406 { print_message(error, html(expand_failed(Term))) }. 407 408 409do_expand(Token, _) --> % call user hooks 410 expand(Token), 411 !. 412do_expand(Fmt-Args, _) --> 413 !, 414 { format(string(String), Fmt, Args) 415 }, 416 html_quoted(String). 417do_expand(\List, Module) --> 418 { is_list(List) 419 }, 420 !, 421 raw(List, Module). 422do_expand(\Term, Module, In, Rest) :- 423 !, 424 call(Module:Term, In, Rest). 425do_expand(Module:Term, _) --> 426 !, 427 qhtml(Term, Module). 428do_expand(&(Entity), _) --> 429 !, 430 { integer(Entity) 431 -> format(string(String), '&#~d;', [Entity]) 432 ; format(string(String), '&~w;', [Entity]) 433 }, 434 [ String ]. 435do_expand(Token, _) --> 436 { atomic(Token) 437 }, 438 !, 439 html_quoted(Token). 440do_expand(element(Env, Attributes, Contents), M) --> 441 !, 442 ( { Contents == [], 443 html_current_option(dialect(xhtml)) 444 } 445 -> xhtml_empty(Env, Attributes) 446 ; html_begin(Env, Attributes), 447 qhtml(Env, Contents, M), 448 html_end(Env) 449 ). 450do_expand(Term, M) --> 451 { Term =.. [Env, Contents] 452 }, 453 !, 454 ( { layout(Env, _, empty) 455 } 456 -> html_begin(Env, Contents) 457 ; ( { Contents == [], 458 html_current_option(dialect(xhtml)) 459 } 460 -> xhtml_empty(Env, []) 461 ; html_begin(Env), 462 qhtml(Env, Contents, M), 463 html_end(Env) 464 ) 465 ). 466do_expand(Term, M) --> 467 { Term =.. [Env, Attributes, Contents], 468 check_non_empty(Contents, Env, Term) 469 }, 470 !, 471 ( { Contents == [], 472 html_current_option(dialect(xhtml)) 473 } 474 -> xhtml_empty(Env, Attributes) 475 ; html_begin(Env, Attributes), 476 qhtml(Env, Contents, M), 477 html_end(Env) 478 ). 479 480qhtml(Env, Contents, M) --> 481 { cdata_element(Env), 482 phrase(cdata(Contents, M), Tokens) 483 }, 484 !, 485 [ cdata(Env, Tokens) ]. 486qhtml(_, Contents, M) --> 487 qhtml(Contents, M). 488 489 490check_non_empty([], _, _) :- !. 491check_non_empty(_, Tag, Term) :- 492 layout(Tag, _, empty), 493 !, 494 print_message(warning, 495 format('Using empty element with content: ~p', [Term])). 496check_non_empty(_, _, _). 497 498cdata(List, M) --> 499 { is_list(List) }, 500 !, 501 raw(List, M). 502cdata(One, M) --> 503 raw_element(One, M).
509raw([], _) --> 510 []. 511raw([H|T], Module) --> 512 raw_element(H, Module), 513 raw(T, Module). 514 515raw_element(Var, _) --> 516 { var(Var), 517 !, 518 instantiation_error(Var) 519 }. 520raw_element(\List, Module) --> 521 { is_list(List) 522 }, 523 !, 524 raw(List, Module). 525raw_element(\Term, Module, In, Rest) :- 526 !, 527 call(Module:Term, In, Rest). 528raw_element(Module:Term, _) --> 529 !, 530 raw_element(Term, Module). 531raw_element(Fmt-Args, _) --> 532 !, 533 { format(string(S), Fmt, Args) }, 534 [S]. 535raw_element(Value, _) --> 536 { must_be(atomic, Value) }, 537 [Value].
html(table(border=1, \table_content))
html_begin(table(border=1) table_content, html_end(table)
558html_begin(Env) --> 559 { Env =.. [Name|Attributes] 560 }, 561 html_begin(Name, Attributes). 562 563html_begin(Env, Attributes) --> 564 pre_open(Env), 565 [<], 566 [Env], 567 attributes(Env, Attributes), 568 ( { layout(Env, _, empty), 569 html_current_option(dialect(xhtml)) 570 } 571 -> ['/>'] 572 ; [>] 573 ), 574 post_open(Env). 575 576html_end(Env) --> % empty element or omited close 577 { layout(Env, _, -), 578 html_current_option(dialect(html)) 579 ; layout(Env, _, empty) 580 }, 581 !, 582 []. 583html_end(Env) --> 584 pre_close(Env), 585 ['</'], 586 [Env], 587 ['>'], 588 post_close(Env).
594xhtml_empty(Env, Attributes) -->
595 pre_open(Env),
596 [<],
597 [Env],
598 attributes(Attributes),
599 ['/>'].
xmlns
channel. Rdfa
(http://www.w3.org/2006/07/SWD/RDFa/syntax/), embedding RDF in
(x)html provides a typical usage scenario where we want to
publish the required namespaces in the header. We can define:
rdf_ns(Id) --> { rdf_global_id(Id:'', Value) }, xhtml_ns(Id, Value).
After which we can use rdf_ns//1 as a normal rule in html//1 to
publish namespaces from library(semweb/rdf_db). Note that this
macro only has effect if the dialect is set to xhtml
. In
html
mode it is silently ignored.
The required xmlns
receiver is installed by html_begin//1
using the html
tag and thus is present in any document that
opens the outer html
environment through this library.
624xhtml_ns(Id, Value) --> 625 { html_current_option(dialect(xhtml)) }, 626 !, 627 html_post(xmlns, \attribute(xmlns:Id=Value)). 628xhtml_ns(_, _) --> 629 [].
html(div(...)), html_root_attribute(lang, en), ...
642html_root_attribute(Name, Value) -->
643 html_post(html_begin, \attribute(Name=Value)).
650attributes(html, L) --> 651 !, 652 ( { html_current_option(dialect(xhtml)) } 653 -> ( { option(xmlns(_), L) } 654 -> attributes(L) 655 ; { ns(xhtml, NS) }, 656 attributes([xmlns(NS)|L]) 657 ), 658 html_receive(xmlns) 659 ; attributes(L), 660 html_noreceive(xmlns) 661 ), 662 html_receive(html_begin). 663attributes(_, L) --> 664 attributes(L). 665 666attributes([]) --> 667 !, 668 []. 669attributes([H|T]) --> 670 !, 671 attribute(H), 672 attributes(T). 673attributes(One) --> 674 attribute(One). 675 676attribute(Name=Value) --> 677 !, 678 [' '], name(Name), [ '="' ], 679 attribute_value(Value), 680 ['"']. 681attribute(NS:Term) --> 682 !, 683 { Term =.. [Name, Value] 684 }, 685 !, 686 attribute((NS:Name)=Value). 687attribute(Term) --> 688 { Term =.. [Name, Value] 689 }, 690 !, 691 attribute(Name=Value). 692attribute(Atom) --> % Value-abbreviated attribute 693 { atom(Atom) 694 }, 695 [ ' ', Atom ]. 696 697name(NS:Name) --> 698 !, 699 [NS, :, Name]. 700name(Name) --> 701 [ Name ].
encode(V)
Emit URL-encoded version of V. See www_form_encode/2.encode(Value1)
&Name2=encode(Value2)
...
The hook expand_attribute_value//1 can be defined to
provide additional `function like' translations. For example,
http_dispatch.pl
defines location_by_id(ID)
to refer to a
location on the current server based on the handler id. See
http_location_by_id/2.
723attribute_value(List) --> 724 { is_list(List) }, 725 !, 726 attribute_value_m(List). 727attribute_value(Value) --> 728 attribute_value_s(Value). 729 730% emit a single attribute value 731 732attribute_value_s(Var) --> 733 { var(Var), 734 !, 735 instantiation_error(Var) 736 }. 737attribute_value_s(A+B) --> 738 !, 739 attribute_value(A), 740 ( { is_list(B) } 741 -> ( { B == [] } 742 -> [] 743 ; [?], search_parameters(B) 744 ) 745 ; attribute_value(B) 746 ). 747attribute_value_s(encode(Value)) --> 748 !, 749 { uri_encoded(query_value, Value, Encoded) }, 750 [ Encoded ]. 751attribute_value_s(Value) --> 752 expand_attribute_value(Value), 753 !. 754attribute_value_s(Fmt-Args) --> 755 !, 756 { format(string(Value), Fmt, Args) }, 757 html_quoted_attribute(Value). 758attribute_value_s(Value) --> 759 html_quoted_attribute(Value). 760 761search_parameters([H|T]) --> 762 search_parameter(H), 763 ( {T == []} 764 -> [] 765 ; ['&'], 766 search_parameters(T) 767 ). 768 769search_parameter(Var) --> 770 { var(Var), 771 !, 772 instantiation_error(Var) 773 }. 774search_parameter(Name=Value) --> 775 { www_form_encode(Value, Encoded) }, 776 [Name, =, Encoded]. 777search_parameter(Term) --> 778 { Term =.. [Name, Value], 779 !, 780 www_form_encode(Value, Encoded) 781 }, 782 [Name, =, Encoded]. 783search_parameter(Term) --> 784 { domain_error(search_parameter, Term) 785 }.
body(class([c1, c2]), Body)
Emits <body class="c1 c2"> ...
797attribute_value_m([]) --> 798 []. 799attribute_value_m([H|T]) --> 800 attribute_value_s(H), 801 ( { T == [] } 802 -> [] 803 ; [' '], 804 attribute_value_m(T) 805 ). 806 807 808 /******************************* 809 * QUOTING RULES * 810 *******************************/
html(b(Text))
825html_quoted(Text) -->
826 { xml_quote_cdata(Text, Quoted, utf8) },
827 [ Quoted ].
838html_quoted_attribute(Text) -->
839 { xml_quote_attribute(Text, Quoted, utf8) },
840 [ Quoted ].
</
needs to be escaped.847cdata_element(script). 848cdata_element(style). 849 850 851 /******************************* 852 * REPOSITIONING HTML * 853 *******************************/
A typical usage scenario is to get required CSS links in the document head in a reusable fashion. First, we define css//1 as:
css(URL) --> html_post(css, link([ type('text/css'), rel('stylesheet'), href(URL) ])).
Next we insert the unique CSS links, in the pagehead using the following call to reply_html_page/2:
reply_html_page([ title(...), \html_receive(css) ], ...)
885html_post(Id, Content) -->
886 { strip_module(Content, M, C) },
887 [ mailbox(Id, post(M, C)) ].
900html_receive(Id) -->
901 html_receive(Id, sorted_html).
phrase(Handler, PostedTerms, HtmlTerms, Rest)
Typically, Handler collects the posted terms, creating a term suitable for html//1 and finally calls html//1.
920html_receive(Id, Handler) -->
921 { strip_module(Handler, M, P) },
922 [ mailbox(Id, accept(M:P, _)) ].
928html_noreceive(Id) -->
929 [ mailbox(Id, ignore(_,_)) ].
head
and script
boxes at
the end.940mailman(Tokens) :- 941 ( html_token(mailbox(_, accept(_, Accepted)), Tokens) 942 -> true 943 ), 944 var(Accepted), % not yet executed 945 !, 946 mailboxes(Tokens, Boxes), 947 keysort(Boxes, Keyed), 948 group_pairs_by_key(Keyed, PerKey), 949 move_last(PerKey, script, PerKey1), 950 move_last(PerKey1, head, PerKey2), 951 ( permutation(PerKey2, PerKeyPerm), 952 ( mail_ids(PerKeyPerm) 953 -> ! 954 ; debug(html(mailman), 955 'Failed mail delivery order; retrying', []), 956 fail 957 ) 958 -> true 959 ; print_message(error, html(cyclic_mailboxes)) 960 ). 961mailman(_). 962 963move_last(Box0, Id, Box) :- 964 selectchk(Id-List, Box0, Box1), 965 !, 966 append(Box1, [Id-List], Box). 967move_last(Box, _, Box).
cdata(Elem, Tokens)
.974html_token(Token, [H|T]) :- 975 html_token_(T, H, Token). 976 977html_token_(_, Token, Token) :- !. 978html_token_(_, cdata(_,Tokens), Token) :- 979 html_token(Token, Tokens). 980html_token_([H|T], _, Token) :- 981 html_token_(T, H, Token).
987mailboxes(Tokens, MailBoxes) :- 988 mailboxes(Tokens, MailBoxes, []). 989 990mailboxes([], List, List). 991mailboxes([mailbox(Id, Value)|T0], [Id-Value|T], Tail) :- 992 !, 993 mailboxes(T0, T, Tail). 994mailboxes([cdata(_Type, Tokens)|T0], Boxes, Tail) :- 995 !, 996 mailboxes(Tokens, Boxes, Tail0), 997 mailboxes(T0, Tail0, Tail). 998mailboxes([_|T0], T, Tail) :- 999 mailboxes(T0, T, Tail). 1000 1001mail_ids([]). 1002mail_ids([H|T0]) :- 1003 mail_id(H, NewPosts), 1004 add_new_posts(NewPosts, T0, T), 1005 mail_ids(T). 1006 1007mail_id(Id-List, NewPosts) :- 1008 mail_handlers(List, Boxes, Content), 1009 ( Boxes = [accept(MH:Handler, In)] 1010 -> extend_args(Handler, Content, Goal), 1011 phrase(MH:Goal, In), 1012 mailboxes(In, NewBoxes), 1013 keysort(NewBoxes, Keyed), 1014 group_pairs_by_key(Keyed, NewPosts) 1015 ; Boxes = [ignore(_, _)|_] 1016 -> NewPosts = [] 1017 ; Boxes = [accept(_,_),accept(_,_)|_] 1018 -> print_message(error, html(multiple_receivers(Id))), 1019 NewPosts = [] 1020 ; print_message(error, html(no_receiver(Id))), 1021 NewPosts = [] 1022 ). 1023 1024add_new_posts([], T, T). 1025add_new_posts([Id-Posts|NewT], T0, T) :- 1026 ( select(Id-List0, T0, Id-List, T1) 1027 -> append(List0, Posts, List) 1028 ; debug(html(mailman), 'Stuck with new posts on ~q', [Id]), 1029 fail 1030 ), 1031 add_new_posts(NewT, T1, T).
post(Module,HTML)
into Posters and the remainder in
Handlers. Handlers consists of accept(Handler, Tokens)
and
ignore(_,_)
.1040mail_handlers([], [], []). 1041mail_handlers([post(Module,HTML)|T0], H, [Module:HTML|T]) :- 1042 !, 1043 mail_handlers(T0, H, T). 1044mail_handlers([H|T0], [H|T], C) :- 1045 mail_handlers(T0, T, C). 1046 1047extend_args(Term, Extra, NewTerm) :- 1048 Term =.. [Name|Args], 1049 append(Args, [Extra], NewArgs), 1050 NewTerm =.. [Name|NewArgs].
1061sorted_html(List) -->
1062 { sort(List, Unique) },
1063 html(Unique).
html_receive(head)
. Unlike sorted_html//1, it calls
a user hook html_head_expansion/2 to process the
collected head material into a term suitable for html//1.
1076head_html(List) --> 1077 { list_to_set(List, Unique), 1078 html_expand_head(Unique, NewList) 1079 }, 1080 html(NewList). 1081 1082:- multifile 1083 html_head_expansion/2. 1084 1085html_expand_head(List0, List) :- 1086 html_head_expansion(List0, List1), 1087 List0 \== List1, 1088 !, 1089 html_expand_head(List1, List). 1090html_expand_head(List, List). 1091 1092 1093 /******************************* 1094 * LAYOUT * 1095 *******************************/ 1096 1097pre_open(Env) --> 1098 { layout(Env, N-_, _) 1099 }, 1100 !, 1101 [ nl(N) ]. 1102pre_open(_) --> []. 1103 1104post_open(Env) --> 1105 { layout(Env, _-N, _) 1106 }, 1107 !, 1108 [ nl(N) ]. 1109post_open(_) --> 1110 []. 1111 1112pre_close(head) --> 1113 !, 1114 html_receive(head, head_html), 1115 { layout(head, _, N-_) }, 1116 [ nl(N) ]. 1117pre_close(Env) --> 1118 { layout(Env, _, N-_) 1119 }, 1120 !, 1121 [ nl(N) ]. 1122pre_close(_) --> 1123 []. 1124 1125post_close(Env) --> 1126 { layout(Env, _, _-N) 1127 }, 1128 !, 1129 [ nl(N) ]. 1130post_close(_) --> 1131 [].
1148:- multifile 1149 layout/3. 1150 1151layout(table, 2-1, 1-2). 1152layout(blockquote, 2-1, 1-2). 1153layout(pre, 2-1, 0-2). 1154layout(textarea, 1-1, 0-1). 1155layout(center, 2-1, 1-2). 1156layout(dl, 2-1, 1-2). 1157layout(ul, 1-1, 1-1). 1158layout(ol, 2-1, 1-2). 1159layout(form, 2-1, 1-2). 1160layout(frameset, 2-1, 1-2). 1161layout(address, 2-1, 1-2). 1162 1163layout(head, 1-1, 1-1). 1164layout(body, 1-1, 1-1). 1165layout(script, 1-1, 1-1). 1166layout(style, 1-1, 1-1). 1167layout(select, 1-1, 1-1). 1168layout(map, 1-1, 1-1). 1169layout(html, 1-1, 1-1). 1170layout(caption, 1-1, 1-1). 1171layout(applet, 1-1, 1-1). 1172 1173layout(tr, 1-0, 0-1). 1174layout(option, 1-0, 0-1). 1175layout(li, 1-0, 0-1). 1176layout(dt, 1-0, -). 1177layout(dd, 0-0, -). 1178layout(title, 1-0, 0-1). 1179 1180layout(h1, 2-0, 0-2). 1181layout(h2, 2-0, 0-2). 1182layout(h3, 2-0, 0-2). 1183layout(h4, 2-0, 0-2). 1184 1185layout(iframe, 1-1, 1-1). 1186 1187layout(hr, 1-1, empty). % empty elements 1188layout(br, 0-1, empty). 1189layout(img, 0-0, empty). 1190layout(meta, 1-1, empty). 1191layout(base, 1-1, empty). 1192layout(link, 1-1, empty). 1193layout(input, 0-0, empty). 1194layout(frame, 1-1, empty). 1195layout(col, 0-0, empty). 1196layout(area, 1-0, empty). 1197layout(input, 1-0, empty). 1198layout(param, 1-0, empty). 1199 1200layout(p, 2-1, -). % omited close 1201layout(td, 0-0, 0-0). 1202 1203layout(div, 1-0, 0-1). 1204 1205 /******************************* 1206 * PRINTING * 1207 *******************************/
1222print_html(List) :- 1223 current_output(Out), 1224 mailman(List), 1225 write_html(List, Out). 1226print_html(Out, List) :- 1227 ( html_current_option(dialect(xhtml)) 1228 -> stream_property(Out, encoding(Enc)), 1229 ( Enc == utf8 1230 -> true 1231 ; print_message(warning, html(wrong_encoding(Out, Enc))) 1232 ), 1233 xml_header(Hdr), 1234 write(Out, Hdr), nl(Out) 1235 ; true 1236 ), 1237 mailman(List), 1238 write_html(List, Out), 1239 flush_output(Out). 1240 1241write_html([], _). 1242write_html([nl(N)|T], Out) :- 1243 !, 1244 join_nl(T, N, Lines, T2), 1245 write_nl(Lines, Out), 1246 write_html(T2, Out). 1247write_html([mailbox(_, Box)|T], Out) :- 1248 !, 1249 ( Box = accept(_, Accepted) 1250 -> write_html(Accepted, Out) 1251 ; true 1252 ), 1253 write_html(T, Out). 1254write_html([cdata(Env, Tokens)|T], Out) :- 1255 !, 1256 with_output_to(string(CDATA), write_html(Tokens, current_output)), 1257 valid_cdata(Env, CDATA), 1258 write(Out, CDATA), 1259 write_html(T, Out). 1260write_html([H|T], Out) :- 1261 write(Out, H), 1262 write_html(T, Out). 1263 1264join_nl([nl(N0)|T0], N1, N, T) :- 1265 !, 1266 N2 is max(N0, N1), 1267 join_nl(T0, N2, N, T). 1268join_nl(L, N, N, L). 1269 1270write_nl(0, _) :- !. 1271write_nl(N, Out) :- 1272 nl(Out), 1273 N1 is N - 1, 1274 write_nl(N1, Out).
<script>
. This implies it cannot contain </script/
.
There is no escape for this and the script generator must use a
work-around using features of the script language. For example,
when using JavaScript, "</script>" can be written as
"<\/script>".
1288valid_cdata(Env, String) :- 1289 atomics_to_string(['</', Env, '>'], End), 1290 sub_atom_icasechk(String, _, End), 1291 !, 1292 domain_error(cdata, String). 1293valid_cdata(_, _).
phrase(html(DOM), Tokens), html_print_length(Tokens, Len), format('Content-type: text/html; charset=UTF-8~n'), format('Content-length: ~d~n~n', [Len]), print_html(Tokens)
1309html_print_length(List, Len) :- 1310 mailman(List), 1311 ( html_current_option(dialect(xhtml)) 1312 -> xml_header(Hdr), 1313 atom_length(Hdr, L0), 1314 L1 is L0+1 % one for newline 1315 ; L1 = 0 1316 ), 1317 html_print_length(List, L1, Len). 1318 1319html_print_length([], L, L). 1320html_print_length([nl(N)|T], L0, L) :- 1321 !, 1322 join_nl(T, N, Lines, T1), 1323 L1 is L0 + Lines, % assume only \n! 1324 html_print_length(T1, L1, L). 1325html_print_length([mailbox(_, Box)|T], L0, L) :- 1326 !, 1327 ( Box = accept(_, Accepted) 1328 -> html_print_length(Accepted, L0, L1) 1329 ; L1 = L0 1330 ), 1331 html_print_length(T, L1, L). 1332html_print_length([cdata(_, CDATA)|T], L0, L) :- 1333 !, 1334 html_print_length(CDATA, L0, L1), 1335 html_print_length(T, L1, L). 1336html_print_length([H|T], L0, L) :- 1337 atom_length(H, Hlen), 1338 L1 is L0+Hlen, 1339 html_print_length(T, L1, L).
http_wrapper.pl
for a
page constructed from Head and Body. The HTTP Content-type
is provided by html_current_option/1.1349reply_html_page(Head, Body) :- 1350 reply_html_page(default, Head, Body). 1351reply_html_page(Style, Head, Body) :- 1352 html_current_option(content_type(Type)), 1353 phrase(page(Style, Head, Body), HTML), 1354 format('Content-type: ~w~n~n', [Type]), 1355 print_html(HTML). 1356 1357 1358 /******************************* 1359 * META-PREDICATE SUPPORT * 1360 *******************************/
html
. For example:
:- html_meta page(html,html,?,?).
1376html_meta(Spec) :- 1377 throw(error(context_error(nodirective, html_meta(Spec)), _)). 1378 1379html_meta_decls(Var, _, _) :- 1380 var(Var), 1381 !, 1382 instantiation_error(Var). 1383html_meta_decls((A,B), (MA,MB), [MH|T]) :- 1384 !, 1385 html_meta_decl(A, MA, MH), 1386 html_meta_decls(B, MB, T). 1387html_meta_decls(A, MA, [MH]) :- 1388 html_meta_decl(A, MA, MH). 1389 1390html_meta_decl(Head, MetaHead, 1391 html_write:html_meta_head(GenHead, Module, Head)) :- 1392 functor(Head, Name, Arity), 1393 functor(GenHead, Name, Arity), 1394 prolog_load_context(module, Module), 1395 Head =.. [Name|HArgs], 1396 maplist(html_meta_decl, HArgs, MArgs), 1397 MetaHead =.. [Name|MArgs]. 1398 1399html_meta_decl(html, :) :- !. 1400html_meta_decl(Meta, Meta). 1401 1402systemterm_expansion((:- html_meta(Heads)), 1403 [ (:- meta_predicate(Meta)) 1404 | MetaHeads 1405 ]) :- 1406 html_meta_decls(Heads, Meta, MetaHeads). 1407 1408:- multifile 1409 html_meta_head/3. 1410 1411html_meta_colours(Head, Goal, built_in-Colours) :- 1412 Head =.. [_|MArgs], 1413 Goal =.. [_|Args], 1414 maplist(meta_colours, MArgs, Args, Colours). 1415 1416meta_colours(html, HTML, Colours) :- 1417 !, 1418 html_colours(HTML, Colours). 1419meta_colours(I, _, Colours) :- 1420 integer(I), I>=0, 1421 !, 1422 Colours = meta(I). 1423meta_colours(_, _, classify). 1424 1425html_meta_called(Head, Goal, Called) :- 1426 Head =.. [_|MArgs], 1427 Goal =.. [_|Args], 1428 meta_called(MArgs, Args, Called, []). 1429 1430meta_called([], [], Called, Called). 1431meta_called([html|MT], [A|AT], Called, Tail) :- 1432 !, 1433 phrase(called_by(A), Called, Tail1), 1434 meta_called(MT, AT, Tail1, Tail). 1435meta_called([0|MT], [A|AT], [A|CT0], CT) :- 1436 !, 1437 meta_called(MT, AT, CT0, CT). 1438meta_called([I|MT], [A|AT], [A+I|CT0], CT) :- 1439 integer(I), I>0, 1440 !, 1441 meta_called(MT, AT, CT0, CT). 1442meta_called([_|MT], [_|AT], Called, Tail) :- 1443 !, 1444 meta_called(MT, AT, Called, Tail). 1445 1446 1447:- html_meta 1448 html( , , ), 1449 page( , , ), 1450 page( , , , ), 1451 page( , , , , ), 1452 pagehead( , , , ), 1453 pagebody( , , , ), 1454 reply_html_page( , ), 1455 reply_html_page( , , ), 1456 html_post( , , , ). 1457 1458 1459 /******************************* 1460 * PCE EMACS SUPPORT * 1461 *******************************/ 1462 1463:- multifile 1464 prolog_colour:goal_colours/2, 1465 prolog_colour:style/2, 1466 prolog_colour:message//1, 1467 prolog:called_by/2. 1468 1469prolog_colourgoal_colours(Goal, Colours) :- 1470 html_meta_head(Goal, _Module, Head), 1471 html_meta_colours(Head, Goal, Colours). 1472prolog_colourgoal_colours(html_meta(_), 1473 built_in-[meta_declarations([html])]). 1474 1475 % TBD: Check with do_expand! 1476html_colours(Var, classify) :- 1477 var(Var), 1478 !. 1479html_colours(\List, html_raw-[list-Colours]) :- 1480 is_list(List), 1481 !, 1482 list_colours(List, Colours). 1483html_colours(\_, html_call-[dcg]) :- !. 1484html_colours(_:Term, built_in-[classify,Colours]) :- 1485 !, 1486 html_colours(Term, Colours). 1487html_colours(&(Entity), functor-[entity(Entity)]) :- !. 1488html_colours(List, list-ListColours) :- 1489 List = [_|_], 1490 !, 1491 list_colours(List, ListColours). 1492html_colours(Format-Args, functor-[FormatColor,ArgsColors]) :- 1493 !, 1494 format_colours(Format, FormatColor), 1495 format_arg_colours(Args, Format, ArgsColors). 1496html_colours(Term, TermColours) :- 1497 compound(Term), 1498 compound_name_arguments(Term, Name, Args), 1499 Name \== '.', 1500 !, 1501 ( Args = [One] 1502 -> TermColours = html(Name)-ArgColours, 1503 ( layout(Name, _, empty) 1504 -> attr_colours(One, ArgColours) 1505 ; html_colours(One, Colours), 1506 ArgColours = [Colours] 1507 ) 1508 ; Args = [AList,Content] 1509 -> TermColours = html(Name)-[AColours, Colours], 1510 attr_colours(AList, AColours), 1511 html_colours(Content, Colours) 1512 ; TermColours = error 1513 ). 1514html_colours(_, classify). 1515 1516list_colours(Var, classify) :- 1517 var(Var), 1518 !. 1519list_colours([], []). 1520list_colours([H0|T0], [H|T]) :- 1521 !, 1522 html_colours(H0, H), 1523 list_colours(T0, T). 1524list_colours(Last, Colours) :- % improper list 1525 html_colours(Last, Colours). 1526 1527attr_colours(Var, classify) :- 1528 var(Var), 1529 !. 1530attr_colours([], classify) :- !. 1531attr_colours(Term, list-Elements) :- 1532 Term = [_|_], 1533 !, 1534 attr_list_colours(Term, Elements). 1535attr_colours(Name=Value, built_in-[html_attribute(Name), VColour]) :- 1536 !, 1537 attr_value_colour(Value, VColour). 1538attr_colours(NS:Term, built_in-[ html_xmlns(NS), 1539 html_attribute(Name)-[classify] 1540 ]) :- 1541 compound(Term), 1542 compound_name_arity(Term, Name, 1). 1543attr_colours(Term, html_attribute(Name)-[VColour]) :- 1544 compound(Term), 1545 compound_name_arity(Term, Name, 1), 1546 !, 1547 Term =.. [Name,Value], 1548 attr_value_colour(Value, VColour). 1549attr_colours(Name, html_attribute(Name)) :- 1550 atom(Name), 1551 !. 1552attr_colours(Term, classify) :- 1553 compound(Term), 1554 compound_name_arity(Term, '.', 2), 1555 !. 1556attr_colours(_, error). 1557 1558attr_list_colours(Var, classify) :- 1559 var(Var), 1560 !. 1561attr_list_colours([], []). 1562attr_list_colours([H0|T0], [H|T]) :- 1563 attr_colours(H0, H), 1564 attr_list_colours(T0, T). 1565 1566attr_value_colour(Var, classify) :- 1567 var(Var). 1568attr_value_colour(location_by_id(ID), sgml_attr_function-[Colour]) :- 1569 !, 1570 location_id(ID, Colour). 1571attr_value_colour(#(ID), sgml_attr_function-[Colour]) :- 1572 !, 1573 location_id(ID, Colour). 1574attr_value_colour(A+B, sgml_attr_function-[CA,CB]) :- 1575 !, 1576 attr_value_colour(A, CA), 1577 attr_value_colour(B, CB). 1578attr_value_colour(encode(_), sgml_attr_function-[classify]) :- !. 1579attr_value_colour(Atom, classify) :- 1580 atomic(Atom), 1581 !. 1582attr_value_colour([_|_], classify) :- !. 1583attr_value_colour(_Fmt-_Args, classify) :- !. 1584attr_value_colour(Term, classify) :- 1585 compound(Term), 1586 compound_name_arity(Term, '.', 2), 1587 !. 1588attr_value_colour(_, error). 1589 1590location_id(ID, classify) :- 1591 var(ID), 1592 !. 1593location_id(ID, Class) :- 1594 ( catch(http_location_by_id(ID, Location), _, fail) 1595 -> Class = http_location_for_id(Location) 1596 ; Class = http_no_location_for_id(ID) 1597 ). 1598location_id(_, classify). 1599 1600format_colours(Format, format_string) :- atom(Format), !. 1601format_colours(Format, format_string) :- string(Format), !. 1602format_colours(_Format, type_error(text)). 1603 1604format_arg_colours(Args, _Format, classify) :- is_list(Args), !. 1605format_arg_colours(_, _, type_error(list)). 1606 1607:- op(990, xfx, :=). % allow compiling without XPCE 1608:- op(200, fy, @). 1609 1610prolog_colourstyle(html(_), [colour(magenta4), bold(true)]). 1611prolog_colourstyle(entity(_), [colour(magenta4)]). 1612prolog_colourstyle(html_attribute(_), [colour(magenta4)]). 1613prolog_colourstyle(html_xmlns(_), [colour(magenta4)]). 1614prolog_colourstyle(format_string(_), [colour(magenta4)]). 1615prolog_colourstyle(sgml_attr_function, [colour(blue)]). 1616prolog_colourstyle(http_location_for_id(_), [bold(true)]). 1617prolog_colourstyle(http_no_location_for_id(_), [colour(red), bold(true)]). 1618 1619 1620prolog_colourmessage(html(Element)) --> 1621 [ '~w: SGML element'-[Element] ]. 1622prolog_colourmessage(entity(Entity)) --> 1623 [ '~w: SGML entity'-[Entity] ]. 1624prolog_colourmessage(html_attribute(Attr)) --> 1625 [ '~w: SGML attribute'-[Attr] ]. 1626prolog_colourmessage(sgml_attr_function) --> 1627 [ 'SGML Attribute function'-[] ]. 1628prolog_colourmessage(http_location_for_id(Location)) --> 1629 [ 'ID resolves to ~w'-[Location] ]. 1630prolog_colourmessage(http_no_location_for_id(ID)) --> 1631 [ '~w: no such ID'-[ID] ]. 1632 1633 1634% prolog:called_by(+Goal, -Called) 1635% 1636% Hook into library(pce_prolog_xref). Called is a list of callable 1637% or callable+N to indicate (DCG) arglist extension. 1638 1639 1640prologcalled_by(Goal, Called) :- 1641 html_meta_head(Goal, _Module, Head), 1642 html_meta_called(Head, Goal, Called). 1643 1644called_by(Term) --> 1645 called_by(Term, _). 1646 1647called_by(Var, _) --> 1648 { var(Var) }, 1649 !, 1650 []. 1651called_by(\G, M) --> 1652 !, 1653 ( { is_list(G) } 1654 -> called_by(G, M) 1655 ; {atom(M)} 1656 -> [(M:G)+2] 1657 ; [G+2] 1658 ). 1659called_by([], _) --> 1660 !, 1661 []. 1662called_by([H|T], M) --> 1663 !, 1664 called_by(H, M), 1665 called_by(T, M). 1666called_by(M:Term, _) --> 1667 !, 1668 ( {atom(M)} 1669 -> called_by(Term, M) 1670 ; [] 1671 ). 1672called_by(Term, M) --> 1673 { compound(Term), 1674 !, 1675 Term =.. [_|Args] 1676 }, 1677 called_by(Args, M). 1678called_by(_, _) --> 1679 []. 1680 1681:- multifile 1682 prolog:hook/1. 1683 1684prologhook(body(_,_,_)). 1685prologhook(body(_,_,_,_)). 1686prologhook(head(_,_,_)). 1687prologhook(head(_,_,_,_)). 1688 1689 1690 /******************************* 1691 * MESSAGES * 1692 *******************************/ 1693 1694:- multifile 1695 prolog:message/3. 1696 1697prologmessage(html(expand_failed(What))) --> 1698 [ 'Failed to translate to HTML: ~p'-[What] ]. 1699prologmessage(html(wrong_encoding(Stream, Enc))) --> 1700 [ 'XHTML demands UTF-8 encoding; encoding of ~p is ~w'-[Stream, Enc] ]. 1701prologmessage(html(multiple_receivers(Id))) --> 1702 [ 'html_post//2: multiple receivers for: ~p'-[Id] ]. 1703prologmessage(html(no_receiver(Id))) --> 1704 [ 'html_post//2: no receivers for: ~p'-[Id] ]
Write HTML text
Most code doesn't need to use this directly; instead use library(http/http_server), which combines this library with the typical HTTP libraries that most servers need.
The purpose of this library is to simplify writing HTML pages. Of course, it is possible to use format/3 to write to the HTML stream directly, but this is generally not very satisfactory:
This module tries to remedy these problems. The idea is to translate a Prolog term into an HTML document. We use DCG for most of the generation.
International documents
The library supports the generation of international documents, but this is currently limited to using UTF-8 encoded HTML or XHTML documents. It is strongly recommended to use the following mime-type.
When generating XHTML documents, the output stream must be in UTF-8 encoding. */