View source with formatted comments or as raw
    1/*  Part of ClioPatria SeRQL and SPARQL server
    2
    3    Author:        Jan Wielemaker
    4    E-mail:        J.Wielemaker@cs.vu.nl
    5    WWW:           http://www.swi-prolog.org
    6    Copyright (C): 2015, VU University Amsterdam
    7
    8    This program is free software; you can redistribute it and/or
    9    modify it under the terms of the GNU General Public License
   10    as published by the Free Software Foundation; either version 2
   11    of the License, or (at your option) any later version.
   12
   13    This program is distributed in the hope that it will be useful,
   14    but WITHOUT ANY WARRANTY; without even the implied warranty of
   15    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   16    GNU General Public License for more details.
   17
   18    You should have received a copy of the GNU General Public
   19    License along with this library; if not, write to the Free Software
   20    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
   21
   22    As a special exception, if you link this library with other files,
   23    compiled with a Free Software compiler, to produce an executable, this
   24    library does not by itself cause the resulting executable to be covered
   25    by the GNU General Public License. This exception does not however
   26    invalidate any other reasons why the executable file might be covered by
   27    the GNU General Public License.
   28*/
   29
   30:- module(cp_messages,
   31	  [ call_showing_messages/2,	% :Goal, +Options
   32	    after_messages/1		% +HTML
   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
   44/** <module> Run goals that produce messages
   45
   46This module allows executing (long  running)   Prolog  goals and see the
   47messages appear in the browser.
   48*/
   49
   50:- meta_predicate
   51	call_showing_messages(0, +).   52:- html_meta
   53	after_messages(html).   54
   55%%	call_showing_messages(:Goal, +Options) is det.
   56%
   57%	Execute  Goal,  showing  the  feedback   in  the  browser.  This
   58%	predicate builds a default application   page with a placeholder
   59%	for the messages. It then sends   all  HTML upto the placeholder
   60%	and flushes the output to  the   browser.  During execution, all
   61%	output from Goal emitted through   print_message/2  is caught in
   62%	the message-box. After completion of Goal the page is completed.
   63%
   64%	This predicate is intended for action such as loading RDF files,
   65%	while providing feedback on  files   loaded  and  possible error
   66%	messages. Note that this call creates a complete page.
   67%
   68%	@bug	This call uses =chunked= transfer encoding to send the
   69%		page in parts.  Not all browsers support this and not
   70%		all browsers update the page incrementally.
   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'),			% we are in a <pre> environment
  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
  132%%	after_messages(+HTML) is det.
  133%
  134%	Close the message window and emit   HTML.  This predicate may be
  135%	called from the Goal of call_showing_messages/2 to indicate that
  136%	all work has been done.
  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
  145%%	header(+Style, +Head, +Header, +Footer, -FooterTokens)
  146%
  147%	Emit all tokens upto the placeholder for the actual messages and
  148%	return the remaining page-tokens in FooterTokens. Style and Head
  149%	are passed
  150
  151header(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
  188footer(FooterTokens) :-
  189	close_messages,
  190	current_output(Out),
  191	html_write:write_html(FooterTokens, Out)