/*  Part of SWI-Prolog

    Author:        Jan Wielemaker
    E-mail:        J.Wielemaker@vu.nl
    WWW:           http://www.swi-prolog.org
    Copyright (C): 1995-2015, University of Amsterdam
			      VU University 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 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(online,
	[ online_index/2,
	  online_index/0
	]).

user:file_search_path(library, '../packages/clpqr').

:- use_module(library(debug)).
:- use_module(user:library(clpfd)).		% Make predicates defined
:- use_module(user:library(clpr)).		% Make predicates defined
:- use_module(user:library(simplex)).		% Make predicates defined

/** <module> Generate online manual index

This library module creates the index  file   for  the online manual. By
default, as expected by help.pl, the manual is called MANUAL and resides
in the Prolog library directory. online_index/[0,2] parses this file and
creates the index file help_index.pl. Toplevel:

    * online_index/0
	Equivalent to online_index($MANUAL, $INDEX).  The two variables
	are taken from the program environment.

    * online_index/2
	Create index for `Manual' and write the output on `Index'.

@see  - The program `online' in the manual source directory
      - library help.pl which implements the online manual on top of
      this.
*/


:- multifile
	user:portray/1.

user:portray(X) :-
	is_list(X),
	ascii_list(X),
	format('"~s"', [X]).

ascii_list([]).
ascii_list([H|T]) :-
	integer(H),
	between(1, 127, H),
	ascii_list(T).

:- dynamic
	last_chapter/1,
	page/2,
	predicate/5,
	function/3,
	section/4,
	summary/3,
	end_offset/1.

cleanup :-
	retractall(last_chapter(_)),
	retractall(page(_,_)),
	retractall(predicate(_,_,_,_,_)),
	retractall(function(_,_,_)),
	retractall(section(_,_,_,_)),
	retractall(summary(_,_,_)),
	retractall(end_offset(_)).

%%	online_index is det.
%%	online_index(+In, +Out) is det.
%
%	Parse plain-text manual, creating an index by predicate, section
%	and C-function. Without arguments the input   is  taken from the
%	environment variable =MANUAL= and the output written to =INDEX=.

online_index :-
	expand_file_name('$MANUAL', [Manual]),
	expand_file_name('$INDEX', [Index]),
	online_index(Manual, Index).

online_index(In, Out) :-
	cleanup,
	load_urldefs,
	parse_summaries('summary.doc'),
	setup_call_cleanup(open(In, read, InFd),
			   read_index(InFd),
			   close(InFd)),
	setup_call_cleanup(open(Out, write, OutFd),
			   write_manual(OutFd),
			   close(OutFd)).

%%	write_manual(+Out:stream)
%
%	Write the index file (using the asserted data) to stream `out'.

write_manual(Out) :-
	format(Out, '/*  Generated by online_index/0~n~n', []),
	format(Out, '    Purpose: Index to file online_manual~n', []),
	format(Out, '*/~n~n', []),
	format(Out, ':- module(help_index,~n', []),
	format(Out, '\t[ predicate/5,~n', []),
	format(Out, '\t  section/4,~n', []),
	format(Out, '\t  function/3~n', []),
	format(Out, '\t]).~n~n', []),
	list(Out, predicate, 5),
	list(Out, section, 4),
	list(Out, function, 3).

list(Out, Name, Arity) :-
	functor(Head, Name, Arity),
	format(Out, '% Predicate ~w/~w~n~n', [Name, Arity]),
	Head,
	    format(Out, '~q.~n', Head),
	fail.
list(Out, _, _) :-
	format(Out, '~n~n', []).

%%	read_index(+In:stream)
%
%	Create an index in the prolog database.  Input is read from stream
%	`in'

read_index(In) :-
	flag(last, _, false),
	repeat,
	    (   flag(last, true, true)
	    ->	line_count(In, EndOffset),
		End is EndOffset - 1,
		assert(end_offset(End)), !
	    ;   line_count(In, Offset),
		read_page(In, Page),
		line_count(In, EndOffset),
	        identify_page(Offset, EndOffset, Page),
	        fail
	    ),
	update_offsets.

%%	read_page(In, -Page)
%
%	Read the next page from stream `in'.  Pages are separeted (by
%	dvi2tty) by ^L.  The last page is ended by the end-of-file.

read_page(In, [C|R]) :-
	get_code(In, C),
	(   C == -1
	->  flag(last, _, true),
	    fail
	;   C \== 12
	), !,
	read_page(In, R).
read_page(_, []).

%%	identify_page(+StartOffset, +EndOffset, +Page)
%
%	Parse the start of `Page' and record it in the database as a
%	page describing a certain type of data as well as were it starts
%	and ends.

