! EVEX$TPU_TOC.TPU 		23-JUN-1988 12:52			Page 1

procedure evex$tpu_toc_module_ident	! Module "ident"

return ("V02-006");

endprocedure;

!++
!				Table of Contents 
!
!			        EVEX$TPU_TOC.TPU
!				23-JUN-1988 12:52
!
!	Procedure name			Page	Description
!	--------------			----	------------
!
!	evex$tpu_toc_module_ident 	   1	Module "ident"
!	evex$toc_file_name 		   2	File name+type to use
!	eve_number_pages 		   3	Insert page header line
!	eve_unnumber_pages 		   4	Remove page headers
!	eve_table_of_contents 		   5	Create table of contents
!	evex$remove_toc 		   5	Remove the existing TOC
!--
!
!       The following procedures will create a table of contents page for
!       a TPU program. To use them, invoke eve_table_of_contents. In EVE
!	this can be done by typing TABLE OF CONTENTS (abbreviatable to TABL)
!	to the command prompt. Before creating the TOC, EVE_TABLE_OF_CONTENTS
!	will remove any existing TOC V02-style Table of Contents and then
!	will invoke eve_number_pages to renumber the pages. Eve_number_pages
!	will in turn invoke eve_unnumber_pages to remove any existing page
!	numbers before doing the new ones.
!
!	Both eve_number_pages and eve_unnumber_pages can be invoked directly
!	as the EVE commands NUMBER PAGES and UNNUMBER PAGES.

! EVEX$TPU_TOC.TPU 							Page 2

procedure evex$toc_file_name		! File name+type to use

local   the_file;

the_file := get_info (current_buffer, "file_name");
if the_file = ""
then
    the_file := get_info (current_buffer, "output_file");
endif;

if (the_file = "") or (the_file = 0)
then
    return (get_info (current_buffer, "name"));
else
    return (file_parse (the_file, "", "", NAME) +
	    file_parse (the_file, "", "", TYPE));
endif;

endprocedure

! EVEX$TPU_TOC.TPU 							Page 3

!
!       Number pages
!
!       This procedure will search for a form feed and insert a header line
!       after each form feed of the form:
!
!
!       This procedure will also insert a blank first page to be used later
!       for the table of contents page.
!

procedure eve_number_pages  ! Insert page header line

local   the_severity,
	form_feed,
	page_pat,
	tab_count,
	the_file,
	page_num;

on_error
    if error <> TPU$_STRNOTFOUND
    then
	the_severity := eve$severity (error);
	eve$message (error_text, the_severity);
    endif;
    message (fao ("!UL Pages found", page_num));
    position (beginning_of (current_buffer));
    return;

endon_error;

eve_unnumber_pages;
page_num := 1;
form_feed := ascii (12);
page_pat := line_begin & form_feed;
position (beginning_of (current_buffer));

the_file := evex$toc_file_name;

! Include date in title on first page only.

tab_count := 4 - ((length (the_file) + 3) / 8);	! 3 = filename start column

if tab_count < 1
then
    tab_count := 1;
endif;

eve$insert_text (fao ("!! !AS!#* !#*	!17%D			Page !UL",
			  substr (the_file, 1, 29),	! filename
			  (length (the_file) < 29),	! space after filename-
							!   only if there's room
			  tab_count,			! tabs before date
			  0,				! date
			  page_num));			! page number
split_line;
split_line;
position (search (page_pat, FORWARD));
move_vertical (1);

! now do the other pages

tab_count := 9 - ((length (the_file) + 3) / 8);
if tab_count < 1
then
    tab_count := 1;
endif;
loop
    page_num := page_num + 1;
    eve$insert_text (fao ("!! !AS !#*	Page !UL",
			  substr (the_file, 1, 29),
			  tab_count,
			  page_num));
    split_line;
    split_line;
    position (search (page_pat, FORWARD));
    move_vertical (1);
endloop;

endprocedure


! EVEX$TPU_TOC.TPU 							Page 4

!
!	Unnumber pages
!
!	Routine to get rid of page header lines.
!

procedure eve_unnumber_pages		! Remove page headers

local   x,
	page_pat,
	whitespace;

on_error
    position (beginning_of (current_buffer));
    if (current_character = ascii (12))
    then
	erase_character (1);
	move_horizontal (1);
	if (current_offset = 0)
	then
	    append_line;
	endif;
    endif;

    return

endon_error;

whitespace := " " + ascii (9);
page_pat := "!" & match ("Page ") & span ("1234567890") &
	    (span (whitespace) | "") & line_end;

position (beginning_of (current_buffer));

loop
    x := search (page_pat, FORWARD);		! Find the header lines
    position (x);
    move_vertical (1);
