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