/*  $Id$

    Part of XPCE --- The SWI-Prolog GUI toolkit

    Author:        Jan Wielemaker and Anjo Anjewierden
    E-mail:        wielemak@science.uva.nl
    WWW:           http://www.swi-prolog.org/projects/xpce/
    Copyright (C): 1985-2005, University of Amsterdam

    This program is free software; you can redistribute it and/or
    modify it under the terms of the GNU General Public License
    as published by the Free Software Foundation; either version 2
    of the License, or (at your option) any later version.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU Lesser General Public
    License along with this library; if not, write to the Free Software
    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA

    As a special exception, if you link this library with other files,
    compiled with a Free Software compiler, to produce an executable, this
    library does not by itself cause the resulting executable to be covered
    by the GNU General Public License. This exception does not however
    invalidate any other reasons why the executable file might be covered by
    the GNU General Public License.
*/

:- module(pui_help,
	  [ prolog_help/0,
	    prolog_help/1,
	    prolog_apropos/1,
	    prolog_help_topic/1,
	    prolog_explain/1
	  ]).

/** <module> XPCE-based graphical frontend for online help

This module is normally hooked into help/1 by the module swi_hooks.pl.
*/

:- use_module(library(pce)).
:- use_module(library(pce_edit)).
:- use_module(library(persistent_frame)).
:- pce_autoload(toc_window, library(pce_toc)).
:- use_module(library(helpidx)).
:- require([ start_emacs/0
	   , '$apropos_match'/2
	   , absolute_file_name/3
	   , append/3
	   , atom_length/2
	   , between/3
	   , chain_list/2
	   , atomic_list_concat/2
	   , atomic_list_concat/3
	   , default/3
	   , explain/2
	   , forall/2
	   , ignore/1
	   , maplist/3
	   , member/2
	   , send_list/3
	   , term_to_atom/2
	   , (volatile)/1
	   ]).

resource(manual,	image,	image('16x16/manual.xpm')).
resource(book,		image,  image('16x16/book2.xpm')).
resource(cfunction,	image,  image('16x16/funcdoc.xpm')).
resource(predicate,	image,  image('16x16/preddoc.xpm')).


		 /*******************************
		 *	      TOPLEVEL		*
		 *******************************/

%%	prolog_help is det.
%
%	Open SWI-Prolog graphical reference manual.

prolog_help :-
	section(S, 'Getting started quickly', _, _),
	atomic_list_concat(S, -, Id),
	term_to_atom(Spec, Id),
	prolog_help(Spec).


%%	prolog_help(+Topic) is semidet.
%
%	Open SWI-Prolog graphical reference manual   on  Topic. Fails if
%	Topic is not in the manual.

prolog_help(Topic) :-
	help_atom(Topic, Atom),
	(   atomic(Atom)
	->  once(manual_range(Atom, _)),
	    send(@pui_help_window, give_help, Atom)
	;   get(@pui_help_window, member, pui_editor, Editor),
	    send(Editor, clear),
	    forall(member(A, Atom),
		   send(@pui_help_window, give_help, A, @off, @off)),
	    send(Editor, home)
	),
	send(@pui_help_window?frame, expose).


%%	prolog_apropos(+Keyword) is det.
%
%	Do a keyword search on the manual through the object summaries.

prolog_apropos(Keywd) :-
	send(@pui_help_window, apropos, Keywd),
	send(@pui_help_window?frame, expose).


prolog_explain(Term) :-
	term_to_atom(Term, Atom),
	send(@pui_help_window, explain, Atom),
	send(@pui_help_window?frame, expose).


		 /*******************************
		 *	    MAIN WINDOW		*
		 *******************************/

:- pce_global(@pui_help_window, make_pui_help_window).

make_pui_help_window(W) :-
	send(new(W, pui_manual), open).

:- pce_begin_class(pui_manual, persistent_frame,
		   "Frame for Prolog help").

variable(history, chain, get, "History list").

initialise(F) :->
	send(F, send_super, initialise, 'SWI-Prolog help'),
	send(F, append, new(MBD, dialog)),
	send(MBD, name, menu_bar_dialog),
	send(new(E, pui_editor), below, MBD),
	send(new(dialog), below, E),
	send(F, slot, history, new(chain)),
	send(F, fill_menu_bar),
	send(F, fill_dialog),
	send(F, table_of_contents).