!    erase (x);			!*** position dependent bug!!!
    if current_line = ""
    then
	append_line;
    endif;
    erase (x);			!*** position dependent bug!!!
endloop;

endprocedure

! EVEX$TPU_TOC.TPU 							Page 5

!
!	Table of contents
!
!	This procedure is to be run after number_pages is run over the program.
!	It looks for procedure statements and creates a table of contents of
!	the form:
!
! 	procedure name    page num   description
!
!	The description field is filled in if there is a comment on the same
!	line as the procedure statement.
!
!

procedure eve_table_of_contents		!Create table of contents

local   the_range,
	the_file,
	whitespace,
	page_pat,
	proc_pat,
	proc_name,
	proc_comment,
	temp,
	page_num,
	table_entry,
	number_of_entries,
	tab_count,
	space_count,
	old_position;

on_error
    message (str (number_of_entries) + " entries in Table of contents");
    position (beginning_of (current_buffer));
    return;
endon_error;

whitespace := " " + ascii (9);

position (beginning_of (current_buffer));
eve_unnumber_pages;
toc_position := evex$remove_toc;
eve_number_pages;

proc_pat := line_begin &
	    "PROCEDURE" &
	    span (whitespace) &
	    (scan ("(!") | remain | line_end);
page_pat := "!" & match ("Page ") & span ("1234567890") &
	    (span (whitespace) | "") & line_end;

number_of_entries := 0;
the_file := evex$toc_file_name;
tab_count := 4 - ((length (the_file)) / 16);
space_count := 8 - ((length (the_file) - ((length (the_file) / 16) * 16)) / 2);

position (toc_position);
!if mark (none) = beginning_of (current_buffer)
!then
!    move_vertical (2);
!endif;
eve$insert_text ("!++");
split_line;
eve$insert_text ("!				Table of Contents ");
split_line;
eve$insert_text ("!");
split_line;
eve$insert_text (fao ("!!!#*	!#* !AS", tab_count, space_count, the_file));
split_line;
eve$insert_text (fao ("!!				!17%D", 0));
split_line;
eve$insert_text ("!");
split_line;
eve$insert_text ("!	Procedure name			Page	Description");
split_line;
eve$insert_text ("!	--------------			----	------------");
split_line;
eve$insert_text ("!");
split_line;
eve$insert_text ("!--");
split_line;

move_vertical (-1);
toc_position := mark (NONE);
position (beginning_of (current_buffer));

loop
    the_range := search (proc_pat, FORWARD);	! Find a procedure statement
    position (the_range);
    proc_name := substr (the_range, 11, 999);	! Get procedure name
    edit (proc_name, TRIM_LEADING, TRIM_TRAILING);

    temp := search (page_pat, REVERSE);		! Get page number
    temp := substr (temp, 1, 9999);
    page_num := substr (temp, index (temp, "Page ") + 5, 999);
    page_num := int (page_num);

    proc_comment := "";

    temp := index (current_line, "!");		! Get comment from the same line
    if (temp <> 0)
    then					! Use this as the description
	proc_comment := substr (current_line, temp + 1, temp + 48);
	edit (proc_comment, TRIM_LEADING, TRIM_TRAILING, OFF);
    endif;

    tab_count := 4 - ((length (proc_name) + 1) / 8);
    table_entry := fao ("!!	!AS !#*	!4UL",
			proc_name, tab_count, page_num);

    if (proc_comment <> "")
    then
	table_entry := table_entry + "	" + proc_comment;
    endif;

    old_position := mark (NONE);		! Save current position
    position (toc_position);
    number_of_entries := number_of_entries + 1;
    eve$insert_text (table_entry);			! Insert the actual entry
    split_line;
    toc_position := mark (NONE);
    position (old_position);			! Go back for the next one
    move_vertical (1);

endloop;

endprocedure

procedure evex$remove_toc		! Remove the existing TOC

local   whitespace,
	toc_pat,
	the_range;

on_error
    message ("Not found");
endon_error;

whitespace := " " + ascii (9);
toc_pat := line_begin & "!++" & (span (whitespace) | "") &
	   line_end & "!" & span (whitespace) & "Table of Contents";

position (beginning_of (current_buffer));
the_range := search (toc_pat, FORWARD);

if the_range = 0
then
    return (beginning_of (current_buffer));
endif;

position (the_range);
loop
    if mark (NONE) = end_of (current_buffer)
    then
	return (beginning_of (current_buffer));
    endif;

    if current_character <> "!"
    then
	return (beginning_of (current_buffer));
    endif;

    exitif substr (current_line, 1, 3) = "!--";
    move_vertical (1);

endloop;

move_vertical (1);
move_horizontal (-1);
the_range := create_range (beginning_of (the_range), mark (NONE), BOLD);
erase (the_range);

return (mark (NONE));
endprocedure;
