View source with raw comments or as raw
    1/*  Part of SWI-Prolog
    2
    3    Author:        Jan Wielemaker
    4    E-mail:        J.Wielemaker@vu.nl
    5    WWW:           http://www.swi-prolog.org
    6    Copyright (c)  2014, 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(term_html,
   36          [ term//2                             % +Term, +Options
   37          ]).   38:- use_module(library(http/html_write)).   39:- use_module(library(option)).   40:- use_module(library(error)).   41:- use_module(library(debug)).   42
   43:- multifile
   44    blob_rendering//3.              % +Type, +Blob, +Options

Represent Prolog terms as HTML

This file is primarily designed to support running Prolog applications over the web. It provides a replacement for write_term/2 which renders terms as structured HTML. */

 term(@Term, +Options)// is det
Render a Prolog term as a structured HTML tree. Options are passed to write_term/3. In addition, the following options are processed:
float_format(+Format)
If a float is rendered, it is rendered using format(string(S), Format, [Float])%
To be done
- Cyclic terms.
- Attributed terms.
- Portray
- Test with Ulrich's write test set.
- Deal with numbervars and canonical.
   69term(Term, Options) -->
   70    { must_be(acyclic, Term),
   71      merge_options(Options,
   72                    [ priority(1200),
   73                      max_depth(1 000 000 000),
   74                      depth(0)
   75                    ],
   76                    Options1),
   77      dict_create(Dict, _, Options1)
   78    },
   79    any(Term, Dict).
   80
   81
   82any(_, Options) -->
   83    { Options.depth >= Options.max_depth },
   84    !,
   85    html(span(class('pl-ellipsis'), ...)).
   86any(Term, Options) -->
   87    { primitive(Term, Class0),
   88      !,
   89      quote_atomic(Term, S, Options),
   90      primitive_class(Class0, Term, S, Class)
   91    },
   92    html(span(class(Class), S)).
   93any(Term, Options) -->
   94    { blob(Term,Type), Term \== [] },
   95    !,
   96    (   blob_rendering(Type,Term,Options)
   97    ->  []
   98    ;   html(span(class('pl-blob'),['<',Type,'>']))
   99    ).
  100any(Term, Options) -->
  101    { is_dict(Term), !
  102    },
  103    dict(Term, Options).
  104any(Term, Options) -->
  105    { assertion((compound(Term);Term==[]))
  106    },
  107    compound(Term, Options).
 compound(+Compound, +Options)// is det
Process a compound term.
  113compound('$VAR'(Var), Options) -->
  114    { Options.get(numbervars) == true,
  115      !,
  116      format(string(S), '~W', ['$VAR'(Var), [numbervars(true)]]),
  117      (   S == "_"
  118      ->  Class = 'pl-anon'
  119      ;   Class = 'pl-var'
  120      )
  121    },
  122    html(span(class(Class), S)).
  123compound(List, Options) -->
  124    { (   List == []
  125      ;   List = [_|_]                              % May have unbound tail
  126      ),
  127      !,
  128      arg_options(Options, _{priority:999}, ArgOptions)
  129    },
  130    list(List, ArgOptions).
  131compound({X}, Options) -->
  132    !,
  133    { arg_options(Options, _{priority:1200}, ArgOptions) },
  134    html(span(class('pl-curl'), [ '{', \any(X, ArgOptions), '}' ])).
  135compound(OpTerm, Options) -->
  136    { compound_name_arity(OpTerm, Name, 1),
  137      is_op1(Name, Type, Pri, ArgPri, Options),
  138      \+ Options.get(ignore_ops) == true
  139    },
  140    !,
  141    op1(Type, Pri, OpTerm, ArgPri, Options).
  142compound(OpTerm, Options) -->
  143    { compound_name_arity(OpTerm, Name, 2),
  144      is_op2(Name, LeftPri, Pri, RightPri, Options),
  145      \+ Options.get(ignore_ops) == true
  146    },
  147    !,
  148    op2(Pri, OpTerm, LeftPri, RightPri, Options).
  149compound(Compound, Options) -->
  150    { compound_name_arity(Compound, Name, Arity),
  151      quote_atomic(Name, S, Options.put(embrace, never)),
  152      arg_options(Options, _{priority:999}, ArgOptions),
  153      extra_classes(Classes, Options)
  154    },
  155    html(span(class(['pl-compound'|Classes]),
  156              [ span(class('pl-functor'), S),
  157                '(',
  158                \args(0, Arity, Compound, ArgOptions),
  159                ')'
  160              ])).
  161
  162extra_classes(['pl-level-0'], Options) :-
  163    Options.depth == 0,
  164    !.
  165extra_classes([], _).
 arg_options(+Options, -OptionsOut) is det
 arg_options(+Options, +Extra, -OptionsOut) is det
