35
36:- module(prolog_help,
37 [ help/0,
38 help/1, 39 apropos/1, 40 help_text/2
41 ]). 42:- use_module(library(pldoc), []). 43:- use_module(library(isub), [isub/4]). 44
45:- autoload(library(apply), [maplist/3]). 46:- autoload(library(error), [must_be/2]). 47:- autoload(library(lists), [append/3, sum_list/2]). 48:- autoload(library(pairs), [pairs_values/2]). 49:- autoload(library(porter_stem), [tokenize_atom/2]). 50:- autoload(library(process), [process_create/3]). 51:- autoload(library(sgml), [load_html/3]). 52:- autoload(library(solution_sequences), [distinct/1]). 53:- autoload(library(http/html_write), [html/3, print_html/1]). 54:- autoload(library(lynx/html_text), [html_text/2]). 55:- autoload(pldoc(doc_man), [man_page/4]). 56:- autoload(pldoc(doc_modes), [(mode)/2]). 57:- autoload(pldoc(doc_words), [doc_related_word/3]). 58:- autoload(pldoc(man_index), [man_object_property/2, doc_object_identifier/2]). 59:- autoload(library(prolog_code), [pi_head/2]). 60:- autoload(library(prolog_xref), [xref_source/2]). 61
62:- use_module(library(lynx/pldoc_style), []). 63
88
89:- meta_predicate
90 with_pager(0). 91
92:- multifile
93 show_html_hook/1. 94
97:- create_prolog_flag(help_pager, default,
98 [ type(term),
99 keep(true)
100 ]). 101
146
147help :-
148 notrace(show_matches([help/1, apropos/1], exact-help)).
149
150help(What) :-
151 notrace(help_no_trace(What)).
152
153help_no_trace(What) :-
154 help_objects_how(What, Matches, How),
155 !,
156 show_matches(Matches, How-What).
157help_no_trace(What) :-
158 print_message(warning, help(not_found(What))).
159
160show_matches(Matches, HowWhat) :-
161 help_html(Matches, HowWhat, HTML),
162 !,
163 show_html(HTML).
164
170
171show_html(HTML) :-
172 show_html_hook(HTML),
173 !.
174show_html(HTML) :-
175 setup_call_cleanup(
176 open_string(HTML, In),
177 load_html(stream(In), DOM, []),
178 close(In)),
179 page_width(PageWidth),
180 LineWidth is PageWidth - 4,
181 with_pager(html_text(DOM, [width(LineWidth)])).
182
183help_html(Matches, How, HTML) :-
184 phrase(html(html([ head([]),
185 body([ \match_type(How),
186 dl(\man_pages(Matches,
187 [ no_manual(fail),
188 links(false),
189 link_source(false),
190 navtree(false),
191 server(false),
192 qualified(always)
193 ]))
194 ])
195 ])),
196 Tokens),
197 !,
198 with_output_to(string(HTML),
199 print_html(Tokens)).
200
201match_type(exact-_) -->
202 [].
203match_type(dwim-For) -->
204 html(p(class(warning),
205 [ 'WARNING: No matches for "', span(class('help-query'), For),
206 '" Showing closely related results'
207 ])).
208
209man_pages([], _) -->
210 [].
211man_pages([H|T], Options) -->
212 ( man_page(H, Options)
213 -> []
214 ; html(p(class(warning),
215 [ 'WARNING: No help for ~p'-[H]
216 ]))
217 ),
218 man_pages(T, Options).
219
220page_width(Width) :-
221 tty_width(W),
222 Width is min(100,max(50,W)).
223
228
229tty_width(W) :-
230 \+ running_under_emacs,
231 catch(tty_size(_, W), _, fail),
232 !.
233tty_width(80).
234
235help_objects_how(Spec, Objects, exact) :-
236 help_objects(Spec, exact, Objects),
237 !.
238help_objects_how(Spec, Objects, dwim) :-
239 help_objects(Spec, dwim, Objects),
240 !.
241
242help_objects(Spec, How, Objects) :-
243 findall(ID-Obj, help_object(Spec, How, Obj, ID), Objects0),
244 Objects0 \== [],
245 sort(1, @>, Objects0, Objects1),
246 pairs_values(Objects1, Objects2),
247 sort(Objects2, Objects).
248
249help_object(Fuzzy/Arity, How, Name/Arity, ID) :-
250 match_name(How, Fuzzy, Name),
251 man_object_property(Name/Arity, id(ID)).
252help_object(Fuzzy//Arity, How, Name//Arity, ID) :-
253 match_name(How, Fuzzy, Name),
254 man_object_property(Name//Arity, id(ID)).
255help_object(Fuzzy/Arity, How, f(Name/Arity), ID) :-
256 match_name(How, Fuzzy, Name),
257 man_object_property(f(Name/Arity), id(ID)).
258help_object(Fuzzy, How, Name/Arity, ID) :-
259 atom(Fuzzy),
260 match_name(How, Fuzzy, Name),
261 man_object_property(Name/Arity, id(ID)).
262help_object(Fuzzy, How, Name//Arity, ID) :-
263 atom(Fuzzy),
264 match_name(How, Fuzzy, Name),
265 man_object_property(Name//Arity, id(ID)).
266help_object(Fuzzy, How, f(Name/Arity), ID) :-
267 atom(Fuzzy),
268 match_name(How, Fuzzy, Name),
269 man_object_property(f(Name/Arity), id(ID)).
270help_object(Fuzzy, How, c(Name), ID) :-
271 atom(Fuzzy),
272 match_name(How, Fuzzy, Name),
273 man_object_property(c(Name), id(ID)).
274help_object(SecID, _How, section(Label), ID) :-
275 atom(SecID),
276 ( atom_concat('sec:', SecID, Label)
277 ; sub_atom(SecID, _, _, 0, '.html'),
278 Label = SecID
279 ),
280 man_object_property(section(_Level,_Num,Label,_File), id(ID)).
281help_object(Func, How, c(Name), ID) :-
282 compound(Func),
283 compound_name_arity(Func, Fuzzy, 0),
284 match_name(How, Fuzzy, Name),
285 man_object_property(c(Name), id(ID)).
287help_object(Module, _How, Module:Name/Arity, _ID) :-
288 atom(Module),
289 current_module(Module),
290 atom_concat('sec:', Module, SecLabel),
291 \+ man_object_property(section(_,_,SecLabel,_), _), 292 current_predicate_help(Module:Name/Arity).
293help_object(Module:Name, _How, Module:Name/Arity, _ID) :-
294 atom(Name),
295 current_predicate_help(Module:Name/Arity).
296help_object(Module:Name/Arity, _How, Module:Name/Arity, _ID) :-
297 atom(Name),
298 current_predicate_help(Module:Name/Arity).
299help_object(Name/Arity, _How, Module:Name/Arity, _ID) :-
300 atom(Name),
301 current_predicate_help(Module:Name/Arity).
302help_object(Fuzzy, How, Module:Name/Arity, _ID) :-
303 atom(Fuzzy),
304 match_name(How, Fuzzy, Name),
305 current_predicate_help(Module:Name/Arity).
306
313
314current_predicate_help(M:Name/Arity) :-
315 current_predicate(M:Name/Arity),
316 pi_head(Name/Arity,Head),
317 \+ predicate_property(M:Head, imported_from(_)),
318 module_property(M, class(user)),
319 ( mode(M:_, _) 320 -> true
321 ; \+ module_property(M, class(system)),
322 main_source_file(M:Head, File),
323 xref_source(File,[comments(store)])
324 ),
325 mode(M:Head, _). 326
327match_name(exact, Name, Name).
328match_name(dwim, Name, Fuzzy) :-
329 freeze(Fuzzy, dwim_match(Fuzzy, Name)).
330
334
335main_source_file(Pred, File) :-
336 predicate_property(Pred, file(File0)),
337 main_source(File0, File).
338
339main_source(File, Main) :-
340 source_file(File),
341 !,
342 Main = File.
343main_source(File, Main) :-
344 source_file_property(File, included_in(Parent, _Time)),
345 main_source(Parent, Main).
346
347
352
(Goal) :-
354 pager_ok(Pager, Options),
355 !,
356 Catch = error(io_error(_,_), _),
357 current_output(OldIn),
358 setup_call_cleanup(
359 process_create(Pager, Options,
360 [stdin(pipe(In))]),
361 ( set_stream(In, tty(true)),
362 set_output(In),
363 catch(Goal, Catch, true)
364 ),
365 ( set_output(OldIn),
366 close(In, [force(true)])
367 )).
368with_pager(Goal) :-
369 call(Goal).
370
(_Path, _Options) :-
372 current_prolog_flag(help_pager, false),
373 !,
374 fail.
375pager_ok(Path, Options) :-
376 current_prolog_flag(help_pager, default),
377 !,
378 stream_property(current_output, tty(true)),
379 \+ running_under_emacs,
380 ( distinct(( getenv('PAGER', Pager)
381 ; Pager = less
382 )),
383 absolute_file_name(path(Pager), Path,
384 [ access(execute),
385 file_errors(fail)
386 ])
387 -> pager_options(Path, Options)
388 ).
389pager_ok(Path, Options) :-
390 current_prolog_flag(help_pager, Term),
391 callable(Term),
392 compound_name_arguments(Term, Pager, Options),
393 absolute_file_name(path(Pager), Path,
394 [ access(execute),
395 file_errors(fail)
396 ]).
397
(Path, Options) :-
399 file_base_name(Path, File),
400 file_name_extension(Base, _, File),
401 downcase_atom(Base, Id),
402 pager_default_options(Id, Options).
403
(less, ['-r']).
405
406
411
412running_under_emacs :-
413 current_prolog_flag(emacs_inferior_process, true),
414 !.
415running_under_emacs :-
416 getenv('TERM', dumb),
417 !.
418running_under_emacs :-
419 current_prolog_flag(toplevel_prompt, P),
420 sub_atom(P, _, _, _, 'ediprolog'),
421 !.
422
423
445
446apropos(Query) :-
447 notrace(apropos_no_trace(Query)).
448
449apropos_no_trace(Query) :-
450 findall(Q-(Obj-Summary), apropos(Query, Obj, Summary, Q), Pairs),
451 ( Pairs == []
452 -> print_message(warning, help(no_apropos_match(Query)))
453 ; sort(1, >=, Pairs, Sorted),
454 length(Sorted, Len),
455 ( Len > 20
456 -> length(Truncated, 20),
457 append(Truncated, _, Sorted)
458 ; Truncated = Sorted
459 ),
460 pairs_values(Truncated, Matches),
461 print_message(information, help(apropos_matches(Matches, Len)))
462 ).
463
464apropos(Query, Obj, Summary, Q) :-
465 parse_query(Query, Type, Words),
466 man_object_property(Obj, summary(Summary)),
467 apropos_match(Type, Words, Obj, Summary, Q).
468
469parse_query(Type:String, Type, Words) :-
470 !,
471 must_be(atom, Type),
472 must_be(text, String),
473 tokenize_atom(String, Words).
474parse_query(String, _Type, Words) :-
475 must_be(text, String),
476 tokenize_atom(String, Words).
477
478apropos_match(Type, Query, Object, Summary, Q) :-
479 maplist(amatch(Object, Summary), Query, Scores),
480 match_object_type(Type, Object),
481 sum_list(Scores, Q).
482
483amatch(Object, Summary, Query, Score) :-
484 ( doc_object_identifier(Object, String)
485 ; String = Summary
486 ),
487 amatch(Query, String, Score),
488 !.
489
490amatch(Query, To, Quality) :-
491 doc_related_word(Query, Related, Distance),
492 sub_atom_icasechk(To, _, Related),
493 isub(Related, To, false, Quality0),
494 Quality is Quality0*Distance.
495
496match_object_type(Type, _Object) :-
497 var(Type),
498 !.
499match_object_type(Type, Object) :-
500 downcase_atom(Type, LType),
501 object_class(Object, Class),
502 match_object_class(LType, Class).
503
504match_object_class(Type, Class) :-
505 ( TheClass = Class
506 ; class_alias(Class, TheClass)
507 ),
508 sub_atom(TheClass, 0, _, _, Type),
509 !.
510
511class_alias(section, chapter).
512class_alias(function, arithmetic).
513class_alias(cfunction, c_function).
514class_alias(iso_predicate, predicate).
515class_alias(swi_builtin_predicate, predicate).
516class_alias(library_predicate, predicate).
517class_alias(dcg, predicate).
518class_alias(dcg, nonterminal).
519class_alias(dcg, non_terminal).
520
521class_tag(section, 'SEC').
522class_tag(function, ' F').
523class_tag(iso_predicate, 'ISO').
524class_tag(swi_builtin_predicate, 'SWI').
525class_tag(library_predicate, 'LIB').
526class_tag(dcg, 'DCG').
527
528object_class(section(_Level, _Num, _Label, _File), section).
529object_class(c(_Name), cfunction).
530object_class(f(_Name/_Arity), function).
531object_class(Name/Arity, Type) :-
532 functor(Term, Name, Arity),
533 ( current_predicate(system:Name/Arity),
534 predicate_property(system:Term, built_in)
535 -> ( predicate_property(system:Term, iso)
536 -> Type = iso_predicate
537 ; Type = swi_builtin_predicate
538 )
539 ; Type = library_predicate
540 ).
541object_class(_M:_Name/_Arity, library_predicate).
542object_class(_Name//_Arity, dcg).
543object_class(_M:_Name//_Arity, dcg).
544
550help_text(Pred, HelpText) :-
551 help_objects(Pred, exact, Matches), !,
552 catch(help_html(Matches, exact-exact, HtmlDoc), _, fail),
553 setup_call_cleanup(open_string(HtmlDoc, In),
554 load_html(stream(In), Dom, []),
555 close(In)),
556 with_output_to(string(HelpText), html_text(Dom, [])).
557
558 561
562:- multifile prolog:message//1. 563
564prolog:message(help(not_found(What))) -->
565 [ 'No help for ~p.'-[What], nl,
566 'Use ?- apropos(query). to search for candidates.'-[]
567 ].
568prolog:message(help(no_apropos_match(Query))) -->
569 [ 'No matches for ~p'-[Query] ].
570prolog:message(help(apropos_matches(Pairs, Total))) -->
571 { tty_width(W),
572 Width is max(30,W),
573 length(Pairs, Count)
574 },
575 matches(Pairs, Width),
576 ( {Count =:= Total}
577 -> []
578 ; [ nl,
579 ansi(fg(red), 'Showing ~D of ~D matches', [Count,Total]), nl, nl,
580 'Use ?- apropos(Type:Query) or multiple words in Query '-[], nl,
581 'to restrict your search. For example:'-[], nl, nl,
582 ' ?- apropos(iso:open).'-[], nl,
583 ' ?- apropos(\'open file\').'-[]
584 ]
585 ).
586
587matches([], _) --> [].
588matches([H|T], Width) -->
589 match(H, Width),
590 ( {T == []}
591 -> []
592 ; [nl],
593 matches(T, Width)
594 ).
595
596match(Obj-Summary, Width) -->
597 { Left is min(40, max(20, round(Width/3))),
598 Right is Width-Left-2,
599 man_object_summary(Obj, ObjS, Tag),
600 write_length(ObjS, LenObj, [portray(true), quoted(true)]),
601 Spaces0 is Left - LenObj - 4,
602 ( Spaces0 > 0
603 -> Spaces = Spaces0,
604 SummaryLen = Right
605 ; Spaces = 1,
606 SummaryLen is Right + Spaces0 - 1
607 ),
608 truncate(Summary, SummaryLen, SummaryE)
609 },
610 [ ansi([fg(default)], '~w ~p', [Tag, ObjS]),
611 '~|~*+~w'-[Spaces, SummaryE]
613 ].
614
615truncate(Summary, Width, SummaryE) :-
616 string_length(Summary, SL),
617 SL > Width,
618 !,
619 Pre is Width-4,
620 sub_string(Summary, 0, Pre, _, S1),
621 string_concat(S1, " ...", SummaryE).
622truncate(Summary, _, Summary).
623
624man_object_summary(section(_Level, _Num, Label, _File), Obj, 'SEC') :-
625 atom_concat('sec:', Obj, Label),
626 !.
627man_object_summary(section(0, _Num, File, _Path), File, 'SEC') :- !.
628man_object_summary(c(Name), Obj, ' C') :- !,
629 compound_name_arguments(Obj, Name, []).
630man_object_summary(f(Name/Arity), Name/Arity, ' F') :- !.
631man_object_summary(Obj, Obj, Tag) :-
632 ( object_class(Obj, Class),
633 class_tag(Class, Tag)
634 -> true
635 ; Tag = ' ?'
636 ).
637
638 641
642sandbox:safe_primitive(prolog_help:apropos(_)).
643sandbox:safe_primitive(prolog_help:help(_))