1/*  Part of XPCE --- The SWI-Prolog GUI toolkit
    2
    3    Author:        Jan Wielemaker and Anjo Anjewierden
    4    E-mail:        J.Wielemaker@vu.nl
    5    WWW:           http://www.swi-prolog.org/projects/xpce/
    6    Copyright (c)  1996-2014, University of Amsterdam
    7                              VU University Amsterdam
    8    All rights reserved.
    9
   10    Redistribution and use in source and binary forms, with or without
   11    modification, are permitted provided that the following conditions
   12    are met:
   13
   14    1. Redistributions of source code must retain the above copyright
   15       notice, this list of conditions and the following disclaimer.
   16
   17    2. Redistributions in binary form must reproduce the above copyright
   18       notice, this list of conditions and the following disclaimer in
   19       the documentation and/or other materials provided with the
   20       distribution.
   21
   22    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   23    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   24    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   25    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   26    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   27    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   28    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   29    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   30    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   31    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   32    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   33    POSSIBILITY OF SUCH DAMAGE.
   34*/
   35
   36:- module(pui_help,
   37          [ prolog_help/0,
   38            prolog_help/1,
   39            prolog_apropos/1,
   40            prolog_help_topic/1,
   41            prolog_explain/1
   42          ]).

   49:- use_module(library(pce)).   50:- use_module(library(persistent_frame)).   51:- pce_autoload(toc_window, library(pce_toc)).   52:- use_module(library(helpidx)).   53:- require([ start_emacs/0
   54           , absolute_file_name/3
   55           , append/3
   56           , atom_length/2
   57           , between/3
   58           , chain_list/2
   59           , atomic_list_concat/2
   60           , atomic_list_concat/3
   61           , default/3
   62           , explain/2
   63           , forall/2
   64           , ignore/1
   65           , maplist/3
   66           , member/2
   67           , send_list/3
   68           , term_to_atom/2
   69           , (volatile)/1
   70           ]).   71
   72resource(manual,        image,  image('16x16/manual.xpm')).
   73resource(book,          image,  image('16x16/book2.xpm')).
   74resource(cfunction,     image,  image('16x16/funcdoc.xpm')).
   75resource(predicate,     image,  image('16x16/preddoc.xpm')).
   76
   77
   78                 /*******************************
   79                 *            TOPLEVEL          *
   80                 *******************************/

 prolog_help is det

Open SWI-Prolog graphical reference manual.

   86prolog_help :-
   87    section(S, 'Getting started quickly', _, _),
   88    atomic_list_concat(S, -, Id),
   89    term_to_atom(Spec, Id),
   90    prolog_help(Spec).

 prolog_help(+Topic) is semidet

Open SWI-Prolog graphical reference manual on Topic. Fails if Topic is not in the manual.

   98prolog_help(Topic) :-
   99    in_pce_thread(prolog_help_sync(Topic)).
  100
  101prolog_help_sync(Topic) :-
  102    help_atom(Topic, Atom),
  103    (   atomic(Atom)
  104    ->  once(manual_range(Atom, _)),
  105        send(@pui_help_window, give_help, Atom)
  106    ;   get(@pui_help_window, member, pui_editor, Editor),
  107        send(Editor, clear),
  108        forall(member(A, Atom),
  109               send(@pui_help_window, give_help, A, @off, @off)),
  110        send(Editor, home)
  111    ),
  112    send(@pui_help_window?frame, expose).

 prolog_apropos(+Keyword) is det

Do a keyword search on the manual through the object summaries.

  119prolog_apropos(Keywd) :-
  120    in_pce_thread(prolog_apropos_sync(Keywd)).
  121
  122prolog_apropos_sync(Keywd) :-
  123    send(@pui_help_window, apropos, Keywd),
  124    send(@pui_help_window?frame, expose).

 prolog_explain(+Term) is det