Increment depth in Options.
  172arg_options(Options, Options.put(depth, NewDepth)) :-
  173    NewDepth is Options.depth+1.
  174arg_options(Options, Extra, Options.put(depth, NewDepth).put(Extra)) :-
  175    NewDepth is Options.depth+1.
 args(+Arg0, +Arity, +Compound, +Options)//
Emit arguments of a compound term.
  181args(Arity, Arity, _, _) --> !.
  182args(I, Arity, Compound, ArgOptions) -->
  183    { NI is I + 1,
  184      arg(NI, Compound, Arg)
  185    },
  186    any(Arg, ArgOptions),
  187    (   {NI == Arity}
  188    ->  []
  189    ;   html(', '),
  190        args(NI, Arity, Compound, ArgOptions)
  191    ).
 list(+List, +Options)//
Emit a list. The List may have an unbound tail.
  197list(List, Options) -->
  198    html(span(class('pl-list'),
  199              ['[', \list_content(List, Options),
  200               ']'
  201              ])).
  202
  203list_content([], _Options) -->
  204    !,
  205    [].
  206list_content([H|T], Options) -->
  207    !,
  208    { arg_options(Options, ArgOptions)
  209    },
  210    any(H, Options),
  211    (   {T == []}
  212    ->  []
  213    ;   { Options.depth + 1 >= Options.max_depth }
  214    ->  html(['|',span(class('pl-ellipsis'), ...)])
  215    ;   {var(T) ; \+ T = [_|_]}
  216    ->  html('|'),
  217        tail(T, ArgOptions)
  218    ;   html(', '),
  219        list_content(T, ArgOptions)
  220    ).
  221
  222tail(Value, Options) -->
  223    {   var(Value)
  224    ->  Class = 'pl-var-tail'
  225    ;   Class = 'pl-nonvar-tail'
  226    },
  227    html(span(class(Class), \any(Value, Options))).
 is_op1(+Name, -Type, -Priority, -ArgPriority, +Options) is semidet
True if Name is an operator taking one argument of Type.
  233is_op1(Name, Type, Pri, ArgPri, Options) :-
  234    operator_module(Module, Options),
  235    current_op(Pri, OpType, Module:Name),
  236    argpri(OpType, Type, Pri, ArgPri),
  237    !.
  238
  239argpri(fx, prefix,  Pri0, Pri) :- Pri is Pri0 - 1.
  240argpri(fy, prefix,  Pri,  Pri).
  241argpri(xf, postfix, Pri0, Pri) :- Pri is Pri0 - 1.
  242argpri(yf, postfix, Pri,  Pri).
 is_op2(+Name, -LeftPri, -Pri, -RightPri, +Options) is semidet
True if Name is an operator taking two arguments of Type.
  248is_op2(Name, LeftPri, Pri, RightPri, Options) :-
  249    operator_module(Module, Options),
  250    current_op(Pri, Type, Module:Name),
  251    infix_argpri(Type, LeftPri, Pri, RightPri),
  252    !.
  253
  254infix_argpri(xfx, ArgPri, Pri, ArgPri) :- ArgPri is Pri - 1.
  255infix_argpri(yfx, Pri, Pri, ArgPri) :- ArgPri is Pri - 1.
  256infix_argpri(xfy, ArgPri, Pri, Pri) :- ArgPri is Pri - 1.
 operator_module(-Module, +Options) is det
