29
30:- module(html_messages,
31 [ call_showing_messages/2
32 ]). 33:- use_module(library(http/html_write)). 34:- use_module(library(http/html_head)). 35:- use_module(library(option)). 36
42
43:- meta_predicate
44 call_showing_messages(0, +). 45
62
63:- create_prolog_flag(html_messages, false, [type(boolean)]). 64
65assert_message_hook :-
66 Head = message_hook(_Term, Level, Lines),
67 Body = send_message(Level, Lines),
68 ( clause(user:Head, Body)
69 -> true
70 ; asserta((user:Head :- Body))
71 ).
72
73:- initialization
74 assert_message_hook. 75
76call_showing_messages(Goal, Options) :-
77 option(style(Style), Options, default),
78 option(head(Head), Options, title('SWI-Prolog -- make')),
79 option(header(Header), Options,
80 div(class(msg_header),
81 h4('Messages ...'))),
82 ( option(footer(Footer), Options)
83 -> true
84 ; ( option(return_to(ReturnURI), Options)
85 -> FooterRest = [ p(['Go ', a(href(ReturnURI), 'back'),
86 ' to the previous page']) ]
87 ; FooterRest = []
88 ),
89 Footer = div(class(msg_footer), [ h4('Done') | FooterRest ])
90 ),
91 format('Content-Type: text/html~n'),
92 format('Transfer-Encoding: chunked~n~n'),
93 header(Style, Head, Header, Footer, FooterTokens),
94 setup_call_cleanup(
95 set_prolog_flag(html_messages, true),
96 catch(Goal, E, print_message(error, E)),
97 set_prolog_flag(html_messages, false)), !,
98 footer(FooterTokens).
99
100send_message(Level, Lines) :-
101 current_prolog_flag(html_messages, true),
102 level_css_class(Level, Class),
103 phrase(html(pre(class(Class), \html_message_lines(Lines))), Tokens),
104 with_mutex(html_messages, print_html(Tokens)),
105 flush_output,
106 fail.
107
108level_css_class(informational, msg_informational).
109level_css_class(warning, msg_warning).
110level_css_class(error, msg_error).
111
112html_message_lines([]) -->
113 [].
114html_message_lines([nl|T]) --> !,
115 html('\n'), 116 html_message_lines(T).
117html_message_lines([flush]) -->
118 [].
119html_message_lines([H|T]) --> !,
120 html(H),
121 html_message_lines(T).
122
123
129
(Style, Head, Header, Footer, FooterTokens) :-
131 Magic = '$$$MAGIC$$$',
132 Body = [ Header,
133 \(html_messages:html_requires(css('messages.css'))),
134 div(class(messages), Magic),
135 Footer
136 ],
137 phrase(html_write:page(Style, Head, Body), Tokens),
138 html_write:mailman(Tokens),
139 append(HeaderTokens, [Magic|FooterTokens], Tokens), !,
140 current_output(Out),
141 html_write:write_html(HeaderTokens, Out),
142 flush_output(Out).
143
(Footer) :-
145 current_output(Out),
146 html_write:write_html(Footer, Out)