34
35:- module(cp_messages,
36 [ call_showing_messages/2, 37 after_messages/1 38 ]). 39:- use_module(library(http/html_write)). 40:- use_module(library(http/html_head)). 41:- use_module(library(http/js_write)). 42:- use_module(library(http/http_wrapper)). 43:- use_module(library(http/http_dispatch)). 44:- use_module(library(http/http_path)). 45:- use_module(library(http/cp_jquery)). 46:- use_module(library(option)). 47:- use_module(library(lists)). 48
54
55:- meta_predicate
56 call_showing_messages(0, +). 57:- html_meta
58 after_messages(html). 59
76
77:- create_prolog_flag(html_messages, false, [type(boolean)]). 78assert_message_hook :-
79 Head = user:message_hook(_Term, Level, Lines),
80 Body = send_message(Level, Lines),
81 ( clause(Head, Body)
82 -> true
83 ; asserta((Head:-Body))
84 ).
85:- initialization
86 assert_message_hook. 87
88
89call_showing_messages(Goal, Options) :-
90 option(style(Style), Options, cliopatria(default)),
91 option(head(Head), Options, title('ClioPatria')),
92 option(header(Header), Options,
93 div(class(msg_header),
94 h4('Messages ...'))),
95 ( option(footer(Footer), Options)
96 -> true
97 ; ( option(return_to(ReturnURI), Options)
98 -> FooterRest = [ p(['Go ', a(href(ReturnURI), 'back'),
99 ' to the previous page']) ]
100 ; FooterRest = []
101 ),
102 Footer = div(class(msg_footer), [ h4('Done') | FooterRest ])
103 ),
104 format('Content-Type: text/html~n'),
105 format('Transfer-Encoding: chunked~n~n'),
106 header(Style, Head, Header, Footer, FooterTokens),
107 setup_call_cleanup(
108 set_prolog_flag(html_messages, true),
109 catch(once(Goal), E, print_message(error, E)),
110 set_prolog_flag(html_messages, false)),
111 footer(FooterTokens).
112
113send_message(Level, Lines) :-
114 current_prolog_flag(html_messages, true),
115 level_css_class(Level, Class),
116 phrase(html(pre(class(Class), \html_message_lines(Lines))), Tokens),
117 with_mutex(html_messages, print_html(Tokens)),
118 flush_output,
119 fail.
120
121level_css_class(informational, msg_informational).
122level_css_class(warning, msg_warning).
123level_css_class(error, msg_error).
124
125html_message_lines([]) -->
126 [].
127html_message_lines([nl|T]) -->
128 !,
129 html('\n'), 130 html_message_lines(T).
131html_message_lines([flush]) -->
132 [].
133html_message_lines([H|T]) -->
134 !,
135 html(H),
136 html_message_lines(T).
137
138
144
145after_messages(HTML) :-
146 close_messages,
147 phrase(html(HTML), Tokens),
148 current_output(Out),
149 html_write:write_html(Tokens, Out).
150
151
157
(Style, Head, Header, Footer, FooterTokens) :-
159 http_absolute_location(icons('smiley-thinking.gif'), Image, []),
160 Magic = '$$$MAGIC$$$',
161 make_list(Header, HList),
162 make_list(Footer, FList),
163 append([ HList,
164 [ \(cp_messages:html_requires(jquery)),
165 img([id('smiley-thinking'), src(Image)]),
166 div(class(messages), Magic),
167 \(cp_messages:js_script({|javascript||
168 $("#smiley-thinking").hide(1000)|}))
169 ],
170 FList
171 ], Body),
172 phrase(html_write:page(Style, Head, Body), Tokens),
173 html_write:mailman(Tokens),
174 ( append(HeaderTokens, [Magic|FooterTokens0], Tokens)
175 -> append(CloseDiv0, [>|FooterTokens], FooterTokens0)
176 -> append(CloseDiv0, [>], CloseDiv)
177 -> true
178 ),
179 nb_setval(html_messages_close, CloseDiv),
180 current_output(Out),
181 html_write:write_html(HeaderTokens, Out),
182 flush_output(Out).
183
184make_list(List, List) :-
185 is_list(List),
186 !.
187make_list(Obj, [Obj]).
188
189close_messages :-
190 nb_current(html_messages_close, Tokens),
191 !,
192 nb_delete(html_messages_close),
193 current_output(Out),
194 html_write:write_html(Tokens, Out).
195close_messages.
196
(FooterTokens) :-
198 close_messages,
199 current_output(Out),
200 html_write:write_html(FooterTokens, Out)