Find the module for evaluating operators.
  262operator_module(Module, Options) :-
  263    Module = Options.get(module),
  264    !.
  265operator_module(TypeIn, _) :-
  266    '$module'(TypeIn, TypeIn).
 op1(+Type, +Pri, +Term, +ArgPri, +Options)// is det
  270op1(Type, Pri, Term, ArgPri, Options) -->
  271    { Pri > Options.priority },
  272    !,
  273    html(['(', \op1(Type, Term, ArgPri, Options), ')']).
  274op1(Type, _, Term, ArgPri, Options) -->
  275    op1(Type, Term, ArgPri, Options).
  276
  277op1(prefix, Term, ArgPri, Options) -->
  278    { Term =.. [Functor,Arg],
  279      arg_options(Options, DepthOptions),
  280      FuncOptions = DepthOptions.put(embrace, never),
  281      ArgOptions  = DepthOptions.put(priority, ArgPri),
  282      quote_atomic(Functor, S, FuncOptions),
  283      extra_classes(Classes, Options)
  284    },
  285    html(span(class(['pl-compound'|Classes]),
  286              [ span(class('pl-prefix'), S),
  287                \space(Functor, Arg, FuncOptions, ArgOptions),
  288                \any(Arg, ArgOptions)
  289              ])).
  290op1(postfix, Term, ArgPri, Options) -->
  291    { Term =.. [Functor,Arg],
  292      arg_options(Options, DepthOptions),
  293      ArgOptions = DepthOptions.put(priority, ArgPri),
  294      FuncOptions = DepthOptions.put(embrace, never),
  295      quote_atomic(Functor, S, FuncOptions),
  296      extra_classes(Classes, Options)
  297    },
  298    html(span(class(['pl-compound'|Classes]),
  299              [ \any(Arg, ArgOptions),
  300                \space(Arg, Functor, ArgOptions, FuncOptions),
  301                span(class('pl-postfix'), S)
  302              ])).
 op2(+Pri, +Term, +LeftPri, +RightPri, +Options)// is det
  306op2(Pri, Term, LeftPri, RightPri, Options) -->
  307    { Pri > Options.priority },
  308    !,
  309    html(['(', \op2(Term, LeftPri, RightPri, Options), ')']).
  310op2(_, Term, LeftPri, RightPri, Options) -->
  311    op2(Term, LeftPri, RightPri, Options).
  312
  313op2(Term, LeftPri, RightPri, Options) -->
  314    { Term =.. [Functor,Left,Right],
  315      arg_options(Options, DepthOptions),
  316      LeftOptions  = DepthOptions.put(priority, LeftPri),
  317      FuncOptions  = DepthOptions.put(embrace, never),
  318      RightOptions = DepthOptions.put(priority, RightPri),
  319      (   (   need_space(Left, Functor, LeftOptions, FuncOptions)
  320          ;   need_space(Functor, Right, FuncOptions, RightOptions)
  321          )
  322      ->  Space = ' '
  323      ;   Space = ''
  324      ),
  325      quote_op(Functor, S, Options),
  326      extra_classes(Classes, Options)
  327    },
  328    html(span(class(['pl-compound'|Classes]),
  329              [ \any(Left, LeftOptions),
  330                Space,
  331                span(class('pl-infix'), S),
  332                Space,
  333                \any(Right, RightOptions)
  334              ])).
 space(@T1, @T2, +Options)//
Emit a space if omitting a space between T1 and T2 would cause the two terms to join.
  341space(T1, T2, LeftOptions, RightOptions) -->
  342    { need_space(T1, T2, LeftOptions, RightOptions) },
  343    html(' ').
  344space(_, _, _, _) -->
  345    [].
  346
  347need_space(T1, T2, _, _) :-
  348    (   is_solo(T1)
  349    ;   is_solo(T2)
  350    ),
  351    !,
  352    fail.
  353need_space(T1, T2, LeftOptions, RightOptions) :-
  354    end_code_type(T1, TypeR, LeftOptions.put(side, right)),
  355    end_code_type(T2, TypeL, RightOptions.put(side, left)),
  356    \+ no_space(TypeR, TypeL).
  357
  358no_space(punct, _).
  359no_space(_, punct).
  360no_space(quote(R), quote(L)) :-
  361    !,
  362    R \== L.
  363no_space(alnum, symbol).
  364no_space(symbol, alnum).
 end_code_type(+Term, -Code, Options)
