36
37:- module(pldoc_search,
38 [ search_form//1, 39 search_reply//2, 40 matching_object_table//2 41 ]). 42:- use_module(library(http/html_write)). 43:- use_module(library(http/html_head)). 44:- use_module(library(dcg/basics)). 45:- use_module(library(option)). 46:- use_module(library(pairs)). 47:- use_module(library(uri)). 48:- use_module(library(debug)). 49:- use_module(library(apply)). 50:- use_module(library(lists)). 51:- use_module(library(atom)). 52:- use_module(library(porter_stem)). 53
54:- use_module(doc_process). 55:- use_module(doc_html). 56:- use_module(doc_index). 57:- use_module(doc_util). 58:- use_module(doc_words). 59:- use_module(man_index). 60
61:- include(hooks).
71:- predicate_options(search_form//1, 1,
72 [ for(atom),
73 search_in(oneof([all,noapp,app,man])),
74 search_match(oneof([name,summary])),
75 search_options(boolean)
76 ]). 77:- predicate_options(search_reply//2, 2,
78 [ resultFormat(oneof([summary,long])),
79 search_in(oneof([all,noapp,app,man])),
80 search_match(oneof([name,summary])),
81 header(boolean),
82 private(boolean),
83 edit(boolean),
84 page(positive_integer),
85 per_page(positive_integer),
86 pass_to(pldoc_index:doc_links//2, 2)
87 ]).
96search_form(Options) -->
97 { ( option(for(Value), Options)
98 -> Extra = [value(Value)]
99 ; Extra = []
100 ),
101 option(search_in(In), Options, all),
102 option(search_match(Match), Options, summary)
103 },
104 html(form([ id('search-form'),
105 action(location_by_id(pldoc_search))
106 ],
107 [ div([ \search_field([ name(for),
108 id(for)
109 | Extra
110 ])
111 ]),
112 \search_options(In, Match, Options)
113 ])).
114
115search_options(In, Match, Options) -->
116 { option(search_options(false), Options) },
117 !,
118 hidden(in, In),
119 hidden(match, Match).
120search_options(In, Match, _Options) -->
121 html(div(class('search-options'),
122 [ span(class('search-in'),
123 [ \radio(in, all, 'All', In),
124 \radio(in, app, 'Application', In),
125 \radio(in, man, 'Manual', In)
126 ]),
127 span(class('search-match'),
128 [ \radio(match, name, 'Name', Match),
129 \radio(match, summary, 'Summary', Match)
130 ]),
131 span(class('search-help'),
132 [ a(href(location_by_id(pldoc_package)+'pldoc.html#sec:browser'),
133 'Help')
134 ])
135 ])).
144search_field(Options) -->
145 prolog:doc_search_field(Options),
146 !.
147search_field(Options) -->
148 html([ input(Options, []),
149 input([ id('submit-for'),
150 type(submit),
151 value('Search')
152 ])
153 ]).
154
155radio(Radio, Field, Label, In) -->
156 { Field == In
157 -> Extra = [checked]
158 ; Extra = []
159 },
160 html([ input([ type(radio),
161 name(Radio),
162 value(Field)
163 | Extra
164 ]),
165 Label
166 ]).
167
168hidden(Name, Value) -->
169 html(input([type(hidden), name(Name), value(Value)])).
200:- html_meta
201 search_header(+, html, +, ?, ?). 202
203search_reply(For, Options) -->
204 { var(For) ; For == '' },
205 !,
206 search_header('', 'Using PlDoc search', Options),
207 html([ ul( class('search-help'),
208 [ li([ 'If you pause typing, the search box will display ',
209 'an auto completion list. Selecting an object jumps ',
210 'immediately to the corresponding documentation.'
211 ]),
212 li([ 'Searching for ', i('Name/Arity'), ', ',
213 i('Name//Arity'), ', ', i('Name'), ' or ',
214 i('C-function()'), ' ensures that ',
215 'matching definitions appear first in the search ',
216 'results'
217 ]),
218 li([ 'Other searches search through the name and summary ',
219 'descriptions in the manual.'
220 ])
221 ])
222 ]).
223search_reply(For, Options) -->
224 { cached_search(For, PerCategory, Time, Options),
225 PerCategory \== [],
226 page_location(PerCategory, NPages, Offset, Limit, Options),
227 option(resultFormat(Format), Options, summary)
228 },
229 !,
230 search_header(For, [ 'Search results for ',
231 span(class(for), ['"', For, '"'])
232 ],
233 Options),
234 { DisplayOptions = [ for(For),
235 cputime(Time),
236 page_count(NPages)
237 | Options
238 ]
239 },
240 indexed_matches(Format, PerCategory, Offset, Limit, DisplayOptions),
241 search_pagination(DisplayOptions).
242search_reply(For, Options) -->
243 search_header(For, 'No matches', Options),
244 html(div(class('search-no-matches'), 'No matches')).
245
246:- dynamic
247 cached_search_result/4. 248
249cached_search(For, Result, Time, Options) :-
250 option(search_in(In), Options, all),
251 option(search_match(Match), Options, summary),
252 cached_search_result(For, In, Match, Result),
253 !,
254 Time = cached.
255cached_search(For, Result, Time, Options) :-
256 option(search_in(In), Options, all),
257 option(search_match(Match), Options, summary),
258 statistics(cputime, T0),
259 search_doc(For, PerCategory0, Options),
260 order_matches(PerCategory0, Result),
261 statistics(cputime, T1),
262 Time is T1-T0,
263 assertz(cached_search_result(For, In, Match, Result)),
264 prune_search_cache.
265
266prune_search_cache :-
267 ( predicate_property(cached_search_result(_,_,_,_),
268 number_of_clauses(Count)),
269 Del is Count - 25,
270 Del > 0
271 -> forall(between(1,Del,_), retract(cached_search_result(_,_,_,_)))
272 ; true
273 ).
274
275page_location(PerCategory, NPages, Offset, Limit, Options) :-
276 option(page(Page), Options, 1),
277 option(per_page(Limit), Options, 25),
278 Offset is (Page-1)*Limit,
279 count_matches(PerCategory, Total),
280 NPages is (Total+Limit-1)//Limit.
281
(Options) -->
283 { option(page(Page), Options, 1),
284 option(page_count(NPages), Options, 1)
285 },
286 html(div(class(pagination),
287 [ \search_prev(Page, Options),
288 span(class(current), ['Page ', Page, ' of ', NPages]),
289 \search_next(NPages, Page, Options)
290 ])).
291
292search_prev(Page, _) -->
293 { Page =:= 1 },
294 !.
295search_prev(Page, Options) -->
296 { Prev is Page - 1,
297 page_link(Prev, Link, Options)
298 },
299 html(a(href(Link), '< Prev')).
300
301search_next(NPages, Page, _) -->
302 { Page =:= NPages, ! }, [].
303search_next(_NPages, Page, Options) -->
304 { Next is Page + 1,
305 page_link(Next, Link, Options)
306 },
307 html(a(href(Link), 'Next >')).
308
309page_link(Page, '?'+QueryString, Options) :-
310 option(for(For), Options),
311 option(search_in(In), Options, all),
312 option(search_match(Match), Options, summary),
313 option(resultFormat(Format), Options, summary),
314 uri_query_components(QueryString,
315 [ for(For),
316 in(In),
317 match(Match),
318 resultFormat(Format),
319 page(Page)
320 ]).
321
(_For, _Title, Options) -->
323 { option(header(false), Options) },
324 !,
325 html_requires(pldoc).
326search_header(For, Title, Options) -->
327 html_requires(pldoc),
328 doc_links('', [for(For)|Options]),
329 html(h1(class('search-results'), Title)).
336matching_object_table(Objects, Options) -->
337 { maplist(obj_cat_sec, Objects, Pairs),
338 group_hits(Pairs, Organized),
339 option(format(Format), Options, summary)
340 },
341 indexed_matches(Format, Organized, Options).
342
343obj_cat_sec(Object, Cat-(Section-Object)) :-
344 prolog:doc_object_summary(Object, Cat, Section, _Summary).
345
346indexed_matches(Format, PerCategory, Offset, Limit, Options) -->
347 { cat_offset(Offset, _,PerCategory, PerCategory1),
348 cat_limit(Limit, _, PerCategory1, PerCategory2)
349 },
350 ( { PerCategory2 == PerCategory }
351 -> indexed_matches(Format, PerCategory, Options)
352 ; category_counts(PerCategory,
353 [ showing('Total'),
354 link(category)
355 | Options
356 ]),
357 { delete(Options, cputime(_), Options1) },
358 category_counts(PerCategory2,
359 [ showing('Showing'),
360 class([showing])
361 | Options1
362 ]),
363 search_pagination(Options),
364 matches(Format, PerCategory2, Options)
365 ).
370cat_offset(0, 0, PerCat, PerCat) :-
371 !.
372cat_offset(N, R, [C-H|T], PerCat) :-
373 H = [_-[_|_]|_],
374 !,
375 cat_offset(N, R1, H, H1),
376 ( H1 == []
377 -> !, cat_offset(R1, R, T, PerCat)
378 ; PerCat = [C-H1|T]
379 ).
380cat_offset(N, R, [_C-L|T0], PerCat) :-
381 length(L, Len),
382 Left is N-Len,
383 Left > 0,
384 !,
385 cat_offset(Left, R, T0, PerCat).
386cat_offset(N, 0, [C-L0|T], [C-L|T]) :-
387 !,
388 length(Skip, N),
389 append(Skip, L, L0).
390cat_offset(N, N, Obj, Obj).
391
392cat_limit(0, 0, _PerCat, []) :-
393 !.
394cat_limit(N, R, [C-H|T], PerCat) :-
395 H = [_-[_|_]|_],
396 !,
397 cat_limit(N, R1, H, H1),
398 ( R1 == 0
399 -> PerCat = [C-H1]
400 ; PerCat = [C-H|T1],
401 cat_limit(R1, R, T, T1)
402 ).
403cat_limit(N, R, [C-L|T0], [C-L|T]) :-
404 length(L, Len),
405 More is N - Len,
406 More >= 0,
407 !,
408 cat_limit(More, R, T0, T).
409cat_limit(N, 0, [C-L0|_], [C-L]) :-
410 !,
411 length(L, N),
412 append(L, _, L0).
413cat_limit(N, N, [], []).
422order_matches(PerCat0, PerCat) :-
423 maplist(order_category, PerCat0, PerCat).
424
425order_category(Cat-PerSection0, Cat-PerSection) :-
426 maplist(order_section, PerSection0, PerSectionTagged),
427 sort(1, >=, PerSectionTagged, Ordered),
428 pairs_values(Ordered, PerSection).
429
430order_section(Section-Objects0, Q-(Section-Objects)) :-
431 sort(1, >=, Objects0, Objects),
432 maplist(arg(1), Objects, QList),
433 join_quality(QList, Q).
434
435join_quality([], 0).
436join_quality([Q], Q).
437join_quality([QH|QL], Q) :-
438 join_quality(QL, QT),
439 Q is 1-(1-QH)*(1-QT).
446indexed_matches(Format, PerCategory, Options) -->
447 category_counts(PerCategory, Options),
448 matches(Format, PerCategory, Options).
449
450category_counts(PerCategory, Options) -->
451 { count_matches(PerCategory, Matches),
452 option(class(Classes), Options, []),
453 ( PerCategory = [_]
454 -> merge_options([link(false)], Options, Options1)
455 ; Options1 = Options
456 )
457 },
458 html([ div(class(['search-counts'|Classes]),
459 [ \category_showing(Options1),
460 Matches,
461 \count_by_category(PerCategory, Options1),
462 \search_time(Options1)
463 ])
464 ]).
465
466count_by_category([Cat-_PerFile], Options) -->
467 !,
468 html(' matches from '),
469 category_link(Cat, Options).
470count_by_category(PerCategory, Options) -->
471 html(' matches; '),
472 count_by_category_list(PerCategory, Options).
473
474count_by_category_list([], _) -->
475 [].
476count_by_category_list([Cat-PerFile|T], Options) -->
477 { count_category(PerFile, Count) },
478 html([ \category_link(Cat, Options), ': ', Count ]),
479 ( {T == []}
480 -> []
481 ; html(', '),
482 count_by_category_list(T, Options)
483 ).
484
485count_matches([], 0).
486count_matches([_-Cat|T], Count) :-
487 count_matches(T, Count0),
488 count_category(Cat, N),
489 Count is Count0 + N.
490
491count_category([], 0).
492count_category([_-Objs|T], Count) :-
493 count_category(T, Count0),
494 length(Objs, N),
495 Count is Count0 + N.
496
497category_showing(Options) -->
498 { option(showing(Showing), Options) },
499 html(span(class('search-showing'), [Showing, :])).
500category_showing(_) -->
501 [].
502
503search_time(Options) -->
504 { option(cputime(Time), Options) },
505 !,
506 ( { number(Time) }
507 -> html(span(class('search-time'), '(~2f sec.)'-[Time]))
508 ; html(span(class('search-time'), '(~w)'-[Time]))
509 ).
510search_time(_) -->
511 [].
519matches(long, PerCategory, Options) -->
520 long_matches_by_type(PerCategory, Options).
521matches(summary, PerCategory, Options) -->
522 html(table(class(summary),
523 \short_matches_by_type(PerCategory, 1, Options))).
524
525
526long_matches_by_type([], _) -->
527 [].
528long_matches_by_type([Category-PerFile|T], Options) -->
529 category_header(Category, Options),
530 long_matches(PerFile, Options),
531 long_matches_by_type(T, Options).
532
533
534long_matches([], _) -->
535 [].
536long_matches([File-Objs|T], Options) -->
537 file_header(File, Options),
538 objects(Objs, Options),
539 long_matches(T, Options).
540
(Category, _Options) -->
542 html(h1(class(category), \category_title(Category))).
543
544short_matches_by_type([], _, _) -->
545 [].
546short_matches_by_type([Category-PerFile|T], Nth, Options) -->
547 category_index_header(Category, Nth, Options),
548 short_matches(PerFile, Options),
549 { succ(Nth, Nth1) },
550 short_matches_by_type(T, Nth1, Options).
551
552short_matches([], _) -->
553 [].
554short_matches([File-Objs|T], Options) -->
555 file_index_header(File, Options),
556 object_summaries(Objs, File, Options),
557 short_matches(T, Options).
558
559
(Category, Nth, _Options) -->
561 ( { Nth > 1 }
562 -> category_sep('category-top-sep')
563 ; []
564 ),
565 html(tr(th([class(category), colspan(3)],
566 a(name(Category), \category_title(Category))))),
567 category_sep('category-bottom-sep').
568
569category_sep(Which) -->
570 html(tr(th([class(Which), colspan(3)],
571 &(nbsp)))).
572
573category_link(Category, Options) -->
574 { option(link(false), Options) },
575 !,
576 category_title(Category).
577category_link(Category, Options) -->
578 { option(link(category), Options),
579 category_link(Category, HREF, Options)
580 },
581 !,
582 html(a(href(HREF), \category_title(Category))).
583category_link(Category, _Options) -->
584 { atom_concat(#, Category, HREF) },
585 html(a(href(HREF), \category_title(Category))).
586
587category_link(Category, '?'+QueryString, Options) :-
588 ( category_abbreviation(Category, Abbrev)
589 -> true
590 ; Abbrev = Category
591 ),
592 option(for(For), Options),
593 option(search_match(Match), Options, summary),
594 option(resultFormat(Format), Options, summary),
595 uri_query_components(QueryString,
596 [ for(For),
597 in(Abbrev),
598 match(Match),
599 resultFormat(Format)
600 ]).
601
602category_title(Category) -->
603 { prolog:doc_category(Category, _Order, Title)
604 -> true
605 ; Title = Category
606 },
607 html(Title).
614search_doc(Search, PerType, Options) :-
615 findall(Tuples, matching_object(Search, Tuples, Options), Tuples0),
616 sort(Tuples0, Tuples),
617 group_hits(Tuples, PerType0),
618 prune_library(PerType0, PerType).
619
620group_hits(Tuples, PerType) :-
621 keysort(Tuples, Tuples1),
622 group_pairs_by_key(Tuples1, PerCat0),
623 key_sort_order(PerCat0, PerCat1),
624 keysort(PerCat1, PerCat2),
625 pairs_values(PerCat2, PerCat),
626 group_by_file(PerCat, PerType).
627
628key_sort_order([], []).
629key_sort_order([Cat-ByCat|T0], [Order-(Cat-ByCat)|T]) :-
630 ( prolog:doc_category(Cat, Order, _Title)
631 -> true
632 ; Order = 99
633 ),
634 key_sort_order(T0, T).
635
636
637group_by_file([], []).
638group_by_file([Type-Tuples0|T0], [Type-ByFile|T]) :-
639 keysort(Tuples0, Tuples),
640 group_pairs_by_key(Tuples, ByFile),
641 group_by_file(T0, T).
648prune_library(PerCat0, PerCat) :-
649 selectchk(library-InLib0, PerCat0, library-InLib, PerCat1),
650 !,
651 ( cat_objects(manual, PerCat0, Manual),
652 cat_objects(packages, PerCat0, Packages),
653 append(Manual, Packages, Objects),
654 sort(Objects, OSet0),
655 maplist(arg(2), OSet0, OSet), 656 convlist(prune_section(OSet), InLib0, InLib),
657 InLib \== []
658 -> PerCat = PerCat1
659 ; selectchk(library-_, PerCat0, PerCat)
660 ).
661prune_library(PerCat, PerCat).
662
663cat_objects(Cat, PerCat, Objects) :-
664 memberchk(Cat-Sections, PerCat),
665 !,
666 pairs_values(Sections, NestedObjects),
667 append(NestedObjects, Objects).
668cat_objects(_, _, []).
669
670prune_section(Prune, Section-Objects0, Section-Objects) :-
671 exclude(in_set(Prune), Objects0, Objects),
672 Objects \== []. 673
674in_set(Prune, q(_Q,Obj)) :-
675 memberchk(Obj, Prune),
676 !.
677in_set(Prune, q(_Q,_Module:Obj)) :-
678 memberchk(Obj, Prune).
694matching_object(Search, Type-(Section-q(1,Obj)), Options) :-
695 atom_concat(Function, '()', Search),
696 Obj = c(Function),
697 option(search_in(In), Options, all),
698 prolog:doc_object_summary(Obj, Type, Section, _),
699 matching_category(In, Type).
700matching_object(Search, Type-(Section-q(1,Obj)), Options) :-
701 ( atom_pi(Search, Obj0)
702 -> ground(Obj0)
703 ; catch(atom_to_term(Search, Obj0, _), _, fail),
704 nonvar(Obj0)
705 ),
706 opt_qualify(Obj0, Obj),
707 option(search_in(In), Options, all),
708 prolog:doc_object_summary(Obj, Type, Section, _),
709 matching_category(In, Type).
710matching_object(Search, Match, Options) :-
711 atom_codes(Search, Codes),
712 phrase(search_spec(For0), Codes),
713 ( For0 = not(_)
714 -> throw(error(bad_search(only_not), _))
715 ; optimise_search(For0, For),
716 exec_search(For, Match, Options)
717 ).
718
719opt_qualify(Obj0, Obj) :-
720 Obj0 = _:_,
721 !,
722 Obj = Obj0.
723opt_qualify(Obj, Obj).
724opt_qualify(Obj, _:Obj).
733optimise_search(and(not(A0), B0), and(B, not(A))) :-
734 !,
735 optimise_search(A0, A),
736 optimise_search(B0, B).
737optimise_search(A, A).
751exec_search(Spec, Match, Options) :-
752 exec_search(Spec, Match0, Q, Options),
753 add_quality(Match0, Q, Match).
754
755add_quality(Type-(Section-Obj), Q, Type-(Section-q(Q,Obj))).
756
757exec_search(and(A, B), Match, Q, Options) :-
758 !,
759 exec_search(A, Match, Q1, Options),
760 exec_search(B, Match, Q2, Options),
761 Q is 1-((1-Q1)*(1-Q2)).
762exec_search(Search, Type-(Section-Obj), Q, Options) :-
763 option(search_in(In), Options, all),
764 option(search_match(Match), Options, summary),
765 option(private(Public), Options, true),
766 prolog:doc_object_summary(Obj, Type, Section, Summary),
767 matching_category(In, Type),
768 match_private(Public, Obj),
769 ( Search = not(For)
770 -> State = s(0),
771 \+ ( match_object(For, Obj, Summary, Match, Q),
772 nb_setarg(1, State, Q)
773 ),
774 arg(1, State, Q)
775 ; match_object(Search, Obj, Summary, Match, Q)
776 ).
777
778
779matching_category(all, _).
780matching_category(noapp, Category) :-
781 !,
782 Category \== application.
783matching_category(Category, Category).
784matching_category(Abbrev, Category) :-
785 category_abbreviation(Category, Abbrev).
786
787category_abbreviation(application, app).
788category_abbreviation(manual, man).
789category_abbreviation(library, lib).
790category_abbreviation(packages, pack).
791category_abbreviation(wiki, wiki).
792
793match_private(true, _).
794match_private(false, Object) :-
795 ( Object = (Module:PI)
796 -> current_module(Module),
797 pi_head(PI, Head),
798 ( predicate_property(Module:Head, exported)
799 -> true
800 ; predicate_property(Module:Head, multifile)
801 -> true
802 ; predicate_property(Module:Head, public)
803 )
804 ; true
805 ).
806
807pi_head(Name/Arity, Head) :-
808 functor(Head, Name, Arity).
809pi_head(Name//Arity, Head) :-
810 Arity1 is Arity+ 2,
811 functor(Head, Name, Arity1).
817search_spec(Spec) -->
818 blanks,
819 prim_search_spec(A),
820 blanks,
821 ( eos
822 -> { Spec = A }
823 ; search_spec(B)
824 -> { Spec = and(A,B) }
825 ).
826
827prim_search_spec(quoted(Quoted)) -->
828 "\"", string(Codes), "\"",
829 !,
830 { tokenize_atom(Codes, Quoted)
831 }.
832prim_search_spec(Spec) -->
833 nonblanks(Codes),
834 { Codes = [0'-,C0|Rest],
835 code_type(C0, csym)
836 -> atom_codes(Word, [C0|Rest]),
837 Spec = not(Word)
838 ; Codes \== [],
839 atom_codes(Spec, Codes)
840 }.
853prolog:doc_object_summary(Obj, Category, File, Summary) :-
854 once(prolog_object(Obj)),
855 current_prolog_flag(home, SWI),
856 doc_comment(Obj0, File:_Line, Summary, _Comment),
857 ( is_list(Obj0)
858 -> member(Obj, Obj0)
859 ; Obj = Obj0
860 ),
861 Obj \= _:module(_Title), 862 ( sub_atom(File, 0, _, _, SWI)
863 -> Category = library
864 ; Category = application
865 ).
866
867prolog_object(Var) :- var(Var), !.
868prolog_object(_/_).
869prolog_object(_//_).
870prolog_object(_:_/_).
871prolog_object(_:_//_).
872prolog_object(module(_)).
883prolog:doc_category(application, 20, 'Application').
884prolog:doc_category(library, 80, 'System Libraries').
885
886
887
902match_object(For, Object, Summary, How, Quality) :-
903 ( doc_object_identifier(Object, Identitier),
904 identifier_match_quality(For, Identitier, Quality)
905 -> debug(search(rank), 'Rank "~w" in identifier "~w": ~q',
906 [For, Identitier, Quality])
907 ; How == summary,
908 summary_match_quality(For, Summary, Quality),
909 debug(search(rank), 'Rank "~w" in summary "~w": ~q',
910 [For, Summary, Quality])
911 ).
912
913summary_match_quality(For, Summary, Q) :-
914 tokenize_atom(Summary, Tokens0),
915 exclude(is_punctuation, Tokens0, Tokens),
916 Tokens \== [],
917 token_match_quality(summary, For, Tokens, Q0),
918 Q is Q0/2.
919
920is_punctuation(Token) :-
921 atom_length(Token, 1),
922 char_type(Token, punct).
923
924
925identifier_match_quality(Identifier, Identifier, 1) :-
926 !.
927identifier_match_quality(For, Identifier, Q) :-
928 dwim_match(For, Identifier, _),
929 !,
930 Q = 0.8.
931identifier_match_quality(For, Identifier, Q) :-
932 identifier_parts(Identifier, Parts),
933 Parts \== [],
934 token_match_quality(identifier, For, Parts, Q).
935
936token_match_quality(_How, quoted(Tokens), Parts, Q) :-
937 !,
938 append(Tokens, _, All),
939 append(_, All, Parts),
940 Q = 1.
941token_match_quality(How, For, Parts, Q) :-
942 length(Parts, Len),
943 ( memberchk(For, Parts)
944 -> Q0 = 1
945 ; snowball(english, For, Stem),
946 member(Part, Parts),
947 atom(Part),
948 snowball(english, Part, Stem)
949 -> Q0 = 0.9
950 ; How == summary,
951 member(Part, Parts),
952 sub_atom_icasechk(Part, _, For),
953 identifier_parts(Part, SubParts),
954 token_match_quality(identifier, For, SubParts, Q00)
955 -> Q0 is Q00/2
956 ; How == summary,
957 member(Part, Parts),
958 sub_atom_icasechk(Part, 0, For),
959 is_numbered_var(Part, For)
960 -> Q0 is 0.9
961 ; doc_related_word(For, Word, Distance),
962 memberchk(Word, Parts)
963 -> Q0 = Distance
964 ),
965 Q is Q0/Len.
966
967is_numbered_var(VarName, Search) :-
968 atom_length(Search, Len),
969 sub_string(VarName, Len, _, 0, NS),
970 number_string(_, NS),
971 sub_atom(VarName, 0, 1, _, First),
972 char_type(First, prolog_var_start)
Search form and reply
*/