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)  2018, CWI 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(prolog_help,
   36          [ help/0,
   37            help/1,                     % +Object
   38            apropos/1                   % +Search
   39          ]).   40:- use_module(library(pldoc), []).   41:- autoload(library(apply),[maplist/3]).   42:- autoload(library(error),[must_be/2]).   43:- autoload(library(isub),[isub/4]).   44:- autoload(library(lists),[append/3,sum_list/2]).   45:- autoload(library(pairs),[pairs_values/2]).   46:- autoload(library(porter_stem),[tokenize_atom/2]).   47:- autoload(library(process),[process_create/3]).   48:- autoload(library(sgml),[load_html/3]).   49:- autoload(library(solution_sequences),[distinct/1]).   50:- autoload(library(http/html_write),[html/3,print_html/1]).   51:- autoload(library(lynx/html_text),[html_text/2]).   52:- autoload(pldoc(doc_man),[man_page/4]).   53:- autoload(pldoc(doc_words),[doc_related_word/3]).   54:- autoload(pldoc(man_index),
   55	    [man_object_property/2,doc_object_identifier/2]).   56
   57
   58:- use_module(library(lynx/pldoc_style), []).   59
   60/** <module> Text based manual
   61
   62This module provides help/1 and apropos/1 that   give help on a topic or
   63searches the manual for relevant topics.
   64
   65By default the result of  help/1  is   sent  through  a  _pager_ such as
   66`less`. This behaviour is controlled by the following:
   67
   68  - The Prolog flag `help_pager`, which can be set to one of the
   69    following values:
   70
   71    - false
   72    Never use a pager.
   73    - default
   74    Use default behaviour.  This tries to determine whether Prolog
   75    is running interactively in an environment that allows for
   76    a pager.  If so it examines the environment variable =PAGER=
   77    or otherwise tries to find the `less` program.
   78    - Callable
   79    A Callable term is interpreted as program_name(Arg, ...).  For
   80    example, `less('-r')` would be the default.  Note that the
   81    program name can be an absolute path if single quotes are
   82    used.
   83*/
   84
   85:- meta_predicate
   86    with_pager(0).   87
   88:- multifile
   89    show_html_hook/1.   90
   91% one of `default`, `false`, an executable or executable(options), e.g.
   92% less('-r').
   93:- create_prolog_flag(help_pager, default,
   94                      [ type(term),
   95                        keep(true)
   96                      ]).   97
   98%!  help is det.
   99%!  help(+What) is det.
  100%
  101%   Show help for What. What is a   term that describes the topics(s) to
  102%   give help for.  Notations for What are:
  103%
  104%     - Atom
  105%       This ambiguous form is most commonly used and shows all
  106%       matching documents.  For example:
  107%
  108%           ?- help(append).
  109%
  110%     - Name/Arity
  111%       Give help on predicates with matching Name/Arity.  Arity may
  112%       be unbound.
  113%     - Name//Arity
  114%       Give help on the matching DCG rule (non-terminal)
  115%     - f(Name/Arity)
  116%       Give help on the matching Prolog arithmetic functions.
  117%     - c(Name)
  118%       Give help on the matching C interface function
  119%     - section(Label)
  120%       Show the section from the manual with matching Label.
  121%
  122%   If an exact match fails this predicates attempts fuzzy matching and,
  123%   when successful, display the results headed   by  a warning that the
  124%   matches are based on fuzzy matching.
  125%
  126%   If possible, the results are sent  through   a  _pager_  such as the
  127%   `less` program. This behaviour is  controlled   by  the  Prolog flag
  128%   `help_pager`. See section level documentation.
  129%
  130%   @see apropos/1 for searching the manual names and summaries.
  131
  132help :-
  133    notrace(show_matches([help/1, apropos/1], exact-help)).
  134
  135help(What) :-
  136    notrace(help_no_trace(What)).
  137
  138help_no_trace(What) :-
  139    help_objects_how(What, Matches, How),
  140    !,
  141    show_matches(Matches, How-What).
  142help_no_trace(What) :-
  143    print_message(warning, help(not_found(What))).
  144
  145show_matches(Matches, HowWhat) :-
  146    help_html(Matches, HowWhat, HTML),
  147    !,
  148    show_html(HTML).
  149
  150%!  show_html_hook(+HTML:string) is semidet.
  151%
  152%   Hook called to display the  extracted   HTML  document. If this hook
  153%   fails the HTML is rendered  to  the   console  as  plain  text using
  154%   html_text/2.
  155
  156show_html(HTML) :-
  157    show_html_hook(HTML),
  158    !.
  159show_html(HTML) :-
  160    setup_call_cleanup(
  161        open_string(HTML, In),
  162        load_html(stream(In), DOM, []),
  163        close(In)),
  164    page_width(PageWidth),
  165    LineWidth is PageWidth - 4,
  166    with_pager(html_text(DOM, [width(LineWidth)])).
  167
  168help_html(Matches, How, HTML) :-
  169    phrase(html(html([ head([]),
  170                       body([ \match_type(How),
  171                              dl(\man_pages(Matches,
  172                                            [ no_manual(fail),
  173                                              links(false),
  174                                              link_source(false),
  175                                              navtree(false),
  176                                              server(false)
  177                                            ]))
  178                            ])
  179                     ])),
  180           Tokens),
  181    !,
  182    with_output_to(string(HTML),
  183                   print_html(Tokens)).
  184
  185match_type(exact-_) -->
  186    [].
  187match_type(dwim-For) -->
  188    html(p(class(warning),
  189           [ 'WARNING: No matches for "', span(class('help-query'), For),
  190             '" Showing closely related results'
  191           ])).
  192
  193man_pages([], _) -->
  194    [].
  195man_pages([H|T], Options) -->
  196    man_page(H, Options),
  197    man_pages(T, Options).
  198
  199page_width(Width) :-
  200    tty_width(W),
  201    Width is min(100,max(50,W)).
  202
  203%!  tty_width(-Width) is det.
  204%
  205%   Return the believed width of the terminal.   If we do not know Width
  206%   is bound to 80.
  207
  208tty_width(W) :-
  209    \+ running_under_emacs,
  210    catch(tty_size(_, W), _, fail),
  211    !.
  212tty_width(80).
  213
  214help_objects_how(Spec, Objects, exact) :-
  215    help_objects(Spec, exact, Objects),
  216    !.
  217help_objects_how(Spec, Objects, dwim) :-
  218    help_objects(Spec, dwim, Objects),
  219    !.
  220
  221help_objects(Spec, How, Objects) :-
  222    findall(ID-Obj, help_object(Spec, How, Obj, ID), Objects0),
  223    Objects0 \== [],
  224    sort(1, @>, Objects0, Objects1),
  225    pairs_values(Objects1, Objects2),
  226    sort(Objects2, Objects).
  227
  228help_object(Fuzzy/Arity, How, Name/Arity, ID) :-
  229    match_name(How, Fuzzy, Name),
  230    man_object_property(Name/Arity, id(ID)).
  231help_object(Fuzzy//Arity, How, Name//Arity, ID) :-
  232    match_name(How, Fuzzy, Name),
  233    man_object_property(Name//Arity, id(ID)).
  234help_object(Fuzzy/Arity, How, f(Name/Arity), ID) :-
  235    match_name(How, Fuzzy, Name),
  236    man_object_property(f(Name/Arity), id(ID)).
  237help_object(Fuzzy, How, Name/Arity, ID) :-
  238    atom(Fuzzy),
  239    match_name(How, Fuzzy, Name),
  240    man_object_property(Name/Arity, id(ID)).
  241help_object(Fuzzy, How, Name//Arity, ID) :-
  242    atom(Fuzzy),
  243    match_name(How, Fuzzy, Name),
  244    man_object_property(Name//Arity, id(ID)).
  245help_object(Fuzzy, How, f(Name/Arity), ID) :-
  246    atom(Fuzzy),
  247    match_name(How, Fuzzy, Name),
  248    man_object_property(f(Name/Arity), id(ID)).
  249help_object(Fuzzy, How, c(Name), ID) :-
  250    atom(Fuzzy),
  251    match_name(How, Fuzzy, Name),
  252    man_object_property(c(Name), id(ID)).
  253help_object(SecID, _How, section(Label), ID) :-
  254    atom(SecID),
  255    (   atom_concat('sec:', SecID, Label)
  256    ;   sub_atom(SecID, _, _, 0, '.html'),
  257        Label = SecID
  258    ),
  259    man_object_property(section(_Level,_Num,Label,_File), id(ID)).
  260help_object(Func, How, c(Name), ID) :-
  261    compound(Func),
  262    compound_name_arity(Func, Fuzzy, 0),
  263    match_name(How, Fuzzy, Name),
  264    man_object_property(c(Name), id(ID)).
  265
  266match_name(exact, Name, Name).
  267match_name(dwim,  Name, Fuzzy) :-
  268    freeze(Fuzzy, dwim_match(Fuzzy, Name)).
  269
  270
  271%!  with_pager(+Goal)
  272%
  273%   Send the current output of Goal through a  pager. If no pager can be
  274%   found we simply dump the output to the current output.
  275
  276with_pager(Goal) :-
  277    pager_ok(Pager, Options),
  278    !,
  279    Catch = error(io_error(_,_), _),
  280    current_output(OldIn),
  281    setup_call_cleanup(
  282        process_create(Pager, Options,
  283                       [stdin(pipe(In))]),
  284        ( set_stream(In, tty(true)),
  285          set_output(In),
  286          catch(Goal, Catch, true)
  287        ),
  288        ( set_output(OldIn),
  289          close(In, [force(true)])
  290        )).
  291with_pager(Goal) :-
  292    call(Goal).
  293
  294pager_ok(_Path, _Options) :-
  295    current_prolog_flag(help_pager, false),
  296    !,
  297    fail.
  298pager_ok(Path, Options) :-
  299    current_prolog_flag(help_pager, default),
  300    !,
  301    stream_property(current_output, tty(true)),
  302    \+ running_under_emacs,
  303    (   distinct((   getenv('PAGER', Pager)
  304                 ;   Pager = less
  305                 )),
  306        absolute_file_name(path(Pager), Path,
  307                           [ access(execute),
  308                             file_errors(fail)
  309                           ])
  310    ->  pager_options(Path, Options)
  311    ).
  312pager_ok(Path, Options) :-
  313    current_prolog_flag(help_pager, Term),
  314    callable(Term),
  315    compound_name_arguments(Term, Pager, Options),
  316    absolute_file_name(path(Pager), Path,
  317                           [ access(execute),
  318                             file_errors(fail)
  319                           ]).
  320
  321pager_options(Path, Options) :-
  322    file_base_name(Path, File),
  323    file_name_extension(Base, _, File),
  324    downcase_atom(Base, Id),
  325    pager_default_options(Id, Options).
  326
  327pager_default_options(less, ['-r']).
  328
  329
  330%!  running_under_emacs
  331%
  332%   True when we believe to be running  in Emacs. Unfortunately there is
  333%   no easy unambiguous way to tell.
  334
  335running_under_emacs :-
  336    current_prolog_flag(emacs_inferior_process, true),
  337    !.
  338running_under_emacs :-
  339    getenv('TERM', dumb),
  340    !.
  341running_under_emacs :-
  342    current_prolog_flag(toplevel_prompt, P),
  343    sub_atom(P, _, _, _, 'ediprolog'),
  344    !.
  345
  346
  347%!  apropos(+Query) is det.
  348%
  349%   Print objects from the  manual  whose   name  or  summary match with
  350%   Query. Query takes one of the following forms:
  351%
  352%     - Type:Text
  353%       Find objects matching Text and filter the results by Type.
  354%       Type matching is a case intensitive _prefix_ match.
  355%       Defined types are `section`, `cfunction`, `function`,
  356%       `iso_predicate`, `swi_builtin_predicate`, `library_predicate`,
  357%       `dcg` and aliases `chapter`, `arithmetic`, `c_function`,
  358%       `predicate`, `nonterminal` and `non_terminal`.  For example:
  359%
  360%           ?- apropos(c:close).
  361%           ?- apropos(f:min).
  362%
  363%     - Text
  364%       Text is broken into tokens.  A topic matches if all tokens
  365%       appear in the name or summary of the topic. Matching is
  366%	case insensitive.  Results are ordered depending on the
  367%	quality of the match.
  368
  369apropos(Query) :-
  370    notrace(apropos_no_trace(Query)).
  371
  372apropos_no_trace(Query) :-
  373    findall(Q-(Obj-Summary), apropos(Query, Obj, Summary, Q), Pairs),
  374    (   Pairs == []
  375    ->  print_message(warning, help(no_apropos_match(Query)))
  376    ;   sort(1, >=, Pairs, Sorted),
  377        length(Sorted, Len),
  378        (   Len > 20
  379        ->  length(Truncated, 20),
  380            append(Truncated, _, Sorted)
  381        ;   Truncated = Sorted
  382        ),
  383        pairs_values(Truncated, Matches),
  384        print_message(information, help(apropos_matches(Matches, Len)))
  385    ).
  386
  387apropos(Query, Obj, Summary, Q) :-
  388    parse_query(Query, Type, Words),
  389    man_object_property(Obj, summary(Summary)),
  390    apropos_match(Type, Words, Obj, Summary, Q).
  391
  392parse_query(Type:String, Type, Words) :-
  393    !,
  394    must_be(atom, Type),
  395    must_be(text, String),
  396    tokenize_atom(String, Words).
  397parse_query(String, _Type, Words) :-
  398    must_be(text, String),
  399    tokenize_atom(String, Words).
  400
  401apropos_match(Type, Query, Object, Summary, Q) :-
  402    maplist(amatch(Object, Summary), Query, Scores),
  403    match_object_type(Type, Object),
  404    sum_list(Scores, Q).
  405
  406amatch(Object, Summary, Query, Score) :-
  407    (   doc_object_identifier(Object, String)
  408    ;   String = Summary
  409    ),
  410    amatch(Query, String, Score),
  411    !.
  412
  413amatch(Query, To, Quality) :-
  414    doc_related_word(Query, Related, Distance),
  415    sub_atom_icasechk(To, _, Related),
  416    isub(Related, To, false, Quality0),
  417    Quality is Quality0*Distance.
  418
  419match_object_type(Type, _Object) :-
  420    var(Type),
  421    !.
  422match_object_type(Type, Object) :-
  423    downcase_atom(Type, LType),
  424    object_class(Object, Class),
  425    match_object_class(LType, Class).
  426
  427match_object_class(Type, Class) :-
  428    (   TheClass = Class
  429    ;   class_alias(Class, TheClass)
  430    ),
  431    sub_atom(TheClass, 0, _, _, Type),
  432    !.
  433
  434class_alias(section,               chapter).
  435class_alias(function,              arithmetic).
  436class_alias(cfunction,             c_function).
  437class_alias(iso_predicate,         predicate).
  438class_alias(swi_builtin_predicate, predicate).
  439class_alias(library_predicate,     predicate).
  440class_alias(dcg,                   predicate).
  441class_alias(dcg,                   nonterminal).
  442class_alias(dcg,                   non_terminal).
  443
  444class_tag(section,               'SEC').
  445class_tag(function,              '  F').
  446class_tag(iso_predicate,         'ISO').
  447class_tag(swi_builtin_predicate, 'SWI').
  448class_tag(library_predicate,     'LIB').
  449class_tag(dcg,                   'DCG').
  450
  451object_class(section(_Level, _Num, _Label, _File), section).
  452object_class(c(_Name), cfunction).
  453object_class(f(_Name/_Arity), function).
  454object_class(Name/Arity, Type) :-
  455    functor(Term, Name, Arity),
  456    (   current_predicate(system:Name/Arity),
  457        predicate_property(system:Term, built_in)
  458    ->  (   predicate_property(system:Term, iso)
  459        ->  Type = iso_predicate
  460        ;   Type = swi_builtin_predicate
  461        )
  462    ;   Type = library_predicate
  463    ).
  464object_class(_M:_Name/_Arity, library_predicate).
  465object_class(_Name//_Arity, dcg).
  466object_class(_M:_Name//_Arity, dcg).
  467
  468
  469		 /*******************************
  470		 *            MESSAGES		*
  471		 *******************************/
  472
  473:- multifile prolog:message//1.  474
  475prolog:message(help(not_found(What))) -->
  476    [ 'No help for ~p.'-[What], nl,
  477      'Use ?- apropos(query). to search for candidates.'-[]
  478    ].
  479prolog:message(help(no_apropos_match(Query))) -->
  480    [ 'No matches for ~p'-[Query] ].
  481prolog:message(help(apropos_matches(Pairs, Total))) -->
  482    { tty_width(W),
  483      Width is max(30,W),
  484      length(Pairs, Count)
  485    },
  486    matches(Pairs, Width),
  487    (   {Count =:= Total}
  488    ->  []
  489    ;   [ nl,
  490          ansi(fg(red), 'Showing ~D of ~D matches', [Count,Total]), nl, nl,
  491          'Use ?- apropos(Type:Query) or multiple words in Query '-[], nl,
  492          'to restrict your search.  For example:'-[], nl, nl,
  493          '  ?- apropos(iso:open).'-[], nl,
  494          '  ?- apropos(\'open file\').'-[]
  495        ]
  496    ).
  497
  498matches([], _) --> [].
  499matches([H|T], Width) -->
  500    match(H, Width),
  501    (   {T == []}
  502    ->  []
  503    ;   [nl],
  504        matches(T, Width)
  505    ).
  506
  507match(Obj-Summary, Width) -->
  508    { Left is min(40, max(20, round(Width/3))),
  509      Right is Width-Left-2,
  510      man_object_summary(Obj, ObjS, Tag),
  511      write_length(ObjS, LenObj, [portray(true), quoted(true)]),
  512      Spaces0 is Left - LenObj - 4,
  513      (   Spaces0 > 0
  514      ->  Spaces = Spaces0,
  515          SummaryLen = Right
  516      ;   Spaces = 1,
  517          SummaryLen is Right + Spaces0 - 1
  518      ),
  519      truncate(Summary, SummaryLen, SummaryE)
  520    },
  521    [ ansi([fg(default)], '~w ~p', [Tag, ObjS]),
  522      '~|~*+~w'-[Spaces, SummaryE]
  523%     '~*|~w'-[Spaces, SummaryE]		% Should eventually work
  524    ].
  525
  526truncate(Summary, Width, SummaryE) :-
  527    string_length(Summary, SL),
  528    SL > Width,
  529    !,
  530    Pre is Width-4,
  531    sub_string(Summary, 0, Pre, _, S1),
  532    string_concat(S1, " ...", SummaryE).
  533truncate(Summary, _, Summary).
  534
  535man_object_summary(section(_Level, _Num, Label, _File), Obj, 'SEC') :-
  536    atom_concat('sec:', Obj, Label),
  537    !.
  538man_object_summary(section(0, _Num, File, _Path), File, 'SEC') :- !.
  539man_object_summary(c(Name), Obj, '  C') :- !,
  540    compound_name_arguments(Obj, Name, []).
  541man_object_summary(f(Name/Arity), Name/Arity, '  F') :- !.
  542man_object_summary(Obj, Obj, Tag) :-
  543    (   object_class(Obj, Class),
  544        class_tag(Class, Tag)
  545    ->  true
  546    ;   Tag = '  ?'
  547    ).
  548
  549		 /*******************************
  550		 *            SANDBOX		*
  551		 *******************************/
  552
  553sandbox:safe_primitive(prolog_help:apropos(_)).
  554sandbox:safe_primitive(prolog_help:help(_))