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