Provide all information Prolog knows about Term.

  131prolog_explain(Term) :-
  132    in_pce_thread(prolog_explain_sync(Term)).
  133
  134prolog_explain_sync(Term) :-
  135    term_to_atom(Term, Atom),
  136    send(@pui_help_window, explain, Atom),
  137    send(@pui_help_window?frame, expose).
  138
  139
  140                 /*******************************
  141                 *          MAIN WINDOW         *
  142                 *******************************/
  143
  144:- pce_global(@pui_help_window, make_pui_help_window).  145
  146make_pui_help_window(W) :-
  147    send(new(W, pui_manual), open).
  148
  149:- pce_begin_class(pui_manual, persistent_frame,
  150                   "Frame for Prolog help").
  151
  152variable(history, chain, get, "History list").
  153
  154initialise(F) :->
  155    send(F, send_super, initialise, 'SWI-Prolog help'),
  156    send(F, append, new(MBD, dialog)),
  157    send(MBD, name, menu_bar_dialog),
  158    send(new(E, pui_editor), below, MBD),
  159    send(new(dialog), below, E),
  160    send(F, slot, history, new(chain)),
  161    send(F, fill_menu_bar),
  162    send(F, fill_dialog),
  163    send(F, table_of_contents).
  164
  165give_help(F, What:name, Clear:[bool], ScrollToStart:[bool]) :->
  166    get(F, display, Display),
  167    send(Display, busy_cursor),
  168    get(F, member, pui_editor, Editor),
  169    ignore(send(Editor, give_help, What, Clear, ScrollToStart)),
  170    send(Display, busy_cursor, @nil).
  171
  172apropos(F, Atom:name) :->
  173    "Search summary descriptions"::
  174    send(F, add_history, string('apropos:%s', Atom)),
  175    get(F, member, pui_editor, Editor),
  176    give_apropos(Editor, Atom).
  177
  178explain(F, Text:name) :->
  179    "Explain what we know about of term"::
  180    send(F, add_history, string('explain:%s', Text)),
  181    get(F, member, pui_editor, Editor),
  182    send(Editor, editable, @on),
  183    do_explain_text(Editor, Text),
  184    send(Editor, editable, @off).
  185
  186go(F, What:name) :->
  187    "Handle Go menu (history)"::
  188    (   sub_atom(What, 0, _, A, 'apropos:')
  189    ->  sub_atom(What, _, A, 0, For),
  190        send(F, apropos, For)
  191    ;   sub_atom(What, 0, _, A, 'explain:')
  192    ->  sub_atom(What, _, A, 0, For),
  193        send(F, explain, For)
  194    ;   send(F, give_help, What)
  195    ).
  196
  197about(_F) :->
  198    send(@display, inform,
  199         '%s\n\n%s\n%s',
  200         'SWI-Prolog manual browser version 3.0',
  201         'Jan Wielemaker',
  202         'E-mail: jan@swi-prolog.org').
  203
  204fill_menu_bar(F) :->
  205    get(F, member, menu_bar_dialog, D),
  206    send(D, gap, size(0, 0)),
  207    send(D, pen, 0),
  208                                    % the menu-bar
  209    send(D, append, new(MB, menu_bar)),
  210    send(MB, append, new(File, popup(file))),
  211    send(MB, append, new(Settings, popup(settings))),
  212    send(MB, append, new(Hist, popup(go, message(F, go, @arg1)))),
  213    send(MB, append, new(Help, popup(help))),
  214
  215    send_list(File, append,
  216              [ menu_item(exit,
  217                          message(F, destroy))
  218              ]),
  219
  220    send_list(Settings, append,
  221              [ menu_item('User init file ...',
  222                          message(F, edit_preferences, prolog))
  223              ]),
  224
  225    send(Hist, update_message,
  226         message(F, fill_history_popup, @receiver)),
  227
  228    send_list(Help, append,
  229              [ menu_item(about,
  230                          message(F, about),
  231                          end_group := @on),
  232
  233                menu_item('Package documentation ...',
  234                          message(F, open_package_doc)),
  235                menu_item('SWI-Prolog WWW home (on www) ...',
  236                          message(F, open_url, pl)),
  237                menu_item('SWI-Prolog FAQ (on www) ...',
  238                          message(F, open_url, pl_faq)),
  239                menu_item('SWI-Prolog Quick Start (on www) ...',
  240                          message(F, open_url, pl_quick)),
  241                menu_item('SWI-Prolog Manual (on www) ...',
  242                          message(F, open_url, pl_man)),
  243                menu_item('SWI-Prolog Mailing list (on www) ...',
  244                          message(F, open_url, pl_mail)),
  245                menu_item('SWI-Prolog Download (on www) ...',
  246                          message(F, open_url, pl_download),
  247                          end_group := @on),
  248
  249                menu_item('XPCE (GUI) Manual ...',
  250                          message(@prolog, manpce)),
  251                menu_item('XPCE User Guide (on www) ...',
  252                          message(F, open_url, xpce_man),
  253                          end_group := @on),
  254
  255                menu_item('SWI-Prolog bug report (on www) ...',
  256                          message(F, open_url, pl_bugs)),
  257                gap,
  258                menu_item('Donate to SWI-Prolog (on www) ...',
  259                          message(F, open_url, pl_donate))
  260
  261              ]).
  262
  263
  264open_url(F, Id) :->
  265    "Open WWW browser on url with given id"::
  266    send(F, report, progress, 'Starting browser ...'),
  267    Spec =.. [Id, '.'],
  268    www_open_url(Spec),
  269    send(F, report, done).
  270
  271
  272open_package_doc(_F) :->
  273    (   absolute_file_name(swi('doc/packages/index.html'),
  274                           [ access(read),
  275                             file_errors(fail)
  276                           ],
  277                           Page)
  278    ->  atom_concat('file://', Page, URL),
  279        www_open_url(URL)
  280    ;   send(@display, inform,
  281             'Package documentation is not installed.  You may\n \c
  282                  wish to view it on http://www.swi-prolog.org')
  283    ).
  284
  285
  286edit_preferences(_F, Which:name) :->
  287    "Edit preferences"::
  288    prolog_edit_preferences(Which).
  289
  290
  291fill_dialog(F) :->
  292    get(F, member, dialog, D),
  293                                    % the other items
  294    new(TI, text_item(on, '')),
  295    setof(Name, prolog_help_topic(Name), Names),
  296    chain_list(ValueSet, Names),
  297    send(TI, value_set, ValueSet),
  298    send(D, append, button(help,
  299                           message(F, give_help, TI?selection))),
  300    send(D, append, button(search,
  301                           message(F, apropos, TI?selection)),
  302         right),
  303    send(D, append, button(explain,
  304                           message(F, explain, TI?selection)),
  305         right),
  306    send(D, append, TI, right),
  307    send(D, append, label(reporter), right),
  308    send(D, default_button, help).
  309
  310prolog_help_topic(Name) :-
  311    predicate(Name, _, _, _, _).
  312prolog_help_topic(Name) :-
  313    function(Name, _, _).
  314
  315
  316add_history(F, What:name) :->
  317    get(F, history, Chain),
  318    send(Chain, delete_all, What),
  319    send(Chain, prepend, What).
  320
  321fill_history_popup(F, P:popup) :->
  322    send(P, clear),
  323    send(F?history, for_all,
  324         message(@prolog, append_history_menu_item, P, @arg1)).
  325
  326append_history_menu_item(Popup, What) :-
  327    atom_codes(What, S),
  328    phrase(section(Section), S),
  329    section(Section, Title, _, _),
  330    !,
  331    send(Popup, append, menu_item(What, @default, Title)).
  332append_history_menu_item(Popup, What) :-
  333    sub_atom(What, 0, _, A, 'apropos:'),
  334    !,
  335    sub_atom(What, _, A, 0, For),
  336    send(Popup, append, menu_item(What, @default,
  337                                  string('Search %s', For))).
  338append_history_menu_item(Popup, What) :-
  339    sub_atom(What, 0, _, A, 'explain:'),
  340    !,
  341    sub_atom(What, _, A, 0, For),
  342    send(Popup, append, menu_item(What, @default,
  343                                  string('Explain %s', For))).
  344append_history_menu_item(Popup, What) :-
  345    send(Popup, append, menu_item(What, @default, What)).
  346
  347table_of_contents(F) :->
  348    (   get(F, member, pui_toc, _)
  349    ->  true
  350    ;   get(F, member, pui_editor, Editor),
  351        new(PT, pui_toc),
  352        send(PT, left, Editor?tile),
  353        send(PT, expand_node, manual)
  354    ).
  355
  356:- pce_end_class.
  357
  358
  359                 /*******************************
  360                 *        THE HELP EDITOR       *
  361                 *******************************/
  362
  363:- pce_begin_class(pui_editor, view,
  364                   "Editor for PUI help text").
  365
  366variable(displayed_ranges, prolog, get, "Currently displayed ranges").
  367
  368initialise(V) :->
  369    send_super(V, initialise),
  370    get(V, editor, Editor),
  371    send(V, setup_isearch),
  372    send(Editor?text_cursor, displayed, @off),
  373    get(Editor, image, Image),
  374    send(Editor, style, button,    style(bold := @on,
  375                                         colour := forestgreen)),
  376    send(Editor, style, title,     style(font := bold)),
  377    send(Editor, style, section,   style(font := boldlarge)),
  378    send(Editor, style, bold,      style(bold := @on)),
  379    send(Editor, style, underline, style(underline := @on)),
  380    send(Image, wrap, none),
  381    send(Image, recogniser,
  382         click_gesture(left, '', single,
  383                       and(message(V?display, busy_cursor),
  384                           if(message(V, jump, ?(Image, index, @event))),
  385                           message(V?display, busy_cursor, @nil)))).
  386
  387setup_isearch(V) :->
  388    get(V, editor, Editor),
  389    send(Editor, send_method,
  390         send_method(insert_self, vector('[int]', '[char]'),
  391                     if(@receiver?editable == @on,
  392                        message(@receiver, send_class, insert_self,
  393                                @arg1, @arg2),
  394                        and(message(@receiver, isearch_forward),
  395                            message(@receiver, '_start_isearch',@arg2))))),
  396    send(V?editor, send_method,
  397         send_method('_isearch', vector(event_id),
  398                     if(@arg1 == 13,
  399                        and(message(@receiver, caret,
  400                                    @receiver?selection_end),
  401                            message(@receiver, '_changed_region',
  402                                    @receiver?selection_start,
  403                                    @receiver?selection_end),
  404                            message(@receiver, focus_function, @nil)),
  405                        message(@receiver, send_class, '_isearch',
  406                                @arg1)))).
  407
  408
  409displayed_ranges(V, Displayed:prolog) :->
  410    send(V, slot, displayed_ranges, Displayed),
  411    (   get(V?frame, member, pui_toc, TocTree)
  412    ->  send(TocTree, select_range, Displayed)
  413    ;   true
  414    ).
  415
  416clear(V) :->
  417    send_super(V, clear),
  418    send(V, displayed_ranges, []).
  419
  420give_help(V, What:name,
  421     Clear:[bool], ScrollToStart:[bool],
  422     FailOnError:fail_on_error=[bool]) :->
  423    "Display help message"::
  424    send(V, editable, @on),
  425    (   manual_range(What, Ranges)
  426    ->  (   Clear == @off
  427        ->  true
  428        ;   send(V, clear)
  429        ),
  430        manual_file(ManFile),
  431        new(F, file(ManFile, binary)),
  432        get(V, caret, Start),
  433        send(F, open, read),
  434        append_ranges(V, F, Ranges),
  435        send(F, close),
  436        get(V, caret, End),
  437        send(V, markup, Start, End),
  438        get(V, text_buffer, TB),
  439        mark_titles(TB, Start, End),
  440        send(V?frame, add_history, What),
  441        (   ScrollToStart \== @off
  442        ->  send(V, caret, Start),
  443            send(V, scroll_to, Start)
  444        ;   true
  445        ),
  446        send(V, displayed_ranges, Ranges)
  447    ;   FailOnError == @on
  448    ->  fail
  449    ;   (   Clear == @off
  450        ->  true
  451        ;   send(V, clear)
  452        ),
  453        send(V, format, 'Could not find help for "%s".\n', What),
  454        send(V, caret, 0)
  455    ),
  456    send(V, editable, @off).

 append_ranges(+View, +File, +Ranges) is det

Note that the file is opened in binary mode to allow seeking. We must delete \r from the input to compensate for Windows cr/lf line ends. This is all ok as long as the contents of the manual file is ISO Latin 1.

  465append_ranges(V, F, [H|T]) :-
  466    !,
  467    append_ranges(V, F, H),
  468    append_ranges(V, F, T).
  469append_ranges(_, _, []) :- !.
  470append_ranges(V, F, FromLine-ToLine) :-
  471    line_start(FromLine, From),
  472    line_start(ToLine, To),
  473    send(F, seek, From),
  474    get(F, read, To-From, Text),
  475    send(Text, translate, 13, @nil),
  476    send(V, insert, Text),
  477    send(V, insert, @pui_ff),
  478    send(V, newline).
  479
  480home(V, Where:[int]) :->
  481    default(Where, 0, Caret),
  482    send(V, scroll_to, Caret),
  483    send(V, caret, Caret).
  484
  485
  486                 /*******************************
  487                 *             TITLES           *
  488                 *******************************/
  489
  490:- pce_global(@pui_ff, new(string('\f'))).
  491
  492mark_titles(_, From, To) :-
  493    From >= To,
  494    !.
  495mark_titles(TB, From, To) :-
  496    get(TB, character, From, 12),
  497    !,
  498    send(TB, delete, From, 1),
  499    (   between(1, 3, L),
  500        get(TB, scan, From, line, L, start, I2),
  501        get(TB, character, I2, C2),
  502        C2 > 32
  503    ->  mark_titles(TB, I2, To)
  504    ;   true
  505    ).
  506mark_titles(TB, From, To) :-
  507    get(TB, scan, From, line, 0, end, EL),
  508%   Len is EL - From,
  509%!  new(_, fragment(TB, From, Len, title)),
  510    (   get(TB, find, EL, @pui_ff, 1, start, Idx)
  511    ->  mark_titles(TB, Idx, To)
  512    ;   true
  513    ).
  514
  515                 /*******************************
  516                 *     CROSS-REFERENCE LINKS    *
  517                 *******************************/
  518
  519:- volatile
  520    regex_db/2.  521:- dynamic
  522    regex_db/2.  523
  524:- pce_global(@ul_regex, new(regex('.\b(.)'))).
  525
  526%       Bug: send(regex('((.)x\\2)+$'), match, axbaxa) succeeds!
  527%       Bug reproduces in TCL.  Submitted to Tcl bugtracking system.
  528
  529regex(bold,       '((.)\b\\2)+').
  530regex(underline,  '(_\b(.))+').
  531regex(predicate,  '(\\w+)/(\\d+)').
  532regex(predicate2, '\\w+/\\[\\d+[-,]\\d+\\]').
  533regex(function,   'PL_\\w+\\(\\)').
  534regex(section,    '([Ss]ection|[Cc]hapter)\\s+\\d+(\\.\\d+)*').
  535regex(location,   '([a-zA-Z]:)?(/[-_a-zA-Z0-9~+=.]*)+:\\d+').
  536regex(clause,     '\\d+-th clause of \\w+:[^\n]+/\\d+').
  537regex(method,     '\\w+(->|<-)\\w+').
  538
  539regex_object(Id, Re) :-
  540    regex_db(Id, Re),
  541    !.
  542regex_object(Id, Re) :-
  543    regex(Id, Pattern),
  544    new(Re, regex(Pattern)),
  545    send(Re, compile, @on),
  546    send(Re, lock_object, @on),
  547    assert(regex_db(Id, Re)).
  548
  549markup(V, From:int, To:int) :->
  550    get(V, text_buffer, TB),
  551    (   regex(Id, _),
  552        regex_object(Id, Re),
  553        send(Re, for_all, TB,
  554             message(V, mark_fragment, @arg1),
  555             From, To),
  556        fail
  557    ;   true
  558    ).
  559
  560mark_fragment(V, Re:regex) :->
  561    (   documented(Re, V, Type)
  562    ->  get(Re, register_start, Start),
  563        get(Re, register_size, Len),
  564        new(_F, fragment(V, Start, Len, Type))
  565    ;   true
  566    ).
  567
  568font_style(bold, bold).
  569font_style(underline, underline).
  570
  571documented(Re, V, button) :-
  572    regex_db(predicate, Re),
  573    !,
  574    get(V, text_buffer, TB),
  575    get(Re, register_value, TB, 1, name, Name),
  576    get(Re, register_value, TB, 2, int,  Arity),
  577    predicate(Name, Arity, _, _, _).
  578documented(Re, V, Style) :-
  579    regex_db(Style0, Re),
  580    font_style(Style0, Style),
  581    !,
  582    get(V, text_buffer, TB),
  583    get(Re, register_value, TB, 0, String),
  584    send(@ul_regex, for_all, String,
  585         message(@ul_regex, replace, String, '\\1')),
  586    send(Re, replace, TB, String).
  587documented(_, _, button).
  588
  589jump(V, Caret:[int]) :->
  590    "Jump to current fragment"::
  591    (   Caret == @default
  592    ->  get(V, caret, C)
  593    ;   C = Caret
  594    ),
  595    get(V, find_fragment, message(@arg1, overlap, C), Fragment),
  596    get(Fragment, string, JumpTo),
  597    (   send(V, give_help, JumpTo, fail_on_error := @on)
  598    ->  true
  599    ;   get(JumpTo, value, Atom),
  600        try_to_edit(Atom)
  601    ).
  602
  603insert_section(V, Text) :->
  604    get(V, caret, Caret),
  605    (   Caret == 0
  606    ->  Begin = Caret
  607    ;   send(V, newline, 2),
  608        get(V, caret, Begin)
  609    ),
  610    send(V, insert, Text),
  611    get(V, caret, NewCaret),
  612    new(_, fragment(V, Begin, NewCaret-Begin, section)),
  613    send(V, newline, 2).
  614
  615drop(V, Id:name) :->
  616    send(V, give_help, Id, fail_on_error := @on).
  617
  618:- pce_end_class.
  619
  620
  621                 /*******************************
  622                 *       MANUAL UTILITIES       *
  623                 *******************************/

 manual_file(-File)

Find the database file of the manual. If the manual cannot be found, display an error message.

  630manual_file(File) :-
  631    absolute_file_name(library('MANUAL'), File,
  632                       [access(read)]),
  633    !.
  634manual_file(_File) :-
  635    send(@nil, report, error, 'Can''t find manual database MANUAL'),
  636    fail.

 line_start(Line, Start) is det

True if Start is the byte position at which Line starts.

  642:- dynamic
  643    start_of_line/2.  644
  645line_start(Line, Start) :-
  646    start_of_line(Line, Start),
  647    !.
  648line_start(Line, Start) :-
  649    line_index,
  650    start_of_line(Line, Start).

 line_index

Create index holding the byte positions for the line starts

  657line_index :-
  658    start_of_line(_,_),
  659    !.
  660line_index :-
  661    manual_file(File),
  662    open(File, read, Stream, [type(binary)]),
  663    call_cleanup(line_index(Stream, 1), close(Stream)).
  664
  665line_index(Stream, LineNo) :-
  666    byte_count(Stream, ByteNo),
  667    assert(start_of_line(LineNo, ByteNo)),
  668    (   at_end_of_stream(Stream)
  669    ->  true
  670    ;   LineNo2 is LineNo+1,
  671        skip(Stream, 10),
  672        line_index(Stream, LineNo2)
  673    ).
  674
  675
  676                 /*******************************
  677                 *     ATOMIC SPECIFICATIONS    *
  678                 *******************************/

 manual_range(+What, -Range:From-To) is nondet

Find the character range for the given help topic, which is of the form

• name/arity
• function()
• n.m..

  689manual_range(What, Ranges) :-
  690    atom_codes(What, S),
  691    phrase(manual_spec(Ranges), S).
  692
  693manual_spec(From-To) -->
  694    name_and_arity(Name, SArity),
  695    { predicate(Name, Arity, _Summary, From, To),
  696      (   var(SArity)
  697      ->  var(Arity)
  698      ;   SArity = Arity
  699      )
  700    }.
  701manual_spec(From-To) -->
  702    pl_function(Name),
  703    !,
  704    { function(Name, From, To)
  705    }.
  706manual_spec(From-To) -->
  707    (   "section",
  708        blanks
  709    ->  {true}
  710    ;   {true}
  711    ),
  712    section(SN),
  713    { section(SN, _Summary, From, To)
  714    }.
  715manual_spec(Ranges) -->
  716    word(S),
  717    { atom_codes(Name, S),
  718      findall(From-To, predicate(Name, _, _, From, To), Ranges),
  719      Ranges \== []
  720    }.
  721manual_spec(Ranges) -->
  722    [C1|CT],
  723    "/[",
  724    word(_),
  725    { atom_codes(Name, [C1|CT]),
  726      findall(From-To, predicate(Name, _, _, From, To), Ranges),
  727      Ranges \== []
  728    }.
  729
  730section([S0|ST]) -->
  731    integer(S0),
  732    subsections(ST).
  733
  734subsections([S0|ST]) -->
  735    section_separator,
  736    integer(S0),
  737    !,
  738    subsections(ST).
  739subsections([]) -->
  740    [].
  741
  742section_separator -->
  743    ".",
  744    !.
  745section_separator -->
  746    "-",
  747    !.
  748
  749name_and_arity(Name, Arity) -->
  750    string(NameCodes),
  751    "/",
  752    (   integer(Arity)
  753    ->  []
  754    ;   "_"
  755    ),
  756    !,
  757    { atom_codes(Name, NameCodes)
  758    }.
  759
  760pl_function(Name) -->
  761    identifier(S),
  762    "()",
  763    !,
  764    { atom_codes(Name, S)
  765    }.
  766pl_function(Name) -->
  767    "PL_",
  768    identifier(S),
  769    !,
  770    { append("PL_", S, Chars),
  771      atom_codes(Name, Chars)
  772    }.
  773
  774
  775string([]) -->
  776    [].
  777string([H|T]) -->
  778    [H],
  779    string(T).
  780
  781word([C0|CT]) -->
  782    [C0],
  783    { C0 > 0' },
  784    !,
  785    word(CT).
  786word([]) -->
  787    [].
  788
  789identifier([C0|CT]) -->
  790    alnum(C0),
  791    !,
  792    identifier(CT).
  793identifier([]) -->
  794    [].
  795
  796blanks -->
  797    blank,
  798    !,
  799    blanks.
  800blanks -->
  801    [].
  802
  803blank -->
  804    [C],
  805    { C =< 32 }.
  806
  807integer(N) -->
  808    digit(D0),
  809    digits(DT),
  810    { number_chars(N, [D0|DT])
  811    }.
  812
  813digits([D0|DT]) -->
  814    digit(D0),
  815    !,
  816    digits(DT).
  817digits([]) -->
  818    [].
  819
  820digit(D) -->
  821    [D],
  822    { between(0'0, 0'9, D)
  823    }.
  824
  825alnum(C) -->
  826    [C],
  827    { between(0'a, 0'z, C)
  828    ; between(0'A, 0'Z, C)
  829    ; between(0'0, 0'9, C)
  830    ; C = 0'_
  831    }.
  832
  833
  834help_atom(Name/Arity, Atom) :-
  835    !,
  836    (   var(Arity)
  837    ->  atom_concat(Name, '/_', Atom)
  838    ;   atomic_list_concat([Name, /, Arity], Atom)
  839    ).
  840help_atom(S1-S0, Atom) :-
  841    !,
  842    help_atom(S1, A0),
  843    atomic_list_concat([A0, '.', S0], Atom).
  844help_atom(C, C) :-
  845    integer(C),
  846    !.
  847help_atom(F, F) :-
  848    atom(F),
  849    sub_atom(F, 0, _, _, 'PL_'),
  850    !.
  851help_atom(Name, List) :-
  852    findall(Name/Arity, predicate(Name, Arity, _, _, _), Preds),
  853    Preds \== [],
  854    maplist(help_atom, Preds, List).
  855
  856                 /*******************************
  857                 *           APROSPOS           *
  858                 *******************************/
  859
  860give_apropos(V, Atom) :-
  861    send(V, clear),
  862    send(V, editable, @on),
  863    ignore(predicate_apropos(V, Atom)),
  864    ignore(function_apropos(V, Atom)),
  865    ignore(section_apropos(V, Atom)),
  866    send(V, editable, @off),
  867    send(V, home).
  868
  869apropos_predicate(Pattern, Name, Arity, Summary) :-
  870    predicate(Name, Arity, Summary, _, _),
  871    (   apropos_match(Pattern, Name)
  872    ->  true
  873    ;   apropos_match(Pattern, Summary)
  874    ).
  875
  876predicate_apropos(V, Pattern) :-
  877    setof(triple(Name, Arity, Summary),
  878          apropos_predicate(Pattern, Name, Arity, Summary),
  879          Names),
  880    send(V, insert_section,
  881         string('Predicates from "%s":', Pattern)),
  882    forall(member(triple(Name, Arity, Summary), Names),
  883           (   help_atom(Name/Arity, Jump),
  884               append_apropos(V, Jump, Summary)
  885           )).
  886
  887function_apropos(V, Pattern) :-
  888    findall(Name, (function(Name, _, _),
  889                   apropos_match(Pattern, Name)), Names),
  890    Names \= [],
  891    send(V, insert_section,
  892         string('Foreign language interface functions from "%s":', Pattern)),
  893    forall(member(Name, Names),
  894           (   atom_concat(Name, '()', Jump),
  895               append_apropos(V, Jump, 'Interface Function')
  896           )).
  897
  898
  899section_apropos(V, Pattern) :-
  900    findall(Index-Name, (section(Index, Name, _, _),
  901                         apropos_match(Pattern, Name)), Names),
  902    Names \== [],
  903    send(V, insert_section,
  904         string('Sections from "%s":', Pattern)),
  905    forall(member(Index-Title, Names),
  906           (   atomic_list_concat(Index, '.', Jump),
  907               append_apropos(V, Jump, Title)
  908           )).
  909
  910append_apropos(V, Jump, Summary) :-
  911    get(V, caret, Caret),
  912    send(V, format, '%-30s%s\n', Jump, Summary),
  913    atom_length(Jump, Len),
  914    new(_, fragment(V, Caret, Len, button)).
  915
  916apropos_match(Needle, Haystack) :-
  917    sub_atom_icasechk(Haystack, _, Needle).
  918
  919
  920                 /*******************************
  921                 *             EXPLAIN          *
  922                 *******************************/
  923
  924do_explain_text(V, Text) :-
  925    catch(term_to_atom(Term, Text), _, fail),
  926    !,
  927    do_explain(V, Term).
  928do_explain_text(V, Text) :-
  929    send(V, clear),
  930    send(V, insert_section, string('Explanation for "%s"', Text)),
  931    send(V, format,
  932         '"%s" is not correct Prolog syntax.', Text).
  933
  934do_explain(V, Term) :-
  935    send(V, clear),
  936    term_to_atom(Term, Atom),
  937    send(V, insert_section, string('Explanation for "%s"', Atom)),
  938    findall(Explanation, explain(Term, Explanation), Explanations),
  939    get(V, caret, Start),
  940    forall(member(E, Explanations),
  941           (   send(V, insert, string(E)),
  942               send(V, newline)
  943           )),
  944    get(V, caret, End),
  945    send(V, markup, Start, End),
  946    send(V, caret, 0),
  947    send(V, scroll_to, 0).
  948
  949
  950                 /*******************************
  951                 *          EDIT/SOURCE         *
  952                 *******************************/
  953
  954try_to_edit(Spec) :-
  955    atom_codes(Spec, S),
  956    phrase(source(File, Line), S),
  957    !,
  958    start_emacs,
  959    send(@emacs, goto_source_location, source_location(File, Line)).
  960
  961source(File, Line) -->                  % path:line
  962    string(FileCodes),
  963    ":",
  964    integer(Line),
  965    !,
  966    { atom_codes(File, FileCodes)
  967    }.
  968source(File, Line) -->                  % n-th clause of module:name/arity
  969    integer(NClause),
  970    "-th clause of ",
  971    string(MCodes), ":",
  972    string(NCodes), "/",
  973    integer(Arity),
  974    { atom_codes(Name, NCodes),
  975      atom_codes(Module, MCodes),
  976      functor(Head, Name, Arity),
  977      nth_clause(Module:Head, NClause, CRef),
  978      clause_property(CRef, file(File)),
  979      clause_property(CRef, line_count(Line))
  980    }.
  981source(File, Line) -->                  % XPCE method
  982    blanks,
  983    identifier(ClassChars),
  984    blanks,
  985    (   "->"
  986    ->  { Method = '->'(Class, Selector)
  987        }
  988    ;   "<-",
  989        { Method = '<-'(Class, Selector)
  990        }
  991    ),
  992    identifier(SelectorChars),
  993    { atom_codes(Class, ClassChars),
  994      atom_codes(Selector, SelectorChars),
  995      pce_edit:method(Method, Obj),
  996      get(Obj, source, Location),
  997      Location \== @nil,
  998      get(Location, file_name, File),
  999      get(Location, line_no, Line)
 1000    }.
 1001
 1002
 1003                 /*******************************
 1004                 *       TABLE-OF-CONTENTS      *
 1005                 *******************************/
 1006
 1007:- pce_begin_class(pui_toc, toc_window,
 1008                   "Prolog manual table-of-contents").
 1009
 1010initialise(PT) :->
 1011    send(PT, send_super, initialise),
 1012    send(PT, root,
 1013         toc_folder('Manual', manual, resource(manual), resource(book))).
 1014
 1015
 1016                 /*******************************
 1017                 *             OPEN             *
 1018                 *******************************/
 1019
 1020select_node(PT, Id:name) :->
 1021    "Show selected section"::
 1022    send(PT?frame, give_help, Id).
 1023
 1024
 1025                 /*******************************
 1026                 *            EXPAND            *
 1027                 *******************************/
 1028
 1029expand_node(PT, Node:any) :->
 1030    expand_node(PT, Node),
 1031    send(PT, send_super, expand_node, Node).
 1032
 1033expand_node(PT, manual) :-
 1034    !,
 1035    forall(section([N], _, _, _),
 1036           send(PT, son, manual, pui_section_node([N]))).
 1037expand_node(PT, Section) :-
 1038    atom_codes(Section, S),
 1039    phrase(section(List), S),
 1040    subsection(List, I),
 1041    forall(section(I, _, _, _),
 1042           send(PT, son, Section, pui_section_node(I))),
 1043    forall(predicate_in_section(List, Name/Arity),
 1044           send(PT, son, Section, pui_predicate_node(Name, Arity))),
 1045    forall(function_in_section(List, Name),
 1046           send(PT, son, Section, pui_function_node(Name))).
 1047
 1048can_expand(Section) :-
 1049    subsection(Section, Sub),
 1050    section(Sub, _, _, _),
 1051    !.
 1052can_expand(Section) :-
 1053    plain_predicate_in_section(Section, _),
 1054    !.
 1055can_expand(Section) :-
 1056    plain_function_in_section(Section, _),
 1057    !.
 1058
 1059
 1060plain_predicate_in_section(Section, Name/Arity) :-
 1061    section(Section, _, SFrom, STo),
 1062    predicate(Name, Arity, _, PFrom, PTo),
 1063    PFrom > SFrom,
 1064    PTo < STo.
 1065
 1066predicate_in_section(Section, Pred) :-
 1067    plain_predicate_in_section(Section, Pred),
 1068    \+ (subsection(Section, Sub),
 1069        plain_predicate_in_section(Sub, Pred)).
 1070
 1071plain_function_in_section(Section, Name) :-
 1072    section(Section, _, SFrom, STo),
 1073    function(Name, PFrom, PTo),
 1074    PFrom > SFrom,
 1075    PTo < STo.
 1076
 1077function_in_section(Section, Func) :-
 1078    plain_function_in_section(Section, Func),
 1079    \+ (subsection(Section, Sub),
 1080        plain_function_in_section(Sub, Func)).
 1081
 1082subsection(Sec, Sub) :-
 1083    append(Sec, [_], Sub).
 1084
 1085select_range(PT, Ranges:prolog) :->
 1086    "Select selections in range"::
 1087    (   Ranges == []
 1088    ->  send(PT, selection, @nil)
 1089    ;   get(PT, node, manual, Root),
 1090        send(Root, collapsed, @off),
 1091        send(Root?sons, for_all,
 1092             message(@arg1, select_range, prolog(Ranges))),
 1093        get(PT, selection, Nodes),
 1094        send(PT, normalise, Nodes, y)
 1095    ).
 1096
 1097in_range(F-T, Node, How) :-
 1098    get(Node, start, S),
 1099    get(Node, end, E),
 1100    \+  (   F>=E
 1101        ;   T=<S
 1102        ),
 1103    (   S>=F,E=<T
 1104    ->  How = all
 1105    ;   How = partial
 1106    ).
 1107in_range([H|_], Node, How) :-
 1108    in_range(H, Node, How).
 1109in_range([_|T], Node, How) :-
 1110    in_range(T, Node, How).
 1111
 1112
 1113:- pce_end_class.
 1114
 1115:- pce_begin_class(pui_section_node, toc_folder,
 1116                   "Represent section of the manual").
 1117
 1118variable(start, int, get, "Start index").
 1119variable(end,   int, get, "End index").
 1120
 1121initialise(N, Index:prolog) :->
 1122    section(Index, Title, Start, End),
 1123    (   can_expand(Index)
 1124    ->  CanExpand = @on
 1125    ;   CanExpand = @off
 1126    ),
 1127    atomic_list_concat(Index, '.', Id),
 1128    send_super(N, initialise, Title?capitalise, Id,
 1129               resource(manual), resource(book),
 1130               CanExpand),
 1131    (   font(Index, Font)
 1132    ->  send(N, font, Font)
 1133    ;   true
 1134    ),
 1135    send(N, slot, start, Start),
 1136    send(N, slot, end, End).
 1137
 1138font([_], bold).
 1139
 1140select_range(N, Ranges:prolog) :->
 1141    "Select nodes in given ranges"::
 1142    (   in_range(Ranges, N, all)
 1143    ->  send(N, selected, @on)
 1144    ;   in_range(Ranges, N, partial)
 1145    ->  send(N, collapsed, @off),
 1146        send(N?sons, for_all,
 1147             message(@arg1, select_range, prolog(Ranges)))
 1148    ;   true
 1149    ).
 1150
 1151:- pce_end_class(pui_section_node).
 1152
 1153
 1154:- pce_begin_class(pui_predicate_node, toc_file,
 1155                   "Represent a single predicate").
 1156
 1157variable(start, int, get, "Start index").
 1158variable(end,   int, get, "End index").
 1159
 1160initialise(N, Name:name, Arity:prolog) :->
 1161    predicate(Name, SArity, _Summary, Start, End),
 1162    SArity =@= Arity,
 1163    help_atom(Name/Arity, Id),
 1164    send_super(N, initialise, Id, Id, resource(predicate)),
 1165    send(N, slot, start, Start),
 1166    send(N, slot, end, End).
 1167
 1168select_range(N, Ranges:prolog) :->
 1169    "Select nodes in given ranges"::
 1170    (   in_range(Ranges, N, _)
 1171    ->  send(N, selected, @on)
 1172    ;   true
 1173    ).
 1174
 1175:- pce_end_class.
 1176
 1177
 1178:- pce_begin_class(pui_function_node, toc_file,
 1179                   "Represent a single C-function").
 1180
 1181variable(start, int, get, "Start index").
 1182variable(end,   int, get, "End index").
 1183
 1184initialise(N, Name:name) :->
 1185    function(Name, Start, End),
 1186    send_super(N, initialise, Name, Name, resource(cfunction)),
 1187    send(N, slot, start, Start),
 1188    send(N, slot, end, End).
 1189
 1190select_range(N, Ranges:prolog) :->
 1191    "Select nodes in given ranges"::
 1192    (   in_range(Ranges, N, _)
 1193    ->  send(N, selected, @on)
 1194    ;   true
 1195    ).
 1196
 1197:- pce_end_class