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)  2006-2015, University of 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(pldoc_search,
   36          [ search_form//1,             % +Options, //
   37            search_reply//2,            % +Search, +Options, //
   38            matching_object_table//2    % +Objects, +Options, //
   39          ]).   40:- use_module(library(http/html_write)).   41:- use_module(library(http/html_head)).   42:- use_module(library(dcg/basics)).   43:- use_module(library(occurs)).   44:- use_module(library(option)).   45:- use_module(library(pairs)).   46:- use_module(doc_process).   47:- use_module(doc_html).   48:- use_module(doc_index).   49:- use_module(doc_util).   50:- include(hooks).

Search form and reply

To be done
- Advanced search field
  • Limit to a directory
  • Whole-word search

*/

   60:- predicate_options(search_form//1, 1,
   61                     [ for(atom),
   62                       search_in(oneof([all,noapp,app,man])),
   63                       search_match(oneof([name,summary])),
   64                       search_options(boolean)
   65                     ]).   66:- predicate_options(search_reply//2, 2,
   67                     [ resultFormat(oneof([summary,long])),
   68                       search_in(oneof([all,noapp,app,man])),
   69                       search_match(oneof([name,summary])),
   70                       header(boolean),
   71                       edit(boolean),
   72                       pass_to(pldoc_index:doc_links//2, 2)
   73                     ]).
 search_form(+Options)//
Create a search input field. The input field points to /search?for=String on the current server. Options:
   82search_form(Options) -->
   83    { (   option(for(Value), Options)
   84      ->  Extra = [value(Value)]
   85      ;   Extra = []
   86      ),
   87      option(search_in(In), Options, all),
   88      option(search_match(Match), Options, summary)
   89    },
   90    html(form([ id('search-form'),
   91                action(location_by_id(pldoc_search))
   92              ],
   93              [ div([ \search_field([ name(for),
   94                                      id(for)
   95                                    | Extra
   96                                    ])
   97                    ]),
   98                \search_options(In, Match, Options)
   99              ])).
  100
  101search_options(In, Match, Options) -->
  102    { option(search_options(false), Options) },
  103    !,
  104    hidden(in, In),
  105    hidden(match, Match).
  106search_options(In, Match, _Options) -->
  107    html(div(class('search-options'),
  108             [ span(class('search-in'),
  109                    [ \radio(in, all, 'All', In),
  110                      \radio(in, app, 'Application', In),
  111                      \radio(in, man, 'Manual', In)
  112                    ]),
  113               span(class('search-match'),
  114                    [ \radio(match, name, 'Name', Match),
  115                      \radio(match, summary, 'Summary', Match)
  116                    ]),
  117               span(class('search-help'),
  118                    [ a(href(location_by_id(pldoc_package)+'pldoc.html#sec:browser'),
  119                        'Help')
  120                    ])
  121             ])).
 search_field(+Options)// is det
Hookable predicate to display the search field. Hookability is provided to experiment with auto-completion outside this package.
  130search_field(Options) -->
  131    prolog:doc_search_field(Options),
  132    !.
  133search_field(Options) -->
  134    html([ input(Options, []),
  135           input([ id('submit-for'),
  136                   type(submit),
  137                   value('Search')
  138                 ])
  139         ]).
  140
  141radio(Radio, Field, Label, In) -->
  142    {   Field == In
  143    ->  Extra = [checked]
  144    ;   Extra = []
  145    },
  146    html([ input([ type(radio),
  147                   name(Radio),
  148                   value(Field)
  149                 | Extra
  150                 ]),
  151           Label
  152         ]).
  153
  154hidden(Name, Value) -->
  155    html(input([type(hidden), name(Name), value(Value)])).
 search_reply(+For, +Options)// is det
Generate a reply searching for For. Options include
resultFormat(Format)
If summary (default), produce a summary-table. If long, produce full object descriptions.
search_in(In)
Determine which databases to search. One of all, app, man
search_match(Match)
What part of the object to match. One of name, summary
header(+Boolean)
If false, suppress the header.
  176:- html_meta
  177    search_header(+, html, +, ?, ?).  178
  179search_reply(For, Options) -->
  180    { var(For) ; For == '' },
  181    !,
  182    search_header('', 'Using PlDoc search', Options),
  183    html([ ul( class('search-help'),
  184               [ li([ 'If you pause typing, the search box will display ',
  185                      'an auto completion list.  Selecting an object jumps ',
  186                      'immediately to the corresponding documentation.'
  187                    ]),
  188                 li([ 'Searching for ', i('Name/Arity'), ', ',
  189                      i('Name//Arity'), ', ', i('Name'), ' or ',
  190                      i('C-function()'), ' ensures that ',
  191                      'matching definitions appear first in the search ',
  192                      'results'
  193                    ]),
  194                 li([ 'Other searches search through the name and summary ',
  195                      'descriptions in the manual.'
  196                    ])
  197               ])
  198         ]).
  199search_reply(For, Options) -->
  200    { search_doc(For, PerCategory, Options),
  201      PerCategory \== [],
  202      option(resultFormat(Format), Options, summary)
  203    },
  204    !,
  205    search_header(For, [ 'Search results for ',
  206                         span(class(for), ['"', For, '"'])
  207                       ],
  208                  Options),
  209    indexed_matches(Format, PerCategory, Options).
  210search_reply(For, Options) -->
  211    search_header(For, 'No matches', Options).
  212
  213
  214search_header(_For, _Title, Options) -->
  215    { option(header(false), Options) },
  216    !,
  217    html_requires(pldoc).
  218search_header(For, Title, Options) -->
  219    html_requires(pldoc),
  220    doc_links('', [for(For)|Options]),
  221    html(h1(class('search-results'), Title)).
 matching_object_table(+Objects, +Options)// is det
Show a list of matching objects, similar to a result-set from search.
  228matching_object_table(Objects, Options) -->
  229    { maplist(obj_cat_sec, Objects, Pairs),
  230      group_hits(Pairs, Organized),
  231      option(format(Format), Options, summary)
  232    },
  233    indexed_matches(Format, Organized, Options).
  234
  235obj_cat_sec(Object, Cat-(Section-Object)) :-
  236    prolog:doc_object_summary(Object, Cat, Section, _Summary).
  237
  238
  239indexed_matches(Format, PerCategory, Options) -->
  240    { count_matches(PerCategory, Matches)
  241    },
  242    html([ div(class('search-counts'),
  243               [ Matches, ' matches; ',
  244                 \count_by_category(PerCategory)
  245               ])
  246         | \matches(Format, PerCategory, Options)
  247         ]).
  248
  249count_by_category([]) -->
  250    [].
  251count_by_category([Cat-PerFile|T]) -->
  252    { count_category(PerFile, Count),
  253      atom_concat(#, Cat, HREF)
  254    },
  255    html([ a(href(HREF), \category_title(Cat)),
  256           ': ',
  257           Count
  258         ]),
  259    (   {T == []}
  260    ->  []
  261    ;   html(', '),
  262        count_by_category(T)
  263    ).
  264
  265count_matches([], 0).
  266count_matches([_-Cat|T], Count) :-
  267    count_matches(T, Count0),
  268    count_category(Cat, N),
  269    Count is Count0 + N.
  270
  271count_category([], 0).
  272count_category([_-Objs|T], Count) :-
  273    count_category(T, Count0),
  274    length(Objs, N),
  275    Count is Count0 + N.
 matches(+Format, +PerCategory, +Options)// is det
Display search matches according to Format.
Arguments:
PerCategory- List of File-Objects
  283matches(long, PerCategory, Options) -->
  284    long_matches_by_type(PerCategory, Options).
  285matches(summary, PerCategory, Options) -->
  286    html(table(class(summary),
  287               \short_matches_by_type(PerCategory, 1, Options))).
  288
  289
  290long_matches_by_type([], _) -->
  291    [].
  292long_matches_by_type([Category-PerFile|T], Options) -->
  293    category_header(Category, Options),
  294    long_matches(PerFile, Options),
  295    long_matches_by_type(T, Options).
  296
  297
  298long_matches([], _) -->
  299    [].
  300long_matches([File-Objs|T], Options) -->
  301    file_header(File, Options),
  302    objects(Objs, Options),
  303    long_matches(T, Options).
  304
  305category_header(Category, _Options) -->
  306    html(h1(class(category), \category_title(Category))).
  307
  308short_matches_by_type([], _, _) -->
  309    [].
  310short_matches_by_type([Category-PerFile|T], Nth, Options) -->
  311    category_index_header(Category, Nth, Options),
  312    short_matches(PerFile, Options),
  313    { succ(Nth, Nth1) },
  314    short_matches_by_type(T, Nth1, Options).
  315
  316short_matches([], _) -->
  317    [].
  318short_matches([File-Objs|T], Options) -->
  319    file_index_header(File, Options),
  320    object_summaries(Objs, File, Options),
  321    short_matches(T, Options).
  322
  323
  324category_index_header(Category, Nth, _Options) -->
  325    (   { Nth > 1 }
  326    ->  category_sep('category-top-sep')
  327    ;   []
  328    ),
  329    html(tr(th([class(category), colspan(3)],
  330               a(name(Category), \category_title(Category))))),
  331    category_sep('category-bottom-sep').
  332
  333category_sep(Which) -->
  334    html(tr(th([class(Which), colspan(3)],
  335               &(nbsp)))).
  336
  337
  338category_title(Category) -->
  339    {   prolog:doc_category(Category, _Order, Title)
  340    ->  true
  341    ;   Title = Category
  342    },
  343    html(Title).
 search_doc(+SearchString, -PerType:list, +Options) is det
Return matches of SearchString as Type-PerFile tuples, where PerFile is a list File-ListOfObjects.
  350search_doc(Search, PerType, Options) :-
  351    findall(Tuples, matching_object(Search, Tuples, Options), Tuples0),
  352    sort(Tuples0, Tuples),
  353    group_hits(Tuples, PerType).
  354
  355group_hits(Tuples, PerType) :-
  356    group_pairs_by_key(Tuples, PerCat0),
  357    key_sort_order(PerCat0, PerCat1),
  358    keysort(PerCat1, PerCat2),
  359    pairs_values(PerCat2, PerCat),
  360    group_by_file(PerCat, PerType).
  361
  362key_sort_order([], []).
  363key_sort_order([Cat-ByCat|T0], [Order-(Cat-ByCat)|T]) :-
  364    (   prolog:doc_category(Cat, Order, _Title)
  365    ->  true
  366    ;   Order = 99
  367    ),
  368    key_sort_order(T0, T).
  369
  370
  371group_by_file([], []).
  372group_by_file([Type-Tuples0|T0], [Type-ByFile|T]) :-
  373    keysort(Tuples0, Tuples),
  374    group_pairs_by_key(Tuples, ByFile),
  375    group_by_file(T0, T).
 matching_object(+SearchString, -Object, +Options) is nondet
Object matches SearchString. Options include
search_in(In)
One of all, app, man.
search_match(Match)
One of name, summary
Arguments:
Object- Term of the form File-Item
To be done
- Deal with search syntax
  391matching_object(Search, Type-(Section-Obj), Options) :-
  392    atom_concat(Function, '()', Search),
  393    Obj = c(Function),
  394    option(search_in(In), Options, all),
  395    prolog:doc_object_summary(Obj, Type, Section, _),
  396    matching_category(In, Type).
  397matching_object(Search, Type-(Section-Obj), Options) :-
  398    (   atom_pi(Search, Obj0),
  399        qualify(Obj0, Obj)
  400    ;   catch(atom_to_term(Search, Obj, _), _, fail)
  401    ),
  402    nonvar(Obj),
  403    option(search_in(In), Options, all),
  404    prolog:doc_object_summary(Obj, Type, Section, _),
  405    matching_category(In, Type).
  406matching_object(Search, Match, Options) :-
  407    atom_length(Search, Len), Len > 1,
  408    atom_codes(Search, Codes),
  409    phrase(search_spec(For0), Codes),
  410    (   For0 = not(_)
  411    ->  throw(error(bad_search(only_not), _))
  412    ;   optimise_search(For0, For),
  413        exec_search(For, Match, Options)
  414    ).
  415
  416qualify(Obj0, Obj) :-
  417    Obj0 = _:_,
  418    !,
  419    Obj = Obj0.
  420qualify(Obj, _:Obj).
 optimise_search(+Spec, -Optimised)
Optimise a search specification. Currently only deals with the simple case of first searching for a negation and then a positive term.
  429optimise_search(and(not(A0), B0), and(B, not(A))) :-
  430    !,
  431    optimise_search(A0, A),
  432    optimise_search(B0, B).
  433optimise_search(A, A).
 exec_search(+Spec, -Match, +Options) is nondet
Spec is one of
and(Spec, Spec)
Intersection of the specification
not(Spec)
Negation of the specification
  446exec_search(and(A, B), Match, Options) :-
  447    !,
  448    exec_search(A, Match, Options),
  449    exec_search(B, Match, Options).
  450exec_search(Search, Type-(Section-Obj), Options) :-
  451    option(search_in(In), Options, all),
  452    option(search_match(Match), Options, summary),
  453    prolog:doc_object_summary(Obj, Type, Section, Summary),
  454    matching_category(In, Type),
  455    (   Search = not(For)
  456    ->  \+ (   Match == summary,
  457               apropos_match(For, Summary)
  458           ->  true
  459           ;   sub_term(S, Obj),
  460               atom(S),
  461               apropos_match(For, S)
  462           )
  463    ;   (   Match == summary,
  464            apropos_match(Search, Summary)
  465        ->  true
  466        ;   sub_term(S, Obj),
  467            atom(S),
  468            apropos_match(Search, S)
  469        )
  470    ).
  471
  472
  473matching_category(all, _).
  474matching_category(noapp, Category) :-
  475    !,
  476    Category \== application.
  477matching_category(app, application).
  478matching_category(man, manual).
 search_spec(-Search)// is det
Break a search string from the user into a logical expression.
  484search_spec(Spec) -->
  485    blanks,
  486    prim_search_spec(A),
  487    blanks,
  488    (   eos
  489    ->  { Spec = A }
  490    ;   search_spec(B)
  491    ->  { Spec = and(A,B) }
  492    ).
  493
  494prim_search_spec(Quoted) -->
  495    "\"", string(Codes), "\"",
  496    !,
  497    { atom_codes(Quoted, Codes)
  498    }.
  499prim_search_spec(Spec) -->
  500    nonblanks(Codes),
  501    {   Codes = [0'-,C0|Rest],
  502        code_type(C0, csym)
  503    ->  atom_codes(Word, [C0|Rest]),
  504        Spec = not(Word)
  505    ;   Codes \== [],
  506        atom_codes(Spec, Codes)
  507    }.
 object_summary(?Object, ?Category, ?Section, ?Summary) is nondet
True if Object is summarised by Summary. This multifile predicate can be extended with other search mechanisms. The returned objects must be handled by object_summaries//2 and objects//2.
Arguments:
Category- Atom describing the source.
Section- Reference to the context of Object.
  520prolog:doc_object_summary(Obj, Category, File, Summary) :-
  521    once(prolog_object(Obj)),
  522    current_prolog_flag(home, SWI),
  523    doc_comment(Obj0, File:_Line, Summary, _Comment),
  524    (   is_list(Obj0)
  525    ->  member(Obj, Obj0)
  526    ;   Obj = Obj0
  527    ),
  528    Obj \= _:module(_Title),                % HACK.  See ref_object//1
  529    (   sub_atom(File, 0, _, _, SWI)
  530    ->  Category = library
  531    ;   Category = application
  532    ).
  533
  534prolog_object(Var) :- var(Var), !.
  535prolog_object(_/_).
  536prolog_object(_//_).
  537prolog_object(_:_/_).
  538prolog_object(_:_//_).
  539prolog_object(module(_)).
 doc_category(Name, SortOrder, Description) is nondet
Describe the various categories of search results. Used to create the category headers as well as the advanced search dialog.
Arguments:
SortOrder- Ranges 0..100. Lower values come first
  550prolog:doc_category(application, 20, 'Application').
  551prolog:doc_category(library,     80, 'System Libraries').
  552
  553
  554                 /*******************************
  555                 *             UTIL             *
  556                 *******************************/
 apropos_match(+Needle, +Haystick) is semidet
True if Needle can be found as a case-insensitive substring in Haystick.
  563apropos_match(Needle, Haystack) :-
  564    sub_atom_icasechk(Haystack, _, Needle)