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