1/*  Part of ClioPatria
    2
    3    Author:        Jan Wielemaker
    4    E-mail:        J.Wielemaker@vu.nl
    5    WWW:           http://www.swi-prolog.org
    6    Copyright (c)  2010-2012, University of Amsterdam
    7                              CWI, Asterdam
    8                              VU University Amsterdam
    9    All rights reserved.
   10
   11    Redistribution and use in source and binary forms, with or without
   12    modification, are permitted provided that the following conditions
   13    are met:
   14
   15    1. Redistributions of source code must retain the above copyright
   16       notice, this list of conditions and the following disclaimer.
   17
   18    2. Redistributions in binary form must reproduce the above copyright
   19       notice, this list of conditions and the following disclaimer in
   20       the documentation and/or other materials provided with the
   21       distribution.
   22
   23    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   24    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   25    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   26    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   27    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   28    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   29    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   30    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   31    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   32    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   33    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   34    POSSIBILITY OF SUCH DAMAGE.
   35*/
   36
   37:- module(http_help,
   38          [ page_documentation_link//1  % +Request
   39          ]).   40:- use_module(http_tree).   41:- use_module(doc_components,
   42              [ api_tester//2,
   43                init_api_tester//0
   44              ]).   45:- use_module(library(http/http_dispatch)).   46:- use_module(library(http/http_path)).   47:- use_module(library(http/http_json)).   48:- use_module(library(http/js_write)).   49:- use_module(library(http/html_write)).   50:- use_module(library(http/html_head)).   51:- use_module(library(http/http_host)).   52:- use_module(library(http/http_parameters)).   53:- use_module(library(option)).   54:- use_module(library(lists)).   55:- use_module(library(apply)).   56                                        % PlDoc interface
   57:- use_module(library(pldoc/doc_html)).   58:- use_module(library(pldoc/doc_process)).   59
   60/** <module> Explore the running HTTP server
   61
   62This module is part of the  SWI-Prolog web-developent infrastructure. It
   63documents the HTTP server using the reflexive capabilities of Prolog and
   64the server infrastructure. Self-documentation is enabled by loading this
   65module. The entry-point of this module is   located at the HTTP location
   66root(help/http), using the handler-identifier =http_help=.
   67
   68In    addition,    this     module      provides     the     _component_
   69page_documentation_link//1, which shows a small   book  linking from the
   70displayed page to its documentation.
   71*/
   72
   73:- http_handler(root(help/http),             http_help,       []).   74:- http_handler(root(help/http_handler),     help_on_handler, []).   75:- http_handler(root(help/http_ac_location), ac_location,     []).   76
   77%!  page_documentation_link(+Request)// is det.
   78%
   79%   Show a link to the documentation of the current page.
   80
   81page_documentation_link(Request) -->
   82    { memberchk(path(Path), Request),
   83      http_link_to_id(http_help, [location=Path], HREF),
   84      http_absolute_location(icons('doc.png'), IMG, [])
   85    },
   86    html(a([id('dev-help'), href(HREF)],
   87           img([ alt('Developer help'),
   88                 title('Page documentation'),
   89                 src(IMG)
   90               ]))).
   91
   92%!  http_help(Request)
   93%
   94%   HTTP handler to explore the Prolog HTTP server
   95
   96http_help(Request) :-
   97    http_parameters(Request,
   98                    [ location(Start,
   99                               [ optional(true),
  100                                 description('Display help on location')
  101                               ])
  102                    ]),
  103    http_current_host(Request, Host, Port, [global(true)]),
  104    (   Port == 80
  105    ->  Authority = Host
  106    ;   format(atom(Authority), '~w:~w', [Host, Port])
  107    ),
  108    (   var(Start)
  109    ->  Options = []
  110    ;   Options = [ location(Start) ]
  111    ),
  112    reply_html_page(cliopatria(http_help),
  113                    title('Server help'),
  114                    [ body(class('yui-skin-sam'),
  115                           [ h1(class(title), 'Server at ~w'-[Authority]),
  116                             \help_page(Options)
  117                           ])
  118                    ]).
  119
  120%!  help_page(Options)//
  121%
  122%   Emit the tree and #http-help  for   holding  the description. We
  123%   need to include the requirements for   PlDoc here as the scripts
  124%   are not loaded through the innerHTML method.
  125%
  126%   Options:
  127%
  128%       * location(Location)
  129%       Initially open Location.
  130
  131help_page(Options) -->
  132    { tree_view_options(TreeOptions) },
  133    html([ \html_requires(css('httpdoc.css')),
  134           \html_requires(pldoc),
  135           \html_requires(js('api_test.js')),
  136           div(id('http-tree'), \http_tree_view(TreeOptions)),
  137           div(id('http-find'), \quick_find_div_content),
  138           div(id('http-help'), \usage),
  139           \script(Options),
  140           \init_api_tester
  141         ]).
  142
  143tree_view_options(
  144[ labelClick('function(node) { helpNode(node) }')
  145]).
  146
  147usage -->
  148    html([ h4('Usage'),
  149           p([ 'This page finds HTTP paths (locations) served by this ',
  150               'server.  You can find locations by browsing the hierarchy ',
  151               'at the left or by entering a few characters from the ',
  152               'path in the search box above.  Autocompletion will show ',
  153               'paths that contain the typed string.'
  154             ])
  155         ]).
  156
  157
  158%!  script(+Options)// is det.
  159%
  160%   Emit JavScript code that gets  the   help  for the HTTP location
  161%   associated  with  _node_  and  displays    this  information  in
  162%   #http-help.
  163
  164script(Options) -->
  165    { http_link_to_id(help_on_handler, [], Handler)
  166    },
  167    html([ script(type('text/javascript'),
  168                  \[
  169'function helpNode(node)\n',
  170'{',
  171'  helpHTTP(node.data.path);\n',
  172'}\n\n',
  173'function helpHTTP(path)\n',
  174'{',
  175'  var callback =\n',
  176'  { success: function(o)\n',
  177'             {\n',
  178'\t\tvar content = document.getElementById("http-help");\n',
  179'\t\tcontent.innerHTML = o.responseText;\n',
  180'             }\n',
  181'  }\n',
  182'  var sUrl = "~w?location=" + encodeURIComponent(path);\n'-[Handler],
  183'  var transaction = YAHOO.util.Connect.asyncRequest("GET", sUrl, callback, null);\n',
  184'}\n',
  185           \start(Options)
  186                   ])
  187         ]).
  188
  189start(Options) -->
  190    { option(location(Start), Options)
  191    },
  192    !,
  193    js_call(helpHTTP(Start)).
  194start(_) --> [].
  195
  196
  197%!  help_on_handler(+Request)
  198%
  199%   Describe the HTTP handler for the given location.
  200%
  201%   @tbd    Include the output format by scanning for one of the
  202%           defined output handlers.
  203
  204help_on_handler(Request) :-
  205    http_parameters(Request,
  206                    [ location(Path,
  207                               [ description('Location on this server to describe')
  208                               ])
  209                    ]),
  210    (   http_current_handler(Path, M:H, Options)
  211    ->  reply_html_page([],
  212                        [ h1(['HTTP location ', Path]),
  213                          \handler(Request, Path, M:H, Options)
  214                        ])
  215    ;   reply_html_page([],
  216                        [ h4(['No handler for ', Path])
  217                        ])
  218    ).
  219
  220handler(_Request, Path, _:http_redirect(How, Where), _Options) -->
  221    !,
  222    {   Where = location_by_id(Id)
  223    ->  http_location_by_id(Id, URL)
  224    ;   http_absolute_location(Where, URL, [relative_to(Path)])
  225    },
  226    html(p([ 'Location redirects (using "', i(\status(How)), '") to ',
  227             a([href('javascript:helpHTTP("'+URL+'")')], URL),
  228             '.'
  229           ])).
  230handler(_Request, Path, _:http_reply_file(File, Options), _Options) -->
  231    !,
  232    file_handler(File, Path, Options).
  233handler(Request, Path, Closure, Options) -->
  234    { extend_closure(Closure, [_], Closure1),
  235      extracted_parameters(Closure1, Params)
  236    },
  237    html(h4('Implementation')),
  238    predicate_help(Request, Closure1),
  239    html(h4('Test this API')),
  240    api_tester(Path, Params),
  241    html(h4('Parameters for this API')),
  242    parameter_table(Params),
  243    dispatch_options(Options, Path).
  244
  245file_handler(Spec, Location, Options) -->
  246    { (   absolute_file_name(Spec, Path,
  247                             [ access(read),
  248                               file_errors(fail)
  249                             ])
  250      ->  true
  251      ;   Path = '<not found>'
  252      ),
  253      term_to_atom(Spec, SpecAtom),
  254      default_options([cache(true)], Options, Options1)
  255    },
  256    html([ p([ 'Location serves a plain file' ]),
  257           table(class(file_handler),
  258                 [ tr([th('File:'), td(a(href(Location), Path))]),
  259                   tr([th('Symbolic:'), td(SpecAtom)])
  260                 | \file_options(Options1)
  261                 ])
  262         ]).
  263
  264default_options([], Options, Options).
  265default_options([H|T], Options0, Options) :-
  266    functor(H, Name, 1),
  267    functor(Gen, Name, 1),
  268    (   option(Gen, Options0)
  269    ->  default_options(T, Options0, Options)
  270    ;   default_options(T, [H|Options0], Options)
  271    ).
  272
  273file_options([]) --> [].
  274file_options([H|T]) -->
  275    file_option(H),
  276    file_options(T).
  277
  278file_option(Name=Value) -->
  279    !,
  280    { Term =.. [Name, Value] },
  281    file_option(Term).
  282file_option(cache(true)) -->
  283    !,
  284    html(tr([ th('Cache:'),
  285              td(['Supports ', code('If-modified-since')])
  286            ])).
  287file_option(mime_type(Type)) -->
  288    !,
  289    html(tr([ th('Mime-type'), td(Type) ])).
  290file_option(_) -->
  291    [].
  292
  293%!  status(+How)//
  294%
  295%   Emit HTTP code and comment for status.
  296%
  297%   @tbd    Use a clean interface from http_header.
  298
  299status(How) -->
  300    { http_header:status_number(How, Code),
  301      phrase(http_header:status_comment(How), CommentCodes),
  302      atom_codes(Comment, CommentCodes)
  303    },
  304    html([Code, Comment]).
  305
  306
  307%!  predicate_help(+Request, +Closure)// is det.
  308%
  309%   Provide the help-page of the implementing predicate.
  310
  311predicate_help(Request, Closure) -->
  312    { resolve_location(Closure, Closure1),
  313      closure_pi(Closure1, PI),
  314      edit_options(Request, Options)
  315    },
  316    object_page(PI,
  317                [ header(false)
  318                | Options
  319                ]),
  320    !.
  321predicate_help(_Request, Closure) -->
  322    { closure_pi(Closure, PI) },
  323    html(p('The implementing predicate ~q is not documented'-[PI])).
  324
  325resolve_location(Closure, M:G) :-
  326    predicate_property(Closure, imported_from(M)),
  327    !,
  328    strip_module(Closure, _, G).
  329resolve_location(Closure, Closure).
  330
  331
  332%!  edit_options(+Request, -Options) is det.
  333%
  334%   Assume we can show and edit option if we are allowed to access
  335%   the HTTP location pldoc(edit).
  336
  337edit_options(Request, [edit(true)]) :-
  338    catch(http:authenticate(pldoc(edit), Request, _), _, fail),
  339    !.
  340edit_options(_, []).
  341
  342
  343%!  dispatch_options(+Options, +Path)// is det.
  344%
  345%   Describe the dispatching options
  346
  347dispatch_options([], _) -->
  348    [].
  349dispatch_options(List, Path) -->
  350    html([ h4('Notes'),
  351           ul(class(http_options),
  352              \dispatch_items(List, Path))
  353         ]).
  354
  355dispatch_items([], _) --> [].
  356dispatch_items([H|T], Path) -->
  357    dispatch_item(H, Path),
  358    dispatch_items(T, Path).
  359
  360
  361dispatch_item(prefix(true), Path) -->
  362    !,
  363    html(li(['Handler processes all paths that start with ', code(Path)])).
  364dispatch_item(Option, _) -->
  365    dispatch_item(Option),
  366    !.
  367
  368dispatch_item(authentication(_)) -->
  369    !,
  370    html(li('Request requires authentication')).
  371dispatch_item(time_limit(Limit)) -->
  372    !,
  373    (   { number(Limit) }
  374    ->  html(li('Server limits processing time to ~w seconds'-[Limit]))
  375    ;   []
  376    ).
  377dispatch_item(chunked) -->
  378    !,
  379    html(li('Reply uses HTTP chunked encoding if possible')).
  380dispatch_item(spawn(On)) -->
  381    !,
  382    (    {atom(On)}
  383    ->  html(li(['Requests are spawned on pool "', i(On), '"']))
  384    ;   html(li('Requests are spawned on a new thread'))
  385    ).
  386dispatch_item(_) -->
  387    [].
  388
  389
  390%!  parameter_table(+Params)// is det.
  391%
  392%   Provide help on the parameters
  393
  394parameter_table([]) -->
  395    !,
  396    html(p(class(http_parameters),
  397           'Request does not handle parameters')).
  398parameter_table(Params) -->
  399    html([ table(class(http_parameters),
  400                 [ tr([th('Name'), th('Type'), th('Default'), th('Description')])
  401                 | \parameters(Params, 1)
  402                 ])
  403         ]).
  404
  405parameters([], _) --> [].
  406parameters([group(Members, Options)|T], _N) -->
  407    !,
  408    html(tr(class(group),
  409            [ th(colspan(4), \group_title(Options))
  410            ])),
  411    parameters(Members, 0),
  412                                    % typically, this should be
  413                                    % a group again
  414    parameters(T, 0).
  415parameters([H|T], N) -->
  416    { N1 is N + 1,
  417      (   N mod 2 =:= 0
  418      ->  Class = even
  419      ;   Class = odd
  420      )
  421    },
  422    parameter(H, Class),
  423    parameters(T, N1).
  424
  425parameter(param(Name, Options), Class) -->
  426    html(tr(class(Class),
  427            [ td(class(name), Name),
  428              td(\param_type(Options)),
  429              td(\param_default(Options)),
  430              td(\param_description(Options))
  431            ])).
  432
  433group_title(Options) -->
  434    { option(description(Title), Options)
  435    },
  436    !,
  437    html(Title).
  438group_title(Options) -->
  439    { option(generated(Pred), Options),
  440      !,
  441      (   doc_comment(Pred, _Pos, Summary0, _Comment)
  442      ->  (   atom_concat(Summary, '.', Summary0)
  443          ->  true
  444          ;   Summary = Summary0
  445          )
  446      ;   format(string(Summary), 'Parameter group generated by ~q', [Pred])
  447      )
  448    },
  449    html(Summary).
  450group_title(_) -->
  451    html('Parameter group').
  452
  453%!  param_type(+Options)// is det.
  454%
  455%   Emit a description of the type in HTML.
  456
  457param_type(Options) -->
  458    { select(list(Type), Options, Rest) },
  459    !,
  460    param_type([Type|Rest]).
  461param_type(Options) -->
  462    { type_term(Type),
  463      memberchk(Type, Options), !
  464    },
  465    type(Type).
  466param_type(_) -->
  467    html(string).
  468
  469type((T1;T2)) -->
  470    !,
  471    type(T1),
  472    breaking_bar,
  473    type(T2).
  474type(between(L,H)) -->
  475    !,
  476    html('number in [~w..~w]'-[L,H]).
  477type(oneof(Set)) -->
  478    !,
  479    html(code(\set(Set))).
  480type(length > N) -->
  481    !,
  482    html('string(>~w chars)'-[N]).
  483type(length >= N) -->
  484    !,
  485    html('string(>=~w chars)'-[N]).
  486type(length > N) -->
  487    !,
  488    html('string(<~w chars)'-[N]).
  489type(length =< N) -->
  490    !,
  491    html('string(=<~w chars)'-[N]).
  492type(nonneg) -->
  493    !,
  494    html('integer in [0..)').
  495type(uri) -->
  496    !,
  497    html(['URI', \breaking_bar, 'NS:Local']).
  498type(X) -->
  499    { term_to_atom(X, A) },
  500    html(A).
  501
  502set([]) --> [].
  503set([H|T]) -->
  504    html(H),
  505    (   { T == [] }
  506    ->  []
  507    ;   breaking_bar,
  508        set(T)
  509    ).
  510
  511%!  breaking_bar// is det.
  512%
  513%   Emits | followed by a  zero-width   white-space  that allows the
  514%   browser to insert a linebreak here.
  515
  516breaking_bar -->
  517    html(['|', &('#8203')]).
  518
  519%!  type_term(-Term) is nondet.
  520%
  521%   Enumerate the option-terms that are interpreted as types.
  522%
  523%   @tbd    provide a public interface from http_parameters.pl
  524
  525type_term(Term) :-
  526    clause(http_parameters:check_type3(Term, _, _), _),
  527    nonvar(Term).
  528type_term(Term) :-
  529    clause(http:convert_parameter(Term, _, _), _).
  530type_term(Term) :-
  531    clause(http_parameters:check_type2(Term, _), _),
  532    nonvar(Term).
  533
  534param_default(Options) -->
  535    { memberchk(default(Value), Options), !
  536    },
  537    html(code('~w'-[Value])).
  538param_default(Options) -->
  539    { option(optional(true), Options) },
  540    !,
  541    html(i(optional)).
  542param_default(Options) -->
  543    { memberchk(zero_or_more, Options)
  544    ; memberchk(list(_Type), Options)
  545    },
  546    !,
  547    html(i(multiple)).
  548param_default(_Options) -->
  549    html(i(required)).
  550
  551param_description(Options) -->
  552    { option(description(Text), Options) },
  553    !,
  554    html(Text).
  555param_description(_) --> [].
  556
  557
  558%!  extracted_parameters(+Closure, -Declarations)
  559%
  560%   Return a completely  qualified  list   of  parameters  that  are
  561%   retrieved by calling Closure.
  562
  563extracted_parameters(Closure, Declarations) :-
  564    calls(Closure, 5, Goals),
  565    closure_last_arg(Closure, Request),
  566    phrase(param_decls(Goals, Request), Declarations0),
  567    list_to_set(Declarations0, Declarations).
  568
  569param_decls([], _) -->
  570    [].
  571param_decls([H|T], Request) -->
  572    param_decl(H, Request),
  573    param_decls(T, Request).
  574
  575param_decl(Var, _) -->
  576    { var(Var) },
  577    !.
  578param_decl(M:http_parameters(Rq, Decls), Request) -->
  579    !,
  580    param_decl(M:http_parameters(Rq, Decls, []), Request).
  581param_decl(M:http_parameters(Rq, Decls, Options), Request) -->
  582    { ignore(Rq == Request),
  583      !,
  584      decl_goal(Options, M, Decl)
  585    },
  586    params(Decls, Decl).
  587param_decl(_, _) -->
  588    [].
  589
  590decl_goal(Options, M, Module:Goal) :-
  591    option(attribute_declarations(G), Options),
  592    !,
  593    strip_module(M:G, Module, Goal).
  594decl_goal(_, _, -).
  595
  596:- meta_predicate
  597    params(+, 2, ?, ?),
  598    param(+, 2, ?, ?).  599
  600params(V, _) -->
  601    { var(V) },
  602    !.
  603params([], _) -->
  604    [].
  605params([H|T], Decl) -->
  606    param(H, Decl),
  607    params(T, Decl).
  608
  609param(Term, _) -->
  610    { \+ compound(Term) },
  611    !.
  612param(group(Params0, Options), Decl) -->
  613    !,
  614    { phrase(params(Params0, Decl), GroupedParams) },
  615    [ group(GroupedParams, Options) ].
  616param(Term, _) -->
  617    { Term =.. [Name, _Value, Options] },
  618    !,
  619    [ param(Name, Options) ].
  620param(Term, Decl) -->
  621    { Term =.. [Name, _Value],
  622      catch(call(Decl, Name, Options), _, fail), !
  623    },
  624    [ param(Name, Options) ].
  625param(_, _) -->
  626    [].
  627
  628                 /*******************************
  629                 *        CLOSURE LOGIC         *
  630                 *******************************/
  631
  632%!  extend_closure(:In, +Extra, -Out) is det.
  633%
  634%   Extend a possibly qualified closure with arguments from Extra.
  635
  636extend_closure(Var, _, _) :-
  637    var(Var), !, fail.
  638extend_closure(M:C0, Extra, M:C) :-
  639    !,
  640    extend_closure(C0, Extra, C).
  641extend_closure(C0, Extra, C) :-
  642    C0 =.. L0,
  643    append(L0, Extra, L),
  644    C =.. L.
  645
  646closure_pi(M:C, M:Name/Arity) :-
  647    !,
  648    functor(C, Name, Arity).
  649closure_pi(C, Name/Arity) :-
  650    functor(C, Name, Arity).
  651
  652closure_last_arg(C, _) :-
  653    var(C),
  654    !,
  655    instantiation_error(C).
  656closure_last_arg(_:C, Last) :-
  657    !,
  658    closure_last_arg(C, Last).
  659closure_last_arg(C, Last) :-
  660    functor(C, _, Arity),
  661    arg(Arity, C, Last).
  662
  663
  664                 /*******************************
  665                 *      CALL-TREE ANALYSIS      *
  666                 *******************************/
  667
  668%!  calls(:Goal, +MaxDepth, -Called) is det.
  669%
  670%   Called is the list of goals called by Goal obtained by unfolding
  671%   the call-tree upto the given MaxDepth.
  672%
  673%   @tbd    Without MaxDepth not all programs terminate.  Why?
  674
  675:- meta_predicate
  676    calls(:, +, -).  677
  678calls(M:Goal, Depth, SubGoals) :-
  679    phrase(calls(Goal, M, Depth, SubGoals0), SubGoals0),
  680    !,
  681    maplist(unqualify, SubGoals0, SubGoals).
  682
  683unqualify(Var, Var) :-
  684    var(Var),
  685    !.
  686unqualify(S:G, G) :-
  687    S == system,
  688    !.
  689unqualify(S:G, G) :-
  690    predicate_property(S:G, imported_from(system)),
  691    !.
  692unqualify(G, G).
  693
  694calls(_, _, 0, _) --> !.
  695calls(Var, _, _, _) -->
  696    { var(Var), ! },
  697    [ Var ].
  698calls(Goal, M, _, Done) -->
  699    { seen_goal(M:Goal, Done) },
  700    !.
  701calls(M:G, _, D, Done) -->
  702    !,
  703    calls(G, M, D, Done).
  704calls(Control, M, Depth, Done) -->
  705    { control(Control, Members)
  706    },
  707    !,
  708    bodies(Members, M, Depth, Done).
  709calls(Goal, M, _, _) -->
  710    { evaluate_now(M:Goal),
  711      !,
  712      ignore(catch(M:Goal, _, fail))
  713    },
  714    [].
  715calls(Goal, M, _, _) -->
  716    { primitive(M:Goal) },
  717    !,
  718    [ M:Goal ].
  719calls(Goal, M, Depth, Done) -->
  720    { term_variables(Goal, Vars),
  721      Key =.. [v|Vars],
  722      '$define_predicate'(M:Goal),  % auto-import if needed
  723      def_module(M:Goal, DefM),
  724      qualify_goal(DefM:Goal, M, QGoal),
  725      catch(findall(Key-Body, clause(QGoal, Body), Pairs), _, fail),
  726      SubDepth is Depth - 1
  727    },
  728    [ M:Goal ],
  729    vars_bodies(Pairs, DefM, SubDepth, Done),
  730    { bind_vars(Key, Pairs) }.
  731
  732def_module(Callable, M) :-
  733    predicate_property(Callable, imported_from(M)),
  734    !.
  735def_module(Callable, M) :-
  736    strip_module(Callable, M, _).
  737
  738qualify_goal(M:G, Ctx, M:QG) :-
  739    predicate_property(G, meta_predicate(Meta)),
  740    !,
  741    functor(Meta, Name, Arity),
  742    functor(G, Name, Arity),
  743    functor(QG, Name, Arity),
  744    qualify_args(1, Arity, Ctx, Meta, G, QG).
  745qualify_goal(G, _, G).
  746
  747qualify_args(I, Arity, Ctx, Meta, G, QG) :-
  748    I =< Arity,
  749    !,
  750    arg(I, Meta, MA),
  751    arg(I, G, GA),
  752    (   ismeta(MA),
  753        \+ isqual(GA)
  754    ->  arg(I, QG, Ctx:GA)
  755    ;   arg(I, QG, GA)
  756    ),
  757    I2 is I+1,
  758    qualify_args(I2, Arity, Ctx, Meta, G, QG).
  759qualify_args(_, _, _, _, _, _).
  760
  761ismeta(:).
  762ismeta(I) :- integer(I).
  763
  764isqual(M:_) :-
  765    atom(M).
  766
  767vars_bodies([], _, _, _) --> [].
  768vars_bodies([_-Body|T], M, Depth, Done) -->
  769    calls(Body, M, Depth, Done),
  770    vars_bodies(T, M, Depth, Done).
  771
  772bodies([], _, _, _) --> [].
  773bodies([H|T], M, Depth, Done) -->
  774    calls(H, M, Depth, Done),
  775    bodies(T, M, Depth, Done).
  776
  777%!  bind_vars(+Key, +Pairs) is det.
  778%
  779%   Pairs  contains  the  variable  bindings    after  scanning  the
  780%   alternative computation paths. Key are   the  initial variables.
  781%
  782%   @tbd What we should do  is  find   all  bindings  for a specific
  783%   variable, compute the most specific   generalization of this set
  784%   and unify it with the variable in Key.   For now, we only try to
  785%   unify all of them with the  input variable. That deals correctly
  786%   with the case  where  no  path   binds  the  variable  (this  is
  787%   typically the case for input variables   and that is our biggest
  788%   concern at the moment).
  789
  790bind_vars(Key, Pairs) :-
  791    functor(Key, _, Arity),
  792    bind_vars(1, Arity, Key, Pairs).
  793
  794bind_vars(I, Arity, Key, Pairs) :-
  795    I =< Arity,
  796    !,
  797    arg(I, Key, V),
  798    maplist(pair_arg(I), Pairs, Vars),
  799    ignore(maplist(=(V), Vars)).
  800bind_vars(_, _, _, _).
  801
  802pair_arg(I, Key-_, V) :-
  803    arg(I, Key, V).
  804
  805control((A,B), [A,B]).
  806control((A;B), [A,B]).
  807control((A->B), [A,B]).
  808control((A*->B), [A,B]).
  809control(call(G, A1), [Goal]) :-
  810    extend_closure(G, [A1], Goal).
  811control(call(G, A1, A2), [Goal]) :-
  812    extend_closure(G, [A1, A2], Goal).
  813control(call(G, A1, A2, A3), [Goal]) :-
  814    extend_closure(G, [A1, A2, A3], Goal).
  815control(call(G, A1, A2, A3, A4), [Goal]) :-
  816    extend_closure(G, [A1, A2, A3, A4], Goal).
  817
  818primitive(_:Goal) :-
  819    functor(Goal, Name, Arity),
  820    current_predicate(system:Name/Arity),
  821    !.
  822primitive(Goal) :-
  823    \+ predicate_property(Goal, interpreted).
  824
  825seen_goal(Goal, Done) :-
  826    member_open_list(X, Done),
  827    variant(X, Goal),
  828    !.
  829
  830member_open_list(_, List) :-
  831    var(List), !, fail.
  832member_open_list(X, [X|_]).
  833member_open_list(X, [_|T]) :-
  834    member_open_list(X, T).
  835
  836%!  evaluate_now(:Goal) is semidet.
  837%
  838%   If =true=, call Goal and  propagate   bindings  that it produces
  839%   instead of unfolding its call-tree. This  was introduced to deal
  840%   with  extracted_parameters/2,  which    dynamically   constructs
  841%   option-lists for http_parameters/3.
  842%
  843%   @see The hook evaluate/1 extends the definition
  844
  845%!  evaluate(:Goal) is semidet.
  846%
  847%   Multifile hook to  extend  the  goals   that  are  evaluated  by
  848%   evaluate_now/1.
  849
  850:- multifile
  851    evaluate/1.  852
  853evaluate_now(Var) :-
  854    var(Var), !, fail.
  855evaluate_now(Goal) :-
  856    evaluate(Goal),
  857    !.
  858evaluate_now(_:Goal) :-
  859    evaluate_now(Goal).
  860evaluate_now(_ = _).
  861evaluate_now(_ is _).
  862evaluate_now(append(L1,L2,_)) :-
  863    is_list(L1),
  864    is_list(L2).
  865evaluate_now(append(L1,_)) :-
  866    is_list(L1),
  867    maplist(is_list, L1).
  868
  869
  870                 /*******************************
  871                 *         AUTOCOMPLETE         *
  872                 *******************************/
  873
  874max_results_displayed(50).
  875
  876quick_find_div_content -->
  877    html([ span(id(qf_label), 'Quick find:'),
  878           \autocomplete_finder,
  879           input([ value('Show'), type(submit),
  880                   onClick('showLocation();')
  881                 ]),
  882           script(type('text/javascript'),
  883                  [ 'function showLocation()\n',
  884                    '{ helpHTTP(document.getElementById("ac_location_input").value);\n',
  885                    '}'
  886                  ])
  887         ]).
  888
  889autocomplete_finder -->
  890    { max_results_displayed(Max)
  891    },
  892    autocomplete(ac_location,
  893                 [ query_delay(0.2),
  894                   auto_highlight(false),
  895                   max_results_displayed(Max),
  896                   width('40ex')
  897                 ]).
  898
  899%!  autocomplete(+HandlerID, +Options)// is det.
  900%
  901%   Insert a YUI autocomplete widget that obtains its alternatives
  902%   from HandlerID.  The following Options are supported:
  903%
  904%       * width(+Width)
  905%       Specify the width of the box.  Width must satisfy the CSS
  906%       length syntax.
  907%
  908%       * query_delay(+Seconds)
  909%       Wait until no more keys are typed for Seconds before sending
  910%       the query to the server.
  911
  912autocomplete(Handler, Options) -->
  913    { http_location_by_id(Handler, Path),
  914      atom_concat(Handler, '_complete', CompleteID),
  915      atom_concat(Handler, '_input', InputID),
  916      atom_concat(Handler, '_container', ContainerID),
  917      select_option(width(Width), Options, Options1, '25em'),
  918      select_option(name(Name), Options1, Options2, predicate),
  919      select_option(value(Value), Options2, Options3, '')
  920    },
  921    html([ \html_requires(yui('autocomplete/autocomplete.js')),
  922           \html_requires(yui('autocomplete/assets/skins/sam/autocomplete.css')),
  923           div(id(CompleteID),
  924               [ input([ id(InputID),
  925                         name(Name),
  926                         value(Value),
  927                         type(text)
  928                       ]),
  929                 div(id(ContainerID), [])
  930               ]),
  931           style(type('text/css'),
  932                 [ '#', CompleteID, '\n',
  933                   '{ width:~w; padding-bottom:0em; display:inline-block; vertical-align:top}'-[Width]
  934                 ]),
  935           \autocomplete_script(Path, InputID, ContainerID, Options3)
  936         ]).
  937
  938autocomplete_script(HandlerID, Input, Container, Options) -->
  939    { http_absolute_location(HandlerID, Path, [])
  940    },
  941    html(script(type('text/javascript'), \[
  942'{ \n',
  943'  var oDS = new YAHOO.util.XHRDataSource("~w");\n'-[Path],
  944'  oDS.responseType = YAHOO.util.XHRDataSource.TYPE_JSON;\n',
  945'  oDS.responseSchema = { resultsList:"results",
  946\t\t\t  fields:["label","location"]
  947\t\t\t};\n',
  948'  oDS.maxCacheEntries = 5;\n',
  949'  var oAC = new YAHOO.widget.AutoComplete("~w", "~w", oDS);\n'-[Input, Container],
  950'  oAC.resultTypeList = false;\n',
  951'  oAC.formatResult = function(oResultData, sQuery, sResultMatch) {
  952     var into = "<span class=\\"acmatch\\">"+sQuery+"</span>";
  953     var sLabel = oResultData.label.replace(sQuery, into);
  954     return sLabel;
  955   };\n',
  956'  oAC.itemSelectEvent.subscribe(function(sType, aArgs) {
  957     var oData = aArgs[2];
  958     helpHTTP(oData.location);
  959   });\n',
  960\ac_options(Options),
  961'}\n'
  962                                         ])).
  963ac_options([]) -->
  964    [].
  965ac_options([H|T]) -->
  966    ac_option(H),
  967    ac_options(T).
  968
  969ac_option(query_delay(Time)) -->
  970    !,
  971    html([ '  oAC.queryDelay = ~w;\n'-[Time] ]).
  972ac_option(auto_highlight(Bool)) -->
  973    !,
  974    html([ '  oAC.autoHighlight = ~w;\n'-[Bool] ]).
  975ac_option(max_results_displayed(Max)) -->
  976    html([ '  oAC.maxResultsDisplayed = ~w;\n'-[Max] ]).
  977ac_option(O) -->
  978    { domain_error(yui_autocomplete_option, O) }.
  979
  980%!  ac_location(+Request)
  981%
  982%   HTTP handler to for autocompletion on HTTP handlers.
  983
  984ac_location(Request) :-
  985    max_results_displayed(DefMax),
  986    http_parameters(Request,
  987                    [ query(Query, [ description('String to find in HTTP path') ]),
  988                      maxResultsDisplayed(Max,
  989                                          [ integer, default(DefMax),
  990                                            description('Max number of results returned')
  991                                          ])
  992                    ]),
  993    autocompletions(Query, Max, Count, Completions),
  994    reply_json(json([ query = json([ count=Count
  995                                   ]),
  996                      results = Completions
  997                    ])).
  998
  999autocompletions(Query, Max, Count, Completions) :-
 1000    findall(C, ac_object(Query, C), Completions0),
 1001    sort(Completions0, Completions1),
 1002    length(Completions1, Count),
 1003    first_n(Max, Completions1, Completions2),
 1004    maplist(obj_result, Completions2, Completions).
 1005
 1006obj_result(Location, json([ label=Location,
 1007                            location=Location
 1008                          ])).
 1009
 1010first_n(0, _, []) :- !.
 1011first_n(_, [], []) :- !.
 1012first_n(N, [H|T0], [H|T]) :-
 1013    N2 is N - 1,
 1014    first_n(N2, T0, T).
 1015
 1016ac_object(Query, Location) :-
 1017    http_current_handler(Location, _:_Handler, _Options),
 1018    sub_atom(Location, _, _, _, Query)