/*  $Id: plindex.pl,v 1.11 2001/05/22 12:21:37 jan Exp $

    Copyright (c) 1990 Jan Wielemaker. All rights reserved.
    jan@swi.psy.uva.nl

    Purpose: Index online manual
    Last Modified: 11 Octover 1995:
		Updated for character_escapes handling
*/

:- module(online,
	[ online_index/2
	, online_index/0
	]).

:- set_feature(character_escapes, true).

user:portray(X) :-
	proper_list(X),
	ascii_list(X),
	format('"~s"', [X]).
	
ascii_list([]).
ascii_list([H|T]) :-
	integer(H),
	between(0, 127, H),
	ascii_list(T).

:- dynamic
	last_chapter/1.

/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
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 Unix environment.

online_index(+Manual, +Index)
	Create index for `Manual' and write the output on `Index'.

SEE ALSO

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

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

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

online_index(In, Out) :-
	parse_summaries('summary.doc'),
	open(In, read, _, [alias(in)]),
	read_index,
	close(in),
	open(Out, write, _, [alias(out)]),
	write_manual,
	close(out).

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

write_manual :-
	format(out, '/*  $Id', []),
	format(out, '$~n~n', []),
	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, '	[ predicate/5~n', []),
	format(out, '	, section/4~n', []),
	format(out, '	, function/3~n', []),
	format(out, '	]).~n~n', []),
	list(predicate, 5),
	list(section, 4),
	list(function, 3).

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

%	read_index/0
%	Create an index in the prolog database.  Input is read from stream
%	`in'

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

%	read_page(-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([C|R]) :-
	get0(in, C),
	(   C == -1
	->  flag(last, _, true),
	    fail
	;   C \== 12
	), !,
	read_page(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, _),
%	format('~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).

%	Typing on the first line

type(predicate(Name, Arity, Summary)) -->
	predicate_line(Name, Arity),
	end_of_input, !,
	{ (   summary(Name, Arity, Summary)
	  ->  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(unknown) -->
	skipall(Line),
	{ % trace,
          format('Unidentified: ~s~n', [Line])
	}.
type(_, _) -->
	{ fail }.

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

%	Identify line as describing a predicate

predicate_line(Name, Arity) -->
	optional_module,
	optional_directive,
	atom(Name),
	arguments(Arity), !,
	{   (   integer(Arity),
		functor(T, Name, Arity),
		user:current_predicate(_, T)
	    ;	user:current_predicate(Name, _)
	    ;   current_arithmetic_function(T)
	    )
	->  true
	;   format('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_module,
	atom(Name).

optional_directive -->
	starts(":- "), !,
	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

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

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

args(Args) -->
	skip_blanks,
	predarg(A),
	optional(0',),
	args(Args0),
	{sum_args(Args0, A, Args)}.
args(0) -->
	[].

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

optional_dots -->
	skip_blanks,
	starts(", ..."),
	skip_blanks.
optional_dots -->
	{ true }.

predarg -->
	predarg(_).

predarg(1) -->
	input_output,
	alphas(_),
	optional(0'/),
	optional_input_output,
	alphas(_), !.
predarg(_) -->
	"...", !.
predarg(1) -->
	starts("[]").

input_output -->
	char(C),
	{ memberchk(C, "+-?:") }.

optional_input_output -->
	input_output, !.
optional_input_output -->
	{ true }.

%	Identify line as describing a function

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

function_type -->
	"void (*)()", !,
	skip_blanks.
function_type -->
	"const", !,
	skip_blanks,
	function_type.
function_type -->
	skip_blanks,
	(   alpha(_),
	    alpha(_)
	;   "PL_"
	),
	atom(_),
	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.

starts([]) -->
	!.
starts([C|R]) -->
	char(C),
	starts(R).

%	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),
	{ memberchk(S, "\\#$&*+-./:<=>?@^`~") }.

single(S) -->
	char(S),
	{ memberchk(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         *
		********************************/
	
%	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) :-
	open(File, read, In),
	parse_summary_stream(In),
	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(Arity),
	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(_),
	{ parse_summaries(File)
	}.
parse_summary(0, _, _) -->
	(   "%"
	;   "\\chapter"
	;   "\\section"
	;   "\\subsection"
	;   "\\begin"
	;   "\\end"
	;   "\\newcommand"
	;   "\\pagebreak"
	;   "\\opsummary"
	), !,
	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(Value, String) }.

tex_arg_string(Value) -->
	"{", !,
	tex_arg_string(Sub),
	"}",
	tex_arg_string(Tail),
	{flatten(["{", Sub, "}", Tail], Value)}.
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) :- !,
	flatten(["library(", Lib, ")"], Out).
tex_expand(predref(Name, Arity), Out) :- !,
	flatten([Name, "/", Arity], Out).
tex_expand(hook(Module), Out) :- !,
	flatten(["Hook (", Module, ")"], Out).
tex_expand(In, "") :-
	format('ERROR: could not expand TeX command ~w~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("") -->
	{ true }.
string([C|R]) -->
	[C],
	string(R).

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