True when code is the first/last character code that is emitted by printing Term using Options.
  371end_code_type(_, Type, Options) :-
  372    Options.depth >= Options.max_depth,
  373    !,
  374    Type = symbol.
  375end_code_type(Term, Type, Options) :-
  376    primitive(Term, _),
  377    !,
  378    quote_atomic(Term, S, Options),
  379    end_type(S, Type, Options).
  380end_code_type(Dict, Type, Options) :-
  381    is_dict(Dict, Tag),
  382    !,
  383    (   Options.side == left
  384    ->  end_code_type(Tag, Type, Options)
  385    ;   Type = punct
  386    ).
  387end_code_type('$VAR'(Var), Type, Options) :-
  388    Options.get(numbervars) == true,
  389    !,
  390    format(string(S), '~W', ['$VAR'(Var), [numbervars(true)]]),
  391    end_type(S, Type, Options).
  392end_code_type(List, Type, _) :-
  393    (   List == []
  394    ;   List = [_|_]
  395    ),
  396    !,
  397    Type = punct.
  398end_code_type(OpTerm, Type, Options) :-
  399    compound_name_arity(OpTerm, Name, 1),
  400    is_op1(Name, Type, Pri, ArgPri, Options),
  401    \+ Options.get(ignore_ops) == true,
  402    !,
  403    (   Pri > Options.priority
  404    ->  Type = punct
  405    ;   (   Type == prefix
  406        ->  end_code_type(Name, Type, Options)
  407        ;   arg(1, OpTerm, Arg),
  408            arg_options(Options, ArgOptions),
  409            end_code_type(Arg, Type, ArgOptions.put(priority, ArgPri))
  410        )
  411    ).
  412end_code_type(OpTerm, Type, Options) :-
  413    compound_name_arity(OpTerm, Name, 2),
  414    is_op2(Name, LeftPri, Pri, _RightPri, Options),
  415    \+ Options.get(ignore_ops) == true,
  416    !,
  417    (   Pri > Options.priority
  418    ->  Type = punct
  419    ;   arg(1, OpTerm, Arg),
  420        arg_options(Options, ArgOptions),
  421        end_code_type(Arg, Type, ArgOptions.put(priority, LeftPri))
  422    ).
  423end_code_type(Compound, Type, Options) :-
  424    compound_name_arity(Compound, Name, _),
  425    end_code_type(Name, Type, Options).
  426
  427end_type(S, Type, Options) :-
  428    number(S),
  429    !,
  430    (   (S < 0 ; S == -0.0),
  431        Options.side == left
  432    ->  Type = symbol
  433    ;   Type = alnum
  434    ).
  435end_type(S, Type, Options) :-
  436    Options.side == left,
  437    !,
  438    sub_string(S, 0, 1, _, Start),
  439    syntax_type(Start, Type).
  440end_type(S, Type, _) :-
  441    sub_string(S, _, 1, 0, End),
  442    syntax_type(End, Type).
  443
  444syntax_type("\"", quote(double)) :- !.
  445syntax_type("\'", quote(single)) :- !.
  446syntax_type("\`", quote(back))   :- !.
  447syntax_type(S, Type) :-
  448    string_code(1, S, C),
  449    (   code_type(C, prolog_identifier_continue)
  450    ->  Type = alnum
  451    ;   code_type(C, prolog_symbol)
  452    ->  Type = symbol
  453    ;   code_type(C, space)
  454    ->  Type = layout
  455    ;   Type = punct
  456    ).
 dict(+Term, +Options)//
  461dict(Term, Options) -->
  462    { dict_pairs(Term, Tag, Pairs),
  463      quote_atomic(Tag, S, Options.put(embrace, never)),
  464      arg_options(Options, ArgOptions)
  465    },
  466    html(span(class('pl-dict'),
  467              [ span(class('pl-tag'), S),
  468                '{',
  469                \dict_kvs(Pairs, ArgOptions),
  470                '}'
  471              ])).
  472
  473dict_kvs([], _) --> [].
  474dict_kvs(_, Options) -->
  475    { Options.depth >= Options.max_depth },
  476    !,
  477    html(span(class('pl-ellipsis'), ...)).
  478dict_kvs(KVs, Options) -->
  479    dict_kvs2(KVs, Options).
  480
  481dict_kvs2([K-V|T], Options) -->
  482    { quote_atomic(K, S, Options),
  483      end_code_type(V, VType, Options.put(side, left)),
  484      (   VType == symbol
  485      ->  VSpace = ' '
  486      ;   VSpace = ''
  487      ),
  488      arg_options(Options, ArgOptions)
  489    },
  490    html([ span(class('pl-key'), S),
  491           ':',                             % FIXME: spacing
  492           VSpace,
  493           \any(V, ArgOptions)
  494         ]),
  495    (   {T==[]}
  496    ->  []
  497    ;   html(', '),
  498        dict_kvs2(T, Options)
  499    ).
  500
  501quote_atomic(Float, String, Options) :-
  502    float(Float),
  503    Format = Options.get(float_format),
  504    !,
  505    format(string(String), Format, [Float]).
  506quote_atomic(Plain, String, Options) :-
  507    rational(Plain),
  508    \+ integer(Plain),
  509    !,
  510    operator_module(Module, Options),
  511    format(string(String), '~W', [Plain, [module(Module)]]).
  512quote_atomic(Plain, Plain, _) :-
  513    number(Plain),
  514    !.
  515quote_atomic(Plain, String, Options) :-
  516    Options.get(quoted) == true,
  517    !,
  518    (   Options.get(embrace) == never
  519    ->  format(string(String), '~q', [Plain])
  520    ;   format(string(String), '~W', [Plain, Options])
  521    ).
  522quote_atomic(Var, String, Options) :-
  523    var(Var),
  524    !,
  525    format(string(String), '~W', [Var, Options]).
  526quote_atomic(Plain, Plain, _).
  527
  528quote_op(Op, S, _Options) :-
  529    is_solo(Op),
  530    !,
  531    S = Op.
  532quote_op(Op, S, Options) :-
  533    quote_atomic(Op, S, Options.put(embrace,never)).
  534
  535is_solo(Var) :-
  536    var(Var), !, fail.
  537is_solo(',').
  538is_solo(';').
  539is_solo('!').
 primitive(+Term, -Class) is semidet