identify_page(Offset, EndOffset, Page) :-
	parse(page(Type, TextOffset), Page, _),
	debug(page, '~w~n', page(Type, offsets(Offset, EndOffset, TextOffset))),
	assert(page(Type, offsets(Offset, EndOffset, TextOffset))).

parse(page(Type, Offset)) -->
	skip_blank_lines(0, Offset),
	get_line(Line),
	{ phrase(type(Type), Line)
	}.

skip_blank_lines(Sofar, Offset) -->
	blank_line(Line), !,
	{   length(Line, L),
	    NextSofar is Sofar + L
	},
	skip_blank_lines(NextSofar, Offset).
skip_blank_lines(Offset, Offset) -->
	{ true }.

blank_line([10]) -->
	char(10), !.
blank_line([C|R]) -->
	blank(C), !,
	blank_line(R).

get_line([]) -->
	char(10), !.
get_line([C|R]) -->
	[0'_, 8, C], !,
	get_line(R).
get_line([C|R]) -->
	[C, 8, 0'_], !,
	get_line(R).
get_line(L) -->
	[8,_], !,
	get_line(L).
get_line([C|R]) -->
	char(C),
	get_line(R).

%%	type(-Type)// is det.
%
%	Identify a page by its first line.

type(predicate(Name, Arity, Summary)) -->
	predicate_line(Name, Arity),
	optional_predicate_tag(_),
	end_of_input, !,
	{ (   summary(Name, SArity, Summary),
	      SArity =@= Arity
	  ->  true
	  ;   format('ERROR: No summary for ~w/~w~n', [Name, Arity]),
	      Summary = ''
	  )
        }, !.
type(section([0], 'Title Page')) -->
	skip_blanks,
	"University of Amsterdam", !.
type(section([N], 'Bibliography')) -->
	skip_blanks,
	"Bibliography", !,
	{ last_chapter([P]),
	  N is P + 1
	}.
type(section(Index, Name)) -->
	section_line(Index, Name), !.
type(section(Index, Name)) -->
	chapter_line(Index, Name), !.
type(function(Name)) -->
	function_line(Name), !.
type(section([], Name)) -->
	"Version", skip_blanks,
	number(Major), ".", number(Minor), skip_blanks,
	"Release Notes", !,
	{ format(atom(Name), 'Version ~w.~w Release Notes', [Major, Minor]) }.
type(section([], 'Incompatible changes')) -->
	"Incompatible changes", !.
type(section([], 'Compatibility notes')) -->
	"Compatibility notes", !.
type(section([], 'Index')) -->
	"Index", !.
type(unknown) -->
	skipall(Line),
	{ % trace,
          format('Unidentified: ~s~n', [Line])
	}.

end_of_input([], []).
skipall(Line, Line, []).


%%	predicate_line(-Name, -Arity) is semidet.
%
%	Identify line as describing a predicate

predicate_line(Name, Arity) -->
	optional_directive,
	optional_module,
	atom(Name),
	arguments(Arity0), !,
	(   skip_blanks, "//"			% DCG rule
	->  {Arity is Arity0+2}
	;   {Arity = Arity0}
	),
	{   (   integer(Arity),
		functor(T, Name, Arity),
		user:current_predicate(_, T)
	    ;	findall(A, (system:current_predicate(Name, T),
		            functor(T, _, A)
			   ),
			[Arity])
	    ;	system:current_predicate(Name, _)
	    ;	directive(Name/Arity)
	    ;   integer(Arity),
		functor(T, Name, Arity),
		current_arithmetic_function(T)
	    )
	->  true
	;   format(user_error, 'Not a defined predicate: ~w/~w~n', [Name, Arity])
	}.
predicate_line(Name, 0) -->
	atom(_),
	":",
	atom(Name).
predicate_line(Name, 1) -->			% prefix operator
	atom(Name),
	skip_blanks,
	predarg,
	optional_dots, !.
predicate_line(Name, 2) -->			% infix operator
	skip_blanks,
	predarg,
	skip_blanks,
	atom(Name),
	skip_blanks,
	predarg,
	skipall(_), !.
predicate_line(Name, 2) -->			% infix operator
	skip_blanks,
	predarg,
	skip_blanks,
	atom(Name),
	skip_blanks,
	predarg,
	skip_blanks,
	";",
	skip_blanks,
	predarg,
	skip_blanks.
predicate_line(Name, 0) -->
	optional_directive,
	optional_module,
	atom(Name).

directive(include/1).
directive(encoding/1).
directive(if/1).
directive(elif/1).
directive(else/0).
directive(endif/0).


%%	optional_predicate_tag(-Tags)// is det.
%
%	Skip blanks, [.*]

optional_predicate_tag(Tags) -->
	skip_blanks,
	"[", string(Codes), "]", !,
	skip_blanks,
	{ atom_codes(Atom, Codes),
	  atomic_list_concat(Tags, ', ', Atom)
	}.
optional_predicate_tag([]) -->
	"".

optional_directive -->
	":-", !,
	skip_blanks.
optional_directive -->
	{ true }.

optional_module -->
	atom(_),
	":", !.
optional_module -->
	{ true }.

atom(Name) -->
	lower_case(C1), !,
	alphas(Cs),
	{ name(Name, [C1|Cs]) }.
atom(Name) -->
	symbol(C1), !,
	symbols(Cs),
	{ name(Name, [C1|Cs]) }.
atom(Name) -->
	single(S), !,
	{ name(Name, [S]) }.
atom('|') -->
	"_".				% tex --> text conversion bug
atom('{}') -->
	"{}".

alphas([C|R]) -->
	alpha(C), !,
	alphas(R).
alphas([]) -->
	{ true }.

arguments(Args) -->
	char(0'(),
	args(Args),
	char(0')).

args(Args) -->
	skip_blanks,
	predarg(A),
	(   ","
	->  args(Args0),
	    { sum_args(Args0, A, Args) }
	;   { Args = A }
	).
args(0) -->
	[].

sum_args(N, M, Sum) :-
	integer(N),
	integer(M), !,
	Sum is N + M.
sum_args(_, _, _).

optional_dots -->
	skip_blanks,
	", ...",
	skip_blanks.
optional_dots -->
	{ true }.

predarg -->
	predarg(_).

predarg(1) -->
	mode,
	alphas(_),
	(   "/"				% Name/Arity, etc.
	->  optional_mode,
	    alphas(_)
	;   ":"
	->  term
	;   []
	), !.
predarg(_) -->
	"...", !.
predarg(1) -->
	"[]".

mode --> "?:", !.
mode --> "--", !.
mode --> "++", !.
mode -->
	char(C),
	{ string_code(_, "+-?:@!", C) }, !.

optional_mode -->
	mode, !.
optional_mode -->
	[].

term -->
	alphas(_),
	(   "("
	->  string(_),
	    ")"
	;   []
	).


%	Identify line as describing a function

function_line(Name) -->
	function_type,
	function_name(Name),
	"(",
	skipall(_).

function_type -->
	"void (*)()", !,
	skip_blanks.
function_type -->
	"(return)", !,
	skip_blanks,
	function_type.
function_type -->
	"const", !,
	skip_blanks,
	function_type.
function_type -->
	skip_blanks,
	(   alpha(_),
	    alpha(_)
	->  []
	;   "PL_"
	),
	alphas(_),
	skip_blanks,
	optional(0'(),
	optional(0'*),
	skip_blanks.

function_name(Name) -->
	"PL_", !,
	atom(Rest),
	{ concat('PL_', Rest, Name) }.
function_name(Name) -->
	"_PL_",
	atom(Rest),
	{ concat('_PL_', Rest, Name) }.

%	Identify line as starting a section

section_line(Index, Name, Line, []) :-
	phrase(section_index(Index), Line, S),
	name(Name, S).

section_index([C|R]) -->
	skip_blanks,
	number(C),
	subindex(R),
	skip_blanks.

subindex([S|R]) -->
	char(0'.), !,			% '
	number(S),
	subindex(R).
subindex([]) -->
	{ true }.

number(N) -->
	digits(D),
	{ D = [_|_] },
	{ name(N, D) }.

digits([D|R]) -->
	digit(D), !,
	digits(R).
digits([]) -->
	{ true }.

%	Identify line as starting a chapter

chapter_line(Index, Name, Line, []) :-
	phrase(chapter_index(Index), Line, S),
	retractall(last_chapter(_)),
	asserta(last_chapter(Index)),
	name(Name, S).

chapter_index([Index]) -->
	"Chapter",
	skip_blanks,
	number(Index),
	".",
	skip_blanks.

%	PRIMITIVES.

skip_blanks -->
	blank(_), !,
	skip_blanks.
skip_blanks -->
	{ true }.

blank(C) -->
	char(C),
	{ blank(C) }.

blank(9).
blank(32).

optional(List, In, Out) :-
	is_list(List), !,
	(   append(List, Out, In)
	->  true
	;   Out = In
	).
optional(C) -->
	char(C), !.
optional(_) -->
	{ true }.

symbols([C|R])-->
	symbol(C), !,
	symbols(R).
symbols([]) -->
	{ true }.

symbol(S) -->
	char(S),
	{ string_code(_, "\\#$&*+-./:<=>?@^`~", S) }.

single(S) -->
	char(S),
	{ string_code(_, "!,;|", S) }.

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

lower_case(C) -->
	char(C),
	{ between(0'a, 0'z, C) }.

upper_case(C) -->
	char(C),
	{ between(0'A, 0'Z, C) }.

alpha(C) -->
	lower_case(C), !.
alpha(C) -->
	upper_case(C), !.
alpha(C) -->
	digit(C), !.
alpha(0'_) -->
	char(0'_).

char(C, [C|L], L).

%	update_offsets

update_offsets :-
	page(section(Index, Name), offsets(F, _, O)),
	    (   next_index(Index, Next),
		page(section(Next, _), offsets(To,_,_))
	    ->  true
	    ;	end_offset(To)
	    ),
	    From is F + O,
	    assert(section(Index, Name, From, To)),
	fail.
update_offsets :-
	page(predicate(Name, Arity, Summary), offsets(F, T, O)),
	    From is F + O,
	    assert(predicate(Name, Arity, Summary, From, T)),
	fail.
update_offsets :-
	page(function(Name), offsets(F, T, O)),
	    From is F + O,
	    assert(function(Name, From, T)),
	fail.
update_offsets.

%	next_index(+This, -Next)
%	Return index of next section.  Note that the next of [3,4] both
%	can be [3-5] and [4].

next_index(L, N) :-
	(    reverse(L, [Last|Tail])
	;    reverse(L, [_,Last|Tail])
	;    reverse(L, [_,_,Last|Tail])
	;    reverse(L, [_,_,_,Last|Tail])
	),
	Next is Last + 1,
	reverse([Next|Tail], N).


		/********************************
		*       PARSE SUMMARIES         *
		********************************/

:- dynamic
	summary_file/2.

%%	parse_summaries(+File)
%
%	Reads the predicate summary chapter of the manual to get the
%	summary descriptions.  Normally this file is called summary.doc

parse_summaries(File) :-
	(   file_name_extension(Base, tex, File),
	    file_name_extension(Base, doc, DocFile),
	    exists_file(DocFile)
	->  true
	;   DocFile = File
	),
	open(DocFile, read, In),
	asserta(summary_file(File, In), Ref),
	call_cleanup(parse_summary_stream(In),
		     (	 erase(Ref),
			 close(In))).

parse_summary_stream(In) :-
	at_end_of_stream(In), !.
parse_summary_stream(In) :-
	read_line_to_codes(In, Line),
	do_summary(Line),
	parse_summary_stream(In).

do_summary(Line) :-
	parse_summary(Name, Arity, Summary, Line, []), !,
	(   Name == 0
	->  true
	;   assert(summary(Name, Arity, Summary))
	).
do_summary(Line) :-
%	trace,
	format('Failed to parse "~s"~n', [Line]).
do_summary(_) :- fail.

parse_summary(Name, Arity, Summary) -->
	(   "\\predicatesummary"
	;   "\\functionsummary"
	),
	tex_arg(Name0),
	{ atom_codes(Name0, Chars),
	  append(_, [0':|Chars1], Chars)
	->atom_codes(Name, Chars1)
	; Name = Name0
	},
	tex_arg(Arity0),
	{   integer(Arity0)
	->  Arity = Arity0
	;   true
	},
	tex_string(Summary),
	tex_comment.
parse_summary(Name, Arity, Summary) -->
	(   "\\oppredsummary"
	;   "\\opfuncsummary"
	),
	tex_arg(Name),
	tex_arg(Arity),
	tex_arg(_Type),
	tex_arg(_Priority),
	tex_string(Summary),
	tex_comment.
parse_summary(0, _, _) -->		% include a file
	"\\input",
	tex_arg(File),
	string(_),
	{ summary_file(Parent, _),
	  absolute_file_name(File, Path,
			     [ access(read),
			       relative_to(Parent)
			     ]),
	  parse_summaries(Path)
	}.
parse_summary(0, _, _) -->
	(   "%"
	;   "\\chapter"
	;   "\\section"
	;   "\\subsection"
	;   "\\subsubsection"
	;   "\\begin"
	;   "\\end"
	;   "\\newcommand"
	;   "\\pagebreak"
	;   "\\opsummary"
	;   "\\libsummary"
	;   "\\label"
	), !,
	string(_).
parse_summary(0, _, _) -->
	(   "The predicate"
	;   "suggest predicates"
	), !,
	string(_).
parse_summary(0, _, _) -->
	[].

tex_comment -->
	skip_blanks,
	(   "%"
	->  string(_)
	;   []
	).

tex_arg(Value) -->
	"{",
	tex_arg_string(String),
	"}",
	{ name(Value0, String),
	  (   atom(Value0),
	      atom_concat(\, Cmd, Value0),
	      urldef(Cmd, Value1)
	  ->  Value = Value1
	  ;   Value = Value0
	  )
	}.

tex_arg_string(Value) -->
	"{", !,
	tex_arg_string(Sub),
	"}",
	tex_arg_string(Tail),
	{ format(codes(Value), '{~s}~s', [Sub, Tail]) }.
tex_arg_string([]) -->
	peek(0'}), !.
tex_arg_string([C|T]) -->
	[C],
	tex_arg_string(T).

tex_args([A|T]) -->
	"{", !,
	tex_arg_string(A),
	"}",
	tex_args(T).
tex_args([]) -->
	[].

tex_string(S) -->
	"{",
	tex_arg_string(S0),
	"}",
	{ untex(S0, S1),
	  atom_codes(S, S1)
	}.


untex(In, Out) :-
	phrase(untex(Out), In).

tex_expand(pllib(Lib), Out) :- !,
	format(codes(Out), 'library(~s)', [Lib]).
tex_expand(predref(Name, Arity), Out) :- !,
	format(codes(Out), '~s/~s', [Name, Arity]).
tex_expand(hook(Module), Out) :- !,
	format(codes(Out), 'Hook (~s)', [Module]).
tex_expand('', []) :- !.
tex_expand(bsl([]), [0'\\]) :- !.
tex_expand(In, []) :-
	format('ERROR: could not expand TeX command ~q~n', [In]).

untex(S) -->
	"\\", !,
	tex_command(Cmd),
	tex_args(Args),
	{ TexTerm =.. [Cmd|Args],
	  tex_expand(TexTerm, S0)
	},
	untex(S1),
	{ append(S0, S1, S)
	}.
untex([H|T]) -->
	[H], !,
	untex(T).
untex([]) -->
	[].

tex_command(Cmd) -->
	tex_command_chars(Chars),
	{ atom_codes(Cmd, Chars) }.

tex_command_chars([C|T]) -->
	letter(C), !,
	tex_command_chars(T).
tex_command_chars([]) -->
	[].

letter(C) -->
	[C],
	{ between(0'a, 0'z, C) }.

%%	string(-Chars)// is nondet.
%
%	Take smalles possible string from the input.

string([]) -->
	{ true }.
string([C|R]) -->
	[C],
	string(R).

peek(C, [C|T], [C|T]).


%	NOTE: This code is copied from doc_latex.pl from PlDoc.

%%	urldef(?DefName, ?String)
%
%	True if \DefName is  a  urldef   for  String.  UrlDefs are LaTeX
%	sequences that can be used to  represent strings with symbols in
%	fragile environments. Whenever a word can   be  expressed with a
%	urldef, we will  do  this  to   enhance  the  robustness  of the
%	generated LaTeX code.

:- dynamic
	urldef/2,
	urldefs_loaded/1.

%%	load_urldefs.
%%	load_urldefs(+File)
%
%	Load   =|\urldef|=   definitions   from    File   and   populate
%	urldef_name/2. See =|pldoc.sty|= for details.

load_urldefs :-
	urldefs_loaded(_), !.
load_urldefs :-
	load_urldefs('pl.sty').

load_urldefs(File) :-
	urldefs_loaded(File), !.
load_urldefs(File) :-
	open(File, read, In),
	call_cleanup((   read_line_to_codes(In, L0),
			 process_urldefs(L0, In)),
		     close(In)),
	assert(urldefs_loaded(File)).

process_urldefs(end_of_file, _) :- !.
process_urldefs(Line, In) :-
	(   phrase(urldef(Name, String), Line)
	->  assert(urldef(Name, String))
	;   true
	),
	read_line_to_codes(In, L2),
	process_urldefs(L2, In).

urldef(Name, String) -->
	"\\urldef{\\", string(NameS), "}\\satom{", string(StringS), "}",
	ws,
	(   "%"
	->  string(_)
	;   []
	),
	eol, !,
	{ atom_codes(Name, NameS),
	  atom_codes(String, StringS)
	}.

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

eol([],[]).