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)  1985-2002, 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(online_help,
  36          [ help/1,
  37            help/0,
  38            apropos/1
  39          ]).
  40:- use_module(lists, [append/3, member/2]).
  41
  42:- if(exists_source(library(helpidx))).
  43:- use_module(library(helpidx)).
  44no_help :-
  45    fail.
  46:- else.
  47no_help :-
  48    print_message(warning, no_help_files).
  49function(_,_,_).                        % make check silent
  50predicate(_,_,_,_,_).
  51section(_,_,_,_).
  52:- endif.
  53
  54:- multifile
  55    prolog:help_hook/1,             % Generic help hook.
  56    prolog:show_help_hook/2.        % +Title, +TmpFile
  57
  58/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  59This module  defines the  online  help  facility of   SWI-Prolog.   It
  60assumes  (Prolog) index file  at library(help_index)   and  the actual
  61manual  at library(online_manual).   Output  is piped through  a  user
  62defined pager, which defaults to `more'.
  63- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  64
  65%       help/0
  66
  67help :-
  68    no_help,
  69    !.
  70help :-
  71    prolog:help_hook(help),
  72    !.
  73help :-
  74    help(help/1).
  75
  76%!  help(+Subject)
  77%
  78%   Display online help on specified subject.
  79
  80help(_) :-
  81    no_help,
  82    !.
  83help(What) :-
  84    prolog:help_hook(help(What)),
  85    !.
  86help(What) :-
  87    give_help(What).
  88
  89%!  apropos(Pattern)
  90%   Give a list of subjects that might be appropriate.
  91
  92apropos(_) :-
  93    no_help,
  94    !.
  95apropos(What) :-
  96    prolog:help_hook(apropos(What)),
  97    !.
  98apropos(What) :-
  99    give_apropos(What).
 100
 101give_help(Name/Arity) :-
 102    !,
 103    predicate(Name, Arity, _, From, To),
 104    !,
 105    show_help(Name/Arity, [From-To]).
 106give_help(Section) :-
 107    user_index(Index, Section),
 108    !,
 109    section(Index, _, From, To),
 110    show_help(Section, [From-To]).
 111give_help(Function) :-
 112    atom(Function),
 113    atom_concat('PL_', _, Function),
 114    function(Function, From, To),
 115    !,
 116    show_help(Function, [From-To]).
 117give_help(Name) :-
 118    findall(From-To, predicate(Name, _, _, From, To), Ranges),
 119    Ranges \== [],
 120    !,
 121    show_help(Name, Ranges).
 122give_help(What) :-
 123    format('No help available for ~w~n', [What]).
 124
 125%!  show_help(+ListOfRanges)
 126%   Pipe specified ranges of the manual through the user defined pager
 127
 128:- dynamic asserted_help_tmp_file/1.
 129
 130help_tmp_file(X) :-
 131    asserted_help_tmp_file(X),
 132    !.
 133help_tmp_file(X) :-
 134    tmp_file(manual, X),
 135    asserta(asserted_help_tmp_file(X)).
 136
 137write_ranges_to_file(Ranges, Outfile) :-
 138    online_manual_stream(Manual),
 139    help_tmp_file(Outfile),
 140    open(Outfile, write, Output),
 141    show_ranges(Ranges, Manual, Output),
 142    close(Manual),
 143    close(Output).
 144
 145show_help(Title, Ranges) :-
 146    predicate_property(prolog:show_help_hook(_,_), number_of_clauses(N)),
 147    N > 0,
 148    write_ranges_to_file(Ranges, TmpFile),
 149    prolog:show_help_hook(Title, TmpFile).
 150show_help(_, Ranges) :-
 151    current_prolog_flag(pipe, true),
 152    !,
 153    online_manual_stream(Manual),
 154    pager_stream(Pager),
 155    catch(show_ranges(Ranges, Manual, Pager), _, true),
 156    close(Manual),
 157    catch(close(Pager), _, true).
 158show_help(_, Ranges) :-
 159    online_manual_stream(Manual),
 160    show_ranges(Ranges, Manual, user_output).
 161
 162show_ranges([], _, _) :- !.
 163show_ranges([FromLine-ToLine|Rest], Manual, Pager) :-
 164    line_start(FromLine, From),
 165    line_start(ToLine, To),
 166    seek(Manual, From, bof, _),
 167    Range is To - From,
 168    copy_chars(Range, Manual, Pager),
 169    nl(Pager),
 170    show_ranges(Rest, Manual, Pager).
 171
 172%!  copy_chars(+Count, +FromStream, +ToStream)
 173%
 174%   Note: stream is binary to deal with byte offsets. As the data is
 175%   ISO Latin-1 anyway, this is fine.
 176
 177copy_chars(N, From, To) :-
 178    get0(From, C0),
 179    copy_chars(N, From, To, C0).
 180
 181copy_chars(N, _, _, _) :-
 182    N =< 0,
 183    !.
 184copy_chars(N, _, To, _) :-
 185    0 =:= N mod 4096,
 186    flush_output(To),
 187    fail.
 188copy_chars(N, From, To, C) :-
 189    get_byte(From, C1),
 190    (   C1 == 8,                    % backspace
 191        \+ current_prolog_flag(write_help_with_overstrike, true)
 192    ->  get_byte(From, C2),
 193        NN is N - 2,
 194        copy_chars(NN, From, To, C2)
 195    ;   put_printable(To, C),
 196        NN is N - 1,
 197        copy_chars(NN, From, To, C1)
 198    ).
 199
 200put_printable(_, 12) :- !.
 201put_printable(_, 13) :- !.
 202put_printable(_, -1) :- !.
 203put_printable(To, C) :-
 204    put_code(To, C).
 205
 206online_manual_stream(Stream) :-
 207    find_manual(Manual),
 208    open(Manual, read, Stream, [type(binary)]).
 209
 210pager_stream(Stream) :-
 211    find_pager(Pager),
 212    open(pipe(Pager), write, Stream).
 213
 214find_manual(Path) :-
 215    absolute_file_name(library('MANUAL'), Path, [access(read)]).
 216
 217find_pager(Pager) :-
 218    getenv('PAGER', Pager),
 219    !.
 220find_pager(more).
 221
 222/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 223Set the write_help_with_overstrike feature.
 224- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 225
 226set_overstrike_feature :-
 227    current_prolog_flag(write_help_with_overstrike, _),
 228    !.
 229set_overstrike_feature :-
 230    (   getenv('TERM', xterm)
 231    ->  Flag = true
 232    ;   Flag = false
 233    ),
 234    create_prolog_flag(write_help_with_overstrike, Flag, []).
 235
 236:- initialization set_overstrike_feature.
 237
 238%!  line_start(Line, Start) is det.
 239%
 240%   True if Start is the byte position at which Line starts.
 241
 242:- dynamic
 243    start_of_line/2.
 244
 245line_start(Line, Start) :-
 246    start_of_line(Line, Start),
 247    !.
 248line_start(Line, Start) :-
 249    line_index,
 250    start_of_line(Line, Start).
 251
 252
 253%!  line_index
 254%
 255%   Create index holding the byte positions for the line starts
 256
 257line_index :-
 258    start_of_line(_,_),
 259    !.
 260line_index :-
 261    online_manual_stream(Stream),
 262    set_stream(Stream, encoding(octet)),
 263    call_cleanup(line_index(Stream, 1), close(Stream)).
 264
 265line_index(Stream, LineNo) :-
 266    byte_count(Stream, ByteNo),
 267    assert(start_of_line(LineNo, ByteNo)),
 268    (   at_end_of_stream(Stream)
 269    ->  true
 270    ;   LineNo2 is LineNo+1,
 271        skip(Stream, 10),
 272        line_index(Stream, LineNo2)
 273    ).
 274
 275
 276                 /*******************************
 277                 *             APROPOS          *
 278                 *******************************/
 279
 280give_apropos(Atom) :-
 281    ignore(predicate_apropos(Atom)),
 282    ignore(function_apropos(Atom)),
 283    ignore(section_apropos(Atom)).
 284
 285apropos_predicate(Pattern, Name, Arity, Summary) :-
 286    predicate(Name, Arity, Summary, _, _),
 287    (   apropos_match(Pattern, Name)
 288    ->  true
 289    ;   apropos_match(Pattern, Summary)
 290    ).
 291
 292predicate_apropos(Pattern) :-
 293    findall(Name-Arity-Summary,
 294            apropos_predicate(Pattern, Name, Arity, Summary),
 295            Names),
 296    forall(member(Name-Arity-Summary, Names),
 297           format('~w/~w~t~30|~w~n', [Name, Arity, Summary])).
 298
 299function_apropos(Pattern) :-
 300    findall(Name, (function(Name, _, _),
 301                   apropos_match(Pattern, Name)), Names),
 302    forall(member(Name, Names),
 303           format('Interface Function~t~30|~w()~n', Name)).
 304
 305section_apropos(Pattern) :-
 306    findall(Index-Name, (section(Index, Name, _, _),
 307                   apropos_match(Pattern, Name)), Names),
 308    forall(member(Index-Name, Names),
 309           (user_index(Index, UserIndex),
 310            format('Section ~w~t~30|"~w"~n', [UserIndex, Name]))).
 311
 312apropos_match(Needle, Haystack) :-
 313    sub_atom_icasechk(Haystack, _, Needle).
 314
 315user_index(List, Index) :-
 316    is_list(List),
 317    !,
 318    to_user_index(List, S),
 319    name(Index, S).
 320user_index(List, Index) :-
 321    to_system_index(Index, List).
 322
 323to_user_index([], []).
 324to_user_index([A], S) :-
 325    !,
 326    name(A, S).
 327to_user_index([A|B], S) :-
 328    name(A, S0),
 329    append(S0, [0'-], S1),
 330    append(S1, Rest, S),
 331    to_user_index(B, Rest).
 332
 333to_system_index(A-B, I) :-
 334    !,
 335    to_system_index(A, C),
 336    integer(B),
 337    append(C, [B], I).
 338to_system_index(A, [A]) :-
 339    integer(A).
 340
 341                 /*******************************
 342                 *            MESSAGES          *
 343                 *******************************/
 344
 345:- multifile
 346    prolog:message/3.
 347
 348prolog:message(no_help_files) -->
 349    [ 'The online help files (helpidx.pl, MANUAL) are not installed.', nl,
 350      'If you installed SWI-Prolog from GIT/CVS, please consult', nl,
 351      'README.doc and README.git in the toplevel of the sources.'
 352    ].