True if Term is a primitive term, rendered using the CSS class Class.
  546primitive(Term, Type) :- var(Term),      !, Type = 'pl-avar'.
  547primitive(Term, Type) :- atom(Term),     !, Type = 'pl-atom'.
  548primitive(Term, Type) :- string(Term),   !, Type = 'pl-string'.
  549primitive(Term, Type) :- integer(Term),  !, Type = 'pl-int'.
  550primitive(Term, Type) :- rational(Term), !, Type = 'pl-rational'.
  551primitive(Term, Type) :- float(Term),    !, Type = 'pl-float'.
 primitive_class(+Class0, +Value, -String, -Class) is det
Fixup the CSS class for lexical variations. Used to find quoted atoms.
  558primitive_class('pl-atom', Atom, String, Class) :-
  559    \+ atom_string(Atom, String),
  560    !,
  561    Class = 'pl-quoted-atom'.
  562primitive_class(Class, _, _, Class).
  563
  564
  565                 /*******************************
  566                 *             HOOKS            *
  567                 *******************************/
 blob_rendering(+BlobType, +Blob, +WriteOptions)// is semidet
Hook to render blob atoms as HTML. This hook is called whenever a blob atom is encountered while rendering a compound term as HTML. The blob type is provided to allow efficient indexing without having to examine the blob. If this predicate fails, the blob is rendered as an HTML SPAN with class 'pl-blob' containing BlobType as text.