1/*  Part of SWISH
    2
    3    Author:        Jan Wielemaker
    4    E-mail:        J.Wielemaker@vu.nl
    5    WWW:           http://www.swi-prolog.org
    6    Copyright (c)  2014-2015, VU University Amsterdam
    7    All rights reserved.
    8
    9    Redistribution and use in source and binary forms, with or without
   10    modification, are permitted provided that the following conditions
   11    are met:
   12
   13    1. Redistributions of source code must retain the above copyright
   14       notice, this list of conditions and the following disclaimer.
   15
   16    2. Redistributions in binary form must reproduce the above copyright
   17       notice, this list of conditions and the following disclaimer in
   18       the documentation and/or other materials provided with the
   19       distribution.
   20
   21    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   22    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   23    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   24    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   25    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   26    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   27    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   28    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   29    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   30    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   31    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   32    POSSIBILITY OF SUCH DAMAGE.
   33*/
   34
   35:- module(swish_svgtree,
   36	  [ term_rendering//3			% +Term, +Vars, +Options
   37	  ]).   38:- use_module(library(option)).   39:- use_module(library(http/html_write)).   40:- use_module(library(http/term_html)).   41:- use_module(library(http/js_write)).   42:- use_module(library(http/http_wrapper)).   43:- use_module(library(apply)).   44:- use_module(library(lists)).   45:- use_module(library(sandbox)).   46:- use_module('../render').   47
   48:- register_renderer(svgtree, "Render term as a tree").   49
   50/** <module> SWISH SVG tree renderer
   51
   52Render a term as an SVG tree.   This  renderer is intended to illustrate
   53the shape of terms or display a simple parse tree.
   54
   55This renderer is also an illustration of  using a JavaScript library and
   56SVG inside rendered elements. Note  that   the  use  of RequireJS avoids
   57loading the library multiple times as   well  as poluting the namespace.
   58
   59Note that while the  script  is   being  evaluated,  `$.ajaxScript` is a
   60jQuery object pointing to the executing script. This is used to find the
   61`span`  element  without  using  an  `id`    attribute.  Using  `id`  is
   62undesirable as it is hard  to   guarantee  their uniqueness. However, we
   63must find the desired  element  immediately   and  not  in the RequireJS
   64callback, so we need to put it in   a variable and scope the whole thing
   65in a function to avoid conflicts.  JavaScript is fun!
   66*/
   67
   68%%	term_rendering(+Term, +Vars, +Options)//
   69%
   70%	Render a compound term as a tree.  Options processed:
   71%
   72%	  - list(Boolean)
   73%	  If `false`, do not render lists.
   74%	  - filter(:NodeFilter)
   75%	  If present, use call(NodeFilter, Term, Label, Children)
   76%	  to extract the label and children of a term.  Operates
   77%	  on terms for which this call succeeds on the top node.
   78%	  If the call fails on a child, the child is rendered as
   79%	  a term.
   80
   81term_rendering(Term, _Vars, Options) -->
   82	{ is_term_tree(Term, How, Options),
   83	  call(How, Term, Dict)
   84	},
   85	html(div([ class('render-svg-tree'),
   86		   'data-render'('Term as SVG tree')
   87		 ],
   88		 [ span([]),
   89		   \js_script({|javascript(Dict)||
   90(function() {
   91  if ( $.ajaxScript ) {
   92    var span = $.ajaxScript.parent().find("span")[0];
   93
   94    require(["render/svg-tree-drawer", "jquery"], function(svgtree) {
   95      var tree = new TreeDrawer(span, Dict);
   96      if ( !tree.filters.label ) {
   97	tree.addFilter('label', function(label,node) {
   98	  return typeof(label) == "object" ? $(label.html)[0] : label;
   99	});
  100      }
  101      tree.draw();
  102    });
  103  }
  104})();
  105		  |})
  106		 ])).
  107
  108%%	is_term_tree(+Term, -Closure, +Options) is semidet.
  109%
  110%	True when Term  is  a  Prolog   term  that  can  meaningfully be
  111%	displayed as a tree. The  actual   rendering  is done by calling
  112%	call(Closure, Term, JSON), where the  called closure must return
  113%	a nested dict and each node contains:
  114%
  115%	  * label
  116%	  The label to display.  This is either a string or a dict
  117%	  containing html:HTMLString
  118%	  * children
  119%	  If present, this is a list of child nodes. If not, it is
  120%	  a leaf node.
  121
  122is_term_tree(Term, filtered_tree(QFilter, Options1), Options) :-
  123	option(filter(Filter), Options),
  124	callable(Filter),
  125	Filter \= _:_,
  126	option(module(Module), Options),
  127	QFilter = Module:Filter,
  128	catch(safe_filter(QFilter), _, fail),
  129	call(QFilter, Term, _Label, _Children), !,
  130	browser_option(Options, Options1).
  131is_term_tree(Term, compound_tree(Options1), Options) :-
  132	compound(Term),
  133	(   is_list(Term)
  134	->  \+ option(list(false), Options)
  135	;   true
  136	), !,
  137	browser_option(Options, Options1).
  138
  139:- public
  140	compound_tree/3,
  141	filtered_tree/4.  142
  143%%	compound_tree(+Options, +Term, -JSON) is det.
  144%
  145%	Render Term as a tree, considering every   compound term to be a
  146%	node.  Renders leafs using term//1.
  147
  148compound_tree(Options, Term, Tree) :-
  149	compound(Term), Term \= '$VAR'(_), !,
  150	Tree = json{label:Label, children:Children},
  151	compound_name_arguments(Term, Functor, Args),
  152	term_string(Functor, Label),
  153	maplist(compound_tree(Options), Args, Children).
  154compound_tree(Options, Term, json{label:Label}) :-
  155	term_label(Term, Label, Options).
  156
  157%%	term_label(+Term, -Label, +Options) is det.
  158%
  159%	Create a label for a term.  If   we  can, we generate HTML using
  160%	term//2, which is translated into   an  SVG `foreignObject`. The
  161%	Trident engine used by IE does  not support foreignObject though
  162%	:-(
  163
  164term_label(Term, String, Options) :-
  165	option(engine(trident), Options), !,
  166	term_string(Term, String, Options).
  167term_label(Term, json{html:String}, Options) :-
  168	phrase(term(Term, Options), Tokens),
  169	with_output_to(string(String), print_html(Tokens)).
  170
  171%%	filtered_tree(:Filter, +Options, +Term, -JSON) is det.
  172%
  173%	Render a filtered tree.
  174
  175:- meta_predicate filtered_tree(3,+,+,-).  176
  177filtered_tree(Filter, Options, Term, Tree) :-
  178	nonvar(Term),
  179	call(Filter, Term, LabelTerm, ChildNodes),
  180	is_list(ChildNodes), !,
  181	Tree = json{label:Label, children:Children},
  182	term_label(LabelTerm, Label, Options),
  183	maplist(filtered_tree(Filter, Options), ChildNodes, Children).
  184filtered_tree(_, Options, Term, json{label:Label}) :-
  185	term_label(Term, Label, Options).
  186
  187safe_filter(Module:Filter) :-
  188	Filter =.. List0,
  189	append(List0, [_, _, _], List),
  190	Filter1 =.. List,
  191	safe_goal(Module:Filter1).
  192
  193
  194		 /*******************************
  195		 *	      BROWSER		*
  196		 *******************************/
  197
  198browser_option(Options0, Options) :-
  199	is_trident, !,
  200	Options = [engine(trident)|Options0].
  201browser_option(Options, Options).
  202
  203%%	is_trident is semidet.
  204%
  205%	True if we know that the client is Trident-based (IE)
  206
  207is_trident :-
  208	http_current_request(Request),
  209	option(user_agent(Agent), Request),
  210	sub_string(Agent, _, _, _, " Trident/"), !