give_help(F, What:name, Clear:[bool], ScrollToStart:[bool]) :->
	get(F, display, Display),
	send(Display, busy_cursor),
	get(F, member, pui_editor, Editor),
	ignore(send(Editor, give_help, What, Clear, ScrollToStart)),
	send(Display, busy_cursor, @nil).

apropos(F, Atom:name) :->
	"Search summary descriptions"::
	send(F, add_history, string('apropos:%s', Atom)),
	get(F, member, pui_editor, Editor),
	give_apropos(Editor, Atom).

explain(F, Text:name) :->
	"Explain what we know about of term"::
	send(F, add_history, string('explain:%s', Text)),
	get(F, member, pui_editor, Editor),
	send(Editor, editable, @on),
	do_explain_text(Editor, Text),
	send(Editor, editable, @off).

go(F, What:name) :->
	"Handle Go menu (history)"::
	(   sub_atom(What, 0, _, A, 'apropos:')
	->  sub_atom(What, _, A, 0, For),
	    send(F, apropos, For)
	;   sub_atom(What, 0, _, A, 'explain:')
	->  sub_atom(What, _, A, 0, For),
	    send(F, explain, For)
	;   send(F, give_help, What)
	).

about(_F) :->
	send(@display, inform,
	     '%s\n\n%s\n%s',
	     'SWI-Prolog manual browser version 3.0',
	     'Jan Wielemaker',
	     'E-mail: jan@swi-prolog.org').

fill_menu_bar(F) :->
	get(F, member, menu_bar_dialog, D),
	send(D, gap, size(0, 0)),
	send(D, pen, 0),
					% the menu-bar
	send(D, append, new(MB, menu_bar)),
	send(MB, append, new(File, popup(file))),
	send(MB, append, new(Settings, popup(settings))),
	send(MB, append, new(Hist, popup(go, message(F, go, @arg1)))),
	send(MB, append, new(Help, popup(help))),

	send_list(File, append,
		  [ menu_item(exit,
			      message(F, destroy))
		  ]),

	send_list(Settings, append,
		  [ menu_item('User init file ...',
			      message(F, edit_preferences, prolog))
		  ]),

	send(Hist, update_message,
	     message(F, fill_history_popup, @receiver)),

	send_list(Help, append,
		  [ menu_item(about,
			      message(F, about),
			      end_group := @on),

		    menu_item('Package documentation ...',
			      message(F, open_package_doc)),
		    menu_item('SWI-Prolog WWW home (on www) ...',
			      message(F, open_url, pl)),
		    menu_item('SWI-Prolog FAQ (on www) ...',
			      message(F, open_url, pl_faq)),
		    menu_item('SWI-Prolog Quick Start (on www) ...',
			      message(F, open_url, pl_quick)),
		    menu_item('SWI-Prolog Manual (on www) ...',
			      message(F, open_url, pl_man)),
		    menu_item('SWI-Prolog Mailing list (on www) ...',
			      message(F, open_url, pl_mail)),
		    menu_item('SWI-Prolog Download (on www) ...',
			      message(F, open_url, pl_download),
			      end_group := @on),

		    menu_item('XPCE (GUI) Manual ...',
			      message(@prolog, manpce)),
		    menu_item('XPCE User Guide (on www) ...',
			      message(F, open_url, xpce_man),
			      end_group := @on),

		    menu_item('SWI-Prolog bug report (on www) ...',
			      message(F, open_url, pl_bugs)),
		    gap,
		    menu_item('Donate to SWI-Prolog (on www) ...',
			      message(F, open_url, pl_donate))

		  ]).


open_url(F, Id) :->
	"Open WWW browser on url with given id"::
	send(F, report, progress, 'Starting browser ...'),
	Spec =.. [Id, '.'],
	www_open_url(Spec),
	send(F, report, done).


open_package_doc(_F) :->
	(   absolute_file_name(swi('doc/packages/index.html'),
			       [ access(read),
				 file_errors(fail)
			       ],
			       Page)
	->  atom_concat('file://', Page, URL),
	    www_open_url(URL)
	;   send(@display, inform,
		 'Package documentation is not installed.  You may\n \c
		  wish to view it on http://www.swi-prolog.org')
	).


edit_preferences(_F, Which:name) :->
	"Edit preferences"::
	prolog_edit_preferences(Which).


fill_dialog(F) :->
	get(F, member, dialog, D),
					% the other items
	new(TI, text_item(on, '')),
	setof(Name, prolog_help_topic(Name), Names),
	chain_list(ValueSet, Names),
	send(TI, value_set, ValueSet),
	send(D, append, button(help,
			       message(F, give_help, TI?selection))),
	send(D, append, button(search,
			       message(F, apropos, TI?selection)),
	     right),
	send(D, append, button(explain,
			       message(F, explain, TI?selection)),
	     right),
	send(D, append, TI, right),
	send(D, append, label(reporter), right),
	send(D, default_button, help).

prolog_help_topic(Name) :-
	predicate(Name, _, _, _, _).
prolog_help_topic(Name) :-
	function(Name, _, _).


add_history(F, What:name) :->
	get(F, history, Chain),
	send(Chain, delete_all, What),
	send(Chain, prepend, What).

fill_history_popup(F, P:popup) :->
	send(P, clear),
	send(F?history, for_all,
	     message(@prolog, append_history_menu_item, P, @arg1)).

append_history_menu_item(Popup, What) :-
	atom_codes(What, S),
	phrase(section(Section), S),
	section(Section, Title, _, _), !,
	send(Popup, append, menu_item(What, @default, Title)).
append_history_menu_item(Popup, What) :-
	sub_atom(What, 0, _, A, 'apropos:'), !,
	sub_atom(What, _, A, 0, For),
	send(Popup, append, menu_item(What, @default,
				      string('Search %s', For))).
append_history_menu_item(Popup, What) :-
	sub_atom(What, 0, _, A, 'explain:'), !,
	sub_atom(What, _, A, 0, For),
	send(Popup, append, menu_item(What, @default,
				      string('Explain %s', For))).
append_history_menu_item(Popup, What) :-
	send(Popup, append, menu_item(What, @default, What)).

table_of_contents(F) :->
	(   get(F, member, pui_toc, _)
	->  true
	;   get(F, member, pui_editor, Editor),
	    new(PT, pui_toc),
	    send(PT, left, Editor?tile),
	    send(PT, expand_node, manual)
	).

:- pce_end_class.


		 /*******************************
		 *	  THE HELP EDITOR	*
		 *******************************/

:- pce_begin_class(pui_editor, view,
		   "Editor for PUI help text").

variable(displayed_ranges, prolog, get, "Currently displayed ranges").

initialise(V) :->
	send_super(V, initialise),
	get(V, editor, Editor),
	send(V, setup_isearch),
	send(Editor?text_cursor, displayed, @off),
	get(Editor, image, Image),
	send(Editor, style, button,    style(bold := @on,
					     colour := forestgreen)),
	send(Editor, style, title,     style(font := bold)),
	send(Editor, style, section,   style(font := boldlarge)),
	send(Editor, style, bold,      style(bold := @on)),
	send(Editor, style, underline, style(underline := @on)),
	send(Image, wrap, none),
	send(Image, recogniser,
	     click_gesture(left, '', single,
			   and(message(V?display, busy_cursor),
			       if(message(V, jump, ?(Image, index, @event))),
			       message(V?display, busy_cursor, @nil)))).

setup_isearch(V) :->
	get(V, editor, Editor),
	send(Editor, send_method,
	     send_method(insert_self, vector('[int]', '[char]'),
			 if(@receiver?editable == @on,
			    message(@receiver, send_class, insert_self,
				    @arg1, @arg2),
			    and(message(@receiver, isearch_forward),
				message(@receiver, '_start_isearch',@arg2))))),
	send(V?editor, send_method,
	     send_method('_isearch', vector(event_id),
			 if(@arg1 == 13,
			    and(message(@receiver, caret,
					@receiver?selection_end),
				message(@receiver, '_changed_region',
					@receiver?selection_start,
					@receiver?selection_end),
				message(@receiver, focus_function, @nil)),
			    message(@receiver, send_class, '_isearch',
				    @arg1)))).


displayed_ranges(V, Displayed:prolog) :->
	send(V, slot, displayed_ranges, Displayed),
	(   get(V?frame, member, pui_toc, TocTree)
	->  send(TocTree, select_range, Displayed)
	;   true
	).

clear(V) :->
	send_super(V, clear),
	send(V, displayed_ranges, []).

give_help(V, What:name,
     Clear:[bool], ScrollToStart:[bool],
     FailOnError:fail_on_error=[bool]) :->
	"Display help message"::
	send(V, editable, @on),
	(   manual_range(What, Ranges)
	->  (   Clear == @off
	    ->	true
	    ;	send(V, clear)
	    ),
	    manual_file(ManFile),
	    new(F, file(ManFile, binary)),
	    get(V, caret, Start),
	    send(F, open, read),
	    append_ranges(V, F, Ranges),
	    send(F, close),
	    get(V, caret, End),
	    send(V, markup, Start, End),
	    get(V, text_buffer, TB),
	    mark_titles(TB, Start, End),
	    send(V?frame, add_history, What),
	    (   ScrollToStart \== @off
	    ->  send(V, caret, Start),
		send(V, scroll_to, Start)
	    ;   true
	    ),
	    send(V, displayed_ranges, Ranges)
	;   FailOnError == @on
	->  fail
	;   (   Clear == @off
	    ->	true
	    ;	send(V, clear)
	    ),
	    send(V, format, 'Could not find help for "%s".\n', What),
	    send(V, caret, 0)
	),
	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.

append_ranges(V, F, [H|T]) :- !,
	append_ranges(V, F, H),
	append_ranges(V, F, T).
append_ranges(_, _, []) :- !.
append_ranges(V, F, FromLine-ToLine) :-
	line_start(FromLine, From),
	line_start(ToLine, To),
	send(F, seek, From),
	get(F, read, To-From, Text),
	send(Text, translate, 13, @nil),
	send(V, insert, Text),
	send(V, insert, @pui_ff),
	send(V, newline).

home(V, Where:[int]) :->
	default(Where, 0, Caret),
	send(V, scroll_to, Caret),
	send(V, caret, Caret).


		 /*******************************
		 *	       TITLES		*
		 *******************************/

:- pce_global(@pui_ff, new(string('\f'))).

mark_titles(_, From, To) :-
	From >= To, !.
mark_titles(TB, From, To) :-
	get(TB, character, From, 12), !,
	send(TB, delete, From, 1),
	(   between(1, 3, L),
	    get(TB, scan, From, line, L, start, I2),
	    get(TB, character, I2, C2),
	    C2 > 32
	->  mark_titles(TB, I2, To)
	;   true
	).
mark_titles(TB, From, To) :-
	get(TB, scan, From, line, 0, end, EL),
%	Len is EL - From,
%%	new(_, fragment(TB, From, Len, title)),
	(   get(TB, find, EL, @pui_ff, 1, start, Idx)
	->  mark_titles(TB, Idx, To)
	;   true
	).

		 /*******************************
		 *     CROSS-REFERENCE LINKS	*
		 *******************************/

:- volatile
	regex_db/2.
:- dynamic
	regex_db/2.

:- pce_global(@ul_regex, new(regex('.\b(.)'))).

%	Bug: send(regex('((.)x\\2)+$'), match, axbaxa) succeeds!
%	Bug reproduces in TCL.  Submitted to Tcl bugtracking system.

regex(bold,	  '((.)\b\\2)+').
regex(underline,  '(_\b(.))+').
regex(predicate,  '(\\w+)/(\\d+)').
regex(predicate2, '\\w+/\\[\\d+[-,]\\d+\\]').
regex(function,   'PL_\\w+\\(\\)').
regex(section,	  '([Ss]ection|[Cc]hapter)\\s+\\d+(\\.\\d+)*').
regex(location,	  '([a-zA-Z]:)?(/[-_a-zA-Z0-9~+=.]*)+:\\d+').
regex(clause,	  '\\d+-th clause of \\w+:[^\n]+/\\d+').
regex(method,     '\\w+(->|<-)\\w+').

regex_object(Id, Re) :-
	regex_db(Id, Re), !.
regex_object(Id, Re) :-
	regex(Id, Pattern),
	new(Re, regex(Pattern)),
	send(Re, compile, @on),
	send(Re, lock_object, @on),
	assert(regex_db(Id, Re)).

markup(V, From:int, To:int) :->
	get(V, text_buffer, TB),
	(   regex(Id, _),
	    regex_object(Id, Re),
	    send(Re, for_all, TB,
		 message(V, mark_fragment, @arg1),
		 From, To),
	    fail
	;   true
	).

mark_fragment(V, Re:regex) :->
        (   documented(Re, V, Type)
	->  get(Re, register_start, Start),
	    get(Re, register_size, Len),
	    new(_F, fragment(V, Start, Len, Type))
	;   true
	).

font_style(bold, bold).
font_style(underline, underline).

documented(Re, V, button) :-
	regex_db(predicate, Re), !,
	get(V, text_buffer, TB),
	get(Re, register_value, TB, 1, name, Name),
	get(Re, register_value, TB, 2, int,  Arity),
	predicate(Name, Arity, _, _, _).
documented(Re, V, Style) :-
	regex_db(Style0, Re),
        font_style(Style0, Style), !,
        get(V, text_buffer, TB),
        get(Re, register_value, TB, 0, String),
	send(@ul_regex, for_all, String,
	     message(@ul_regex, replace, String, '\\1')),
	send(Re, replace, TB, String).
documented(_, _, button).

jump(V, Caret:[int]) :->
	"Jump to current fragment"::
	(   Caret == @default
	->  get(V, caret, C)
	;   C = Caret
	),
	get(V, find_fragment, message(@arg1, overlap, C), Fragment),
	get(Fragment, string, JumpTo),
	(   send(V, give_help, JumpTo, fail_on_error := @on)
	->  true
	;   get(JumpTo, value, Atom),
	    try_to_edit(Atom)
	).

insert_section(V, Text) :->
	get(V, caret, Caret),
	(   Caret == 0
	->  Begin = Caret
	;   send(V, newline, 2),
	    get(V, caret, Begin)
	),
	send(V, insert, Text),
	get(V, caret, NewCaret),
	new(_, fragment(V, Begin, NewCaret-Begin, section)),
	send(V, newline, 2).

drop(V, Id:name) :->
	send(V, give_help, Id, fail_on_error := @on).

:- pce_end_class.


		 /*******************************
		 *       MANUAL UTILITIES	*
		 *******************************/

%%	manual_file(-File)
%
%	Find the database file of the manual.  If the manual cannot be
%	found, display an error message.

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

%%	line_start(Line, Start) is det.
%
%	True if Start is the byte position at which Line starts.

:- dynamic
	start_of_line/2.

line_start(Line, Start) :-
	start_of_line(Line, Start), !.
line_start(Line, Start) :-
	line_index,
	start_of_line(Line, Start).


%%	line_index
%
%	Create index holding the byte positions for the line starts

line_index :-
	start_of_line(_,_), !.
line_index :-
	manual_file(File),
	open(File, read, Stream, [type(binary)]),
	call_cleanup(line_index(Stream, 1), close(Stream)).

line_index(Stream, LineNo) :-
	byte_count(Stream, ByteNo),
	assert(start_of_line(LineNo, ByteNo)),
	(   at_end_of_stream(Stream)
	->  true
	;   LineNo2 is LineNo+1,
	    skip(Stream, 10),
	    line_index(Stream, LineNo2)
	).


		 /*******************************
		 *     ATOMIC SPECIFICATIONS	*
		 *******************************/

%%	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..

manual_range(What, Ranges) :-
	atom_codes(What, S),
	phrase(manual_spec(Ranges), S).

manual_spec(From-To) -->
	name_and_arity(Name, SArity),
	{ predicate(Name, Arity, _Summary, From, To),
	  (   var(SArity)
	  ->  var(Arity)
	  ;   SArity = Arity
	  )
	}.
manual_spec(From-To) -->
	pl_function(Name), !,
	{ function(Name, From, To)
	}.
manual_spec(From-To) -->
	(   "section",
	    blanks
	->  {true}
	;   {true}
	),
	section(SN),
	{ section(SN, _Summary, From, To)
	}.
manual_spec(Ranges) -->
	word(S),
	{ atom_codes(Name, S),
	  findall(From-To, predicate(Name, _, _, From, To), Ranges),
	  Ranges \== []
	}.
manual_spec(Ranges) -->
	[C1|CT],
	"/[",
	word(_),
	{ atom_codes(Name, [C1|CT]),
	  findall(From-To, predicate(Name, _, _, From, To), Ranges),
	  Ranges \== []
	}.

section([S0|ST]) -->
	integer(S0),
	subsections(ST).

subsections([S0|ST]) -->
	section_separator,
	integer(S0), !,
	subsections(ST).
subsections([]) -->
	[].

section_separator -->
	".", !.
section_separator -->
	"-", !.

name_and_arity(Name, Arity) -->
	string(NameCodes),
	"/",
	(   integer(Arity)
	->  []
	;   "_"
	), !,
	{ atom_codes(Name, NameCodes)
	}.

pl_function(Name) -->
	identifier(S),
	"()", !,
	{ atom_codes(Name, S)
	}.
pl_function(Name) -->
	"PL_",
	identifier(S), !,
	{ append("PL_", S, Chars),
	  atom_codes(Name, Chars)
	}.


string([]) -->
	[].
string([H|T]) -->
	[H],
	string(T).

word([C0|CT]) -->
	[C0],
	{ C0 > 0' }, !,
	word(CT).
word([]) -->
	[].

identifier([C0|CT]) -->
	alnum(C0), !,
	identifier(CT).
identifier([]) -->
	[].

blanks -->
	blank, !,
	blanks.
blanks -->
	[].

blank -->
	[C],
	{ C =< 32 }.

integer(N) -->
	digit(D0),
	digits(DT),
	{ number_chars(N, [D0|DT])
	}.

digits([D0|DT]) -->
	digit(D0), !,
	digits(DT).
digits([]) -->
	[].

digit(D) -->
	[D],
	{ between(0'0, 0'9, D)
	}.

alnum(C) -->
	[C],
	{ between(0'a, 0'z, C)
	; between(0'A, 0'Z, C)
	; between(0'0, 0'9, C)
	; C = 0'_
	}.


help_atom(Name/Arity, Atom) :- !,
	(   var(Arity)
	->  atom_concat(Name, '/_', Atom)
	;   atomic_list_concat([Name, /, Arity], Atom)
	).
help_atom(S1-S0, Atom) :- !,
	help_atom(S1, A0),
	atomic_list_concat([A0, '.', S0], Atom).
help_atom(C, C) :-
	integer(C), !.
help_atom(F, F) :-
	atom(F),
	sub_atom(F, 0, _, _, 'PL_'), !.
help_atom(Name, List) :-
	findall(Name/Arity, predicate(Name, Arity, _, _, _), Preds),
	Preds \== [],
	maplist(help_atom, Preds, List).

		 /*******************************
		 *	     APROSPOS		*
		 *******************************/

give_apropos(V, Atom) :-
	send(V, clear),
	send(V, editable, @on),
	ignore(predicate_apropos(V, Atom)),
	ignore(function_apropos(V, Atom)),
	ignore(section_apropos(V, Atom)),
	send(V, editable, @off),
	send(V, home).

apropos_predicate(Pattern, Name, Arity, Summary) :-
	predicate(Name, Arity, Summary, _, _),
	(   apropos_match(Pattern, Name)
	->  true
	;   apropos_match(Pattern, Summary)
	).

predicate_apropos(V, Pattern) :-
	setof(triple(Name, Arity, Summary),
	      apropos_predicate(Pattern, Name, Arity, Summary),
	      Names),
	send(V, insert_section,
	     string('Predicates from "%s":', Pattern)),
	forall(member(triple(Name, Arity, Summary), Names),
	       (   help_atom(Name/Arity, Jump),
		   append_apropos(V, Jump, Summary)
	       )).

function_apropos(V, Pattern) :-
	findall(Name, (function(Name, _, _),
		       apropos_match(Pattern, Name)), Names),
	Names \= [],
	send(V, insert_section,
	     string('Foreign language interface functions from "%s":', Pattern)),
	forall(member(Name, Names),
	       (   atom_concat(Name, '()', Jump),
		   append_apropos(V, Jump, 'Interface Function')
	       )).


section_apropos(V, Pattern) :-
	findall(Index-Name, (section(Index, Name, _, _),
			     apropos_match(Pattern, Name)), Names),
	Names \== [],
	send(V, insert_section,
	     string('Sections from "%s":', Pattern)),
	forall(member(Index-Title, Names),
	       (   atomic_list_concat(Index, '.', Jump),
		   append_apropos(V, Jump, Title)
	       )).

append_apropos(V, Jump, Summary) :-
	get(V, caret, Caret),
	send(V, format, '%-30s%s\n', Jump, Summary),
	atom_length(Jump, Len),
	new(_, fragment(V, Caret, Len, button)).

apropos_match(A, B) :-
	'$apropos_match'(A, B).			% C defined for performance

		 /*******************************
		 *	       EXPLAIN		*
		 *******************************/

do_explain_text(V, Text) :-
	catch(term_to_atom(Term, Text), _, fail), !,
	do_explain(V, Term).
do_explain_text(V, Text) :-
	send(V, clear),
	send(V, insert_section, string('Explanation for "%s"', Text)),
	send(V, format,
	     '"%s" is not correct Prolog syntax.', Text).

do_explain(V, Term) :-
	send(V, clear),
	term_to_atom(Term, Atom),
	send(V, insert_section, string('Explanation for "%s"', Atom)),
	findall(Explanation, explain(Term, Explanation), Explanations),
	get(V, caret, Start),
	forall(member(E, Explanations),
	       (   send(V, insert, string(E)),
		   send(V, newline)
	       )),
	get(V, caret, End),
	send(V, markup, Start, End),
	send(V, caret, 0),
	send(V, scroll_to, 0).


		 /*******************************
		 *	    EDIT/SOURCE		*
		 *******************************/

try_to_edit(Spec) :-
	atom_codes(Spec, S),
	phrase(source(File, Line), S), !,
	start_emacs,
	send(@emacs, goto_source_location, source_location(File, Line)).

source(File, Line) -->			% path:line
	string(FileCodes),
	":",
	integer(Line), !,
	{ atom_codes(File, FileCodes)
	}.
source(File, Line) -->			% n-th clause of module:name/arity
	integer(NClause),
	"-th clause of ",
	string(MCodes), ":",
	string(NCodes), "/",
	integer(Arity),
	{ atom_codes(Name, NCodes),
	  atom_codes(Module, MCodes),
	  functor(Head, Name, Arity),
	  nth_clause(Module:Head, NClause, CRef),
	  clause_property(CRef, file(File)),
	  clause_property(CRef, line_count(Line))
	}.
source(File, Line) -->			% XPCE method
	blanks,
	identifier(ClassChars),
	blanks,
        (   "->"
	->  { Method = '->'(Class, Selector)
	    }
	;   "<-",
	    { Method = '<-'(Class, Selector)
	    }
	),
	identifier(SelectorChars),
	{ atom_codes(Class, ClassChars),
	  atom_codes(Selector, SelectorChars),
	  pce_edit:method(Method, Obj),
	  get(Obj, source, Location),
	  Location \== @nil,
	  get(Location, file_name, File),
	  get(Location, line_no, Line)
	}.


		 /*******************************
		 *       TABLE-OF-CONTENTS	*
		 *******************************/

:- pce_begin_class(pui_toc, toc_window,
		   "Prolog manual table-of-contents").

initialise(PT) :->
	send(PT, send_super, initialise),
	send(PT, root,
	     toc_folder('Manual', manual, resource(manual), resource(book))).


		 /*******************************
		 *	       OPEN		*
		 *******************************/

select_node(PT, Id:name) :->
	"Show selected section"::
	send(PT?frame, give_help, Id).


		 /*******************************
		 *	      EXPAND		*
		 *******************************/

expand_node(PT, Node:any) :->
	expand_node(PT, Node),
	send(PT, send_super, expand_node, Node).

expand_node(PT, manual) :- !,
	forall(section([N], _, _, _),
	       send(PT, son, manual, pui_section_node([N]))).
expand_node(PT, Section) :-
	atom_codes(Section, S),
	phrase(section(List), S),
	subsection(List, I),
	forall(section(I, _, _, _),
	       send(PT, son, Section, pui_section_node(I))),
	forall(predicate_in_section(List, Name/Arity),
	       send(PT, son, Section, pui_predicate_node(Name, Arity))),
	forall(function_in_section(List, Name),
	       send(PT, son, Section, pui_function_node(Name))).

can_expand(Section) :-
	subsection(Section, Sub),
	section(Sub, _, _, _), !.
can_expand(Section) :-
	plain_predicate_in_section(Section, _), !.
can_expand(Section) :-
	plain_function_in_section(Section, _), !.


plain_predicate_in_section(Section, Name/Arity) :-
	section(Section, _, SFrom, STo),
	predicate(Name, Arity, _, PFrom, PTo),
	PFrom > SFrom,
	PTo < STo.

predicate_in_section(Section, Pred) :-
	plain_predicate_in_section(Section, Pred),
	\+ (subsection(Section, Sub),
	    plain_predicate_in_section(Sub, Pred)).

plain_function_in_section(Section, Name) :-
	section(Section, _, SFrom, STo),
	function(Name, PFrom, PTo),
	PFrom > SFrom,
	PTo < STo.

function_in_section(Section, Func) :-
	plain_function_in_section(Section, Func),
	\+ (subsection(Section, Sub),
	    plain_function_in_section(Sub, Func)).

subsection(Sec, Sub) :-
	append(Sec, [_], Sub).

select_range(PT, Ranges:prolog) :->
	"Select selections in range"::
	(   Ranges == []
	->  send(PT, selection, @nil)
	;   get(PT, node, manual, Root),
	    send(Root, collapsed, @off),
	    send(Root?sons, for_all,
		 message(@arg1, select_range, prolog(Ranges))),
	    get(PT, selection, Nodes),
	    send(PT, normalise, Nodes, y)
	).

in_range(F-T, Node, How) :-
	get(Node, start, S),
	get(Node, end, E),
	\+  (   F>=E
	    ;   T=<S
	    ),
	(   S>=F,E=<T
	->  How = all
	;   How = partial
	).
in_range([H|_], Node, How) :-
	in_range(H, Node, How).
in_range([_|T], Node, How) :-
	in_range(T, Node, How).


:- pce_end_class.

:- pce_begin_class(pui_section_node, toc_folder,
		   "Represent section of the manual").

variable(start,	int, get, "Start index").
variable(end,	int, get, "End index").

initialise(N, Index:prolog) :->
	section(Index, Title, Start, End),
	(   can_expand(Index)
	->  CanExpand = @on
	;   CanExpand = @off
	),
	atomic_list_concat(Index, '.', Id),
	send_super(N, initialise, Title?capitalise, Id,
		   resource(manual), resource(book),
		   CanExpand),
	(   font(Index, Font)
	->  send(N, font, Font)
	;   true
	),
	send(N, slot, start, Start),
	send(N, slot, end, End).

font([_], bold).

select_range(N, Ranges:prolog) :->
	"Select nodes in given ranges"::
	(   in_range(Ranges, N, all)
	->  send(N, selected, @on)
	;   in_range(Ranges, N, partial)
	->  send(N, collapsed, @off),
	    send(N?sons, for_all,
		 message(@arg1, select_range, prolog(Ranges)))
	;   true
	).

:- pce_end_class(pui_section_node).


:- pce_begin_class(pui_predicate_node, toc_file,
		   "Represent a single predicate").

variable(start,	int, get, "Start index").
variable(end,	int, get, "End index").

initialise(N, Name:name, Arity:prolog) :->
	predicate(Name, SArity, _Summary, Start, End),
	SArity =@= Arity,
	help_atom(Name/Arity, Id),
	send_super(N, initialise, Id, Id, resource(predicate)),
	send(N, slot, start, Start),
	send(N, slot, end, End).

select_range(N, Ranges:prolog) :->
	"Select nodes in given ranges"::
	(   in_range(Ranges, N, _)
	->  send(N, selected, @on)
	;   true
	).

:- pce_end_class.


:- pce_begin_class(pui_function_node, toc_file,
		   "Represent a single C-function").

variable(start,	int, get, "Start index").
variable(end,	int, get, "End index").

initialise(N, Name:name) :->
	function(Name, Start, End),
	send_super(N, initialise, Name, Name, resource(cfunction)),
	send(N, slot, start, Start),
	send(N, slot, end, End).

select_range(N, Ranges:prolog) :->
	"Select nodes in given ranges"::
	(   in_range(Ranges, N, _)
	->  send(N, selected, @on)
	;   true
	).

:- pce_end_class.


