! EVE$EXTEND.TPU 		20-JUN-1989 17:26			Page 1
! EVE - { Extensible | Easy | Efficient } Vax Editor
!
!*************************************************************************
!									 *
! © Copyright 2005 Hewlett-Packard Development Company, L.P.		 *
!									 *
! Confidential computer software. Valid license  from  HP  required  for *
! possession, use or copying. Consistent with  FAR  12.211  and  12.212, *
! Commercial Computer Software,  Computer  Software  Documentation,  and *
! Technical  Data  for  Commercial  Items  are  licensed  to  the   U.S. *
! Government under vendor's standard commercial license.		 *
!									 *
!*************************************************************************
!
!++
! FACILITY:
!	Text Processing Utility (VAXTPU)
!
! ABSTRACT:
!	This is the source program for the EVE interface extend, save, and
!	define key features. This file was obtained from the old
!	evesecini.tpu file.
!
! ENVIRONMENT:
!	VAX/VMS
!
!Author: Paul B. Patrick
!
! CREATION DATE: 13-Jul-1989
!
! MODIFIED BY:
!
!   X3.0-0  PBP	 13-Jul-1989	Created this file.
!   X3.0-1  GJJ	 22-Sep-1989	Changed references:
!				EVE$RESERVE_SCRATCH_BUFFER ==> EVE$$RESERVE_SCRATCH_BUFFER
!				EVE$RELEASE_SCRATCH_BUFFER ==> EVE$$RELEASE_SCRATCH_BUFFER
!   X3.1-1  CCC	 15-Jan-1990	Remove eve_save_extended_eve()
!   X3.1-3  CCC	 05-Mar-1990	Add back eve_save_extended_eve. The previous
!				is correct.
!   X3.1-4  CCC  02-Apr-1990	Rename eve$$build_attr_code to lse$$build_attr_
!			        code, modify lse$$define_attr, remove
!				superseded eve_save_extended_eve.
!   X3.2    DAS  24-May-1990    Removed old style get_info to save the value
!				of something temporarily set.
!   X3.2-1  SHE  20-Dec-1990	Handle EXTEND THIS with missing ENDPROCEDURE
!   X4.0-1  WC3	11-Jul-91	Replace use of eve$display_choices 
!				    w/lse$prompt_list_buffer
!   X4.0-2  DAS	14-Nov-91	Empty module init
!--

!++
!				Table of Contents 
!
!				 EVE$EXTEND.TPU
!
!	Procedure name			Page	Description
!	--------------			----	------------
!
!	eve$extend_module_ident 	   2	Ident
!	eve_extend_eve 			   7	Compile buffer or procedures
!	eve_extend_this 		   8	Extend the procedure we're in
!	lse$$define_attr			Store setting into attr arrays
!	lse$$build_attrs_code		        Build lse$$restore_mode_setttings

procedure lse$eve_extend_module_ident 
return "X4.0-2";
endprocedure;


! EVE$EXTEND.TPU 							Page 2

! Compile the procedure in the current buffer.  If name = "*", compile
! the entire buffer.  Otherwise, compile procedure with this name.
! Procedure and endprocedure statements must start in column 1.
!
! Parameters:
!
!	extend_parameter	String containing procedure name or * - input

procedure eve_extend_eve (extend_parameter)	! Compile buffer or procedures

local   procedure_name,		! Local copy of extend_parameter
	saved_mark,		! Marker for current cursor position
	this_informational,	! Keyword for display of informational messages
	search_pattern,		! Pattern used to search for start of procedure
	procedure_pattern,	! Pattern used to skip the PROCEDURE keyword
	search_range,		! Temporary range for start of/end of procedure
	case_status,		! For return status value
	start_procedure,	! Marker at beginning of "procedure"
	procedure_range,	! Range including procedure name identifier
	this_name,		! Procedure name string from procedure_range
	whole_procedure_range,	! Range including entire procedure definition
	start_mark,
	end_mark,
	found_a_procedure;	! True if procedure is found

on_error
    [TPU$_CONTROLC]:
	eve$$restore_position (saved_mark);
	eve$learn_abort;
	abort;
    [TPU$_COMPILEFAIL]:
	! VAXTPU will produce message
	eve$message (EVE$_NOTCOMPILE);
	eve$$restore_position (saved_mark);
	set (INFORMATIONAL, this_informational);
	eve$learn_abort;
	return (FALSE);
    [OTHERWISE]:
	eve$$restore_position (saved_mark);
endon_error;

if not eve$prompt_string (extend_parameter, procedure_name,
			  message_text (EVE$_PROCPROMPT, 1),
			  message_text (EVE$_NOTEXTEND, 0))
then
    eve$learn_abort;
    return (FALSE);
endif;

eve$cleanse_string (procedure_name);
change_case (procedure_name, UPPER);

position (search (ANCHOR, FORWARD));		! snap cursor - no padding
saved_mark := mark (FREE_CURSOR);
if procedure_name = "*"
then
    !
    ! ### LSE CHANGE: check for overview records
    !
    start_mark := beginning_of (current_buffer);
    end_mark := end_of (current_buffer);
    procedure_range := create_range(start_mark, end_mark, NONE);
    if NOT lse$source_only(procedure_range)
    then
	message(lse$_cantdobuffer,tpu$k_message_text, "EXTEND",
	     "- buffer contains overview records");

	delete(procedure_range);
	eve$learn_abort;
	return(FALSE);
    endif;

    !
    ! ### END LSE CHANGE
    !
    eve$message (EVE$_EXTENDING);
    this_informational := set (INFORMATIONAL, ON);
    compile (current_buffer);
    set (INFORMATIONAL, this_informational);
    eve$message (EVE$_EXTENDED);
    return (TRUE);
endif;

erase (eve$choice_buffer);
eve$message (EVE$_FINDINGPROC, 0, procedure_name);
position (beginning_of (current_buffer));
procedure_pattern := ANCHOR + "procedure" + span (eve$kt_whitespace);
search_pattern := LINE_BEGIN + "procedure" + span (eve$kt_whitespace) +
		  procedure_name;

loop
    search_range := search_quietly (search_pattern, FORWARD);
    exitif search_range = 0;
    position (beginning_of (search_range));

    ! Get entire name of this procedure

    start_procedure := mark (FREE_CURSOR);
    position (end_of (search_quietly (procedure_pattern, FORWARD)));
    move_horizontal (1);
    procedure_range := search_quietly (eve$pattern_procname, FORWARD);

    ! Find corresponding endprocedure

    search_range := search_quietly (eve$pattern_endprocedure, FORWARD);
    if search_range = 0
    then
	found_a_procedure := 0;
    else
	position (end_of (search_range));
	whole_procedure_range :=
				 create_range (start_procedure, mark (NONE),
					       NONE);
	found_a_procedure := 1;
    endif;

    ! If we have a whole procedure, check for exact match etc.

    if found_a_procedure
    then
	this_name := substr (procedure_range, 1, length (procedure_range));
	change_case (this_name, UPPER);
	if this_name = procedure_name
	then
	    erase (eve$choice_buffer);
	    eve$add_choice (this_name);
	    exitif 1;
	else
	    eve$add_choice (this_name);
	endif;
    endif;

    position (start_procedure);
    position (LINE_END);
    move_horizontal (1);
endloop;

case_status := FALSE;
case get_info (eve$choice_buffer, "record_count") from 0 to 1
    [0]:
	eve$message (EVE$_PROCNOTFOUND, 0, procedure_name);
    [1]:
	!
	! ### LSE CHANGE: check for overview records
	!
	if NOT lse$source_only(whole_procedure_range)
	then
	    message(lse$_cantdobuffer,tpu$k_message_text, "EXTEND",
		 "- buffer contains overview records");

	    delete(whole_procedure_range);
	    eve$learn_abort;
	    return(FALSE);
	endif;
	!
	! ### END LSE CHANGE
	!

	eve$message (EVE$_EXTENDING);
	this_informational := set (INFORMATIONAL, ON);
	compile (whole_procedure_range);
	set (INFORMATIONAL, this_informational);
	eve$message (EVE$_EXTENDEDBY, 0, this_name);
	case_status := TRUE;
    [OUTRANGE]:
	!
	! ### LSE CHANGE: Don't use eve$display_choices
	eve$message( EVE$_AMBPROC, 0, procedure_name );
	POSITION( BEGINNING_OF( eve$choice_buffer ) );
	lse$prompt_list_buffer( eve$choice_buffer, lse$command_window );
	POSITION( saved_mark );
	eve_extend( GET_INFO( eve$choice_buffer, 'line' ) );
	! ### END LSE CHANGE
	!
!	eve$display_choices (message_text (EVE$_AMBPROC, 0, procedure_name),
!** How do we get the synonym for the key that was defined to this command?
!			     "extend tpu ", procedure_name);
endcase;

position (saved_mark);
return (case_status);

endprocedure

! EVE$EXTEND.TPU 							Page 8

procedure eve_extend_this		! Extend the procedure we're in

local   saved_mark,
	saved_informational,
	procedure_range,
	endprocedure_range,
	name_range,
	whole_procedure_range;

on_error
    [TPU$_CONTROLC]:
	eve$$restore_position (saved_mark);
	if (get_info (saved_informational, "type") = KEYWORD)
	then set (INFORMATIONAL, saved_informational);
	endif;
	eve$learn_abort;
	abort;
    [TPU$_COMPILEFAIL]:
	! VAXTPU will produce message
	eve$message (EVE$_NOTCOMPILE);
	eve$$restore_position (saved_mark);
	if (get_info (saved_informational, "type") = KEYWORD)
	then set (INFORMATIONAL, saved_informational);
	endif;
	eve$learn_abort;
	return (FALSE);
    [OTHERWISE]:
	eve$$restore_position (saved_mark);
	if (get_info (saved_informational, "type") = KEYWORD)
	then set (INFORMATIONAL, saved_informational);
	endif;
endon_error;

position (search (ANCHOR, FORWARD));		! no padding
saved_mark := mark (FREE_CURSOR);
procedure_range := search_quietly (eve$pattern_startprocedure, REVERSE);

if procedure_range = 0
then
    eve$message (EVE$_NOPROCEDURE);
    eve$learn_abort;
    return (FALSE);
else
    endprocedure_range := search_quietly (eve$pattern_endprocedure, REVERSE);
    if endprocedure_range <> 0
    then
	! Allow cursor to be at start of line below the endprocedure
	position (endprocedure_range);
	position (LINE_END);
	move_horizontal (1);
	if (mark (FREE_CURSOR) < saved_mark) and
	    (beginning_of (endprocedure_range) > beginning_of (procedure_range))
	then
	    position (saved_mark);
	    eve$message (EVE$_NOPROCEDURE);
	    eve$learn_abort;
	    return (FALSE);
	endif;
    endif;

    position (end_of (procedure_range));
    move_horizontal (1);
    name_range := search_quietly (eve$pattern_procname, FORWARD);
    endprocedure_range := search_quietly (eve$pattern_endprocedure, FORWARD);

    ! 
    !  ### LSE CHANGE - handle missing ENDPROCEDURE
    !    
    if endprocedure_range <> 0 
    then
	whole_procedure_range := create_range (beginning_of (procedure_range),
					       end_of (endprocedure_range),
					       NONE);
    else
	! If there's no ENDPROCEDURE, try to extend to the end of the
	! buffer, and let the parser tell that ENDPROCEDURE is missing
	!
	whole_procedure_range := create_range (beginning_of (procedure_range),
					       BUFFER_END,
					       NONE);
    endif;

    !
    ! ### LSE CHANGE: check for overview records
    !
    if NOT lse$source_only(whole_procedure_range)
    then
	message(lse$_cantdobuffer,tpu$k_message_text, "EXTEND",
	     "- buffer contains overview records");

	eve$learn_abort;
	return(FALSE);
    endif;
    !
    ! ### END LSE CHANGE: check for overview records
    !

    eve$message (EVE$_EXTENDING);
    saved_informational := set (INFORMATIONAL, ON);
    compile (whole_procedure_range);
    set (INFORMATIONAL, saved_informational);
    eve$message (EVE$_EXTENDEDBY, 0,
		 substr (name_range, 1, length (name_range)));
    ! 
    !  ### END LSE CHANGE - handle missing ENDPROCEDURE
    !    


endif;

position (saved_mark);
return (TRUE);

endprocedure


! EVE$EXTEND.TPU 							Page 30

procedure lse$$define_attr	! settings to be saved accross sessions

    (attr_identifier,	! A facility code attrixed string
			! which uniquely identifies the setting.
			! Examples: "EVE$LEFT_MARGIN"
			!	    "EVE$EDIT_MODE"
			!	    "EVE$MENU_ENTRY: NO_SELECT 001"

     attr_code,		! A string containing valid TPU executable code.
			! This code should compile to a program which
			! calls code to do the setting AND CALLS
			! EVE$DEFINE_ATTR.

     display_string);	! A string containing valid TPU executable code.
			! This code should compile to a program which
			! returns a string which describes the setting.

! Validate our arguments

if get_info (attr_identifier, "type") <> STRING
then
    return (FALSE);
else
    if get_info (attr_code, "type") <> STRING
    then
	return (FALSE);
    endif;
endif;

! If the setting is a repeat, then we need not process any more.
! Make this request a no-op and don't set eve$$x_attrs_modified

if (lse$$x_attrs_array {attr_identifier} = attr_code)
    and (lse$$x_display_array {attr_identifier} = display_string)
then
    return (TRUE);
endif;

lse$$x_attrs_array {attr_identifier} := attr_code;
lse$$x_display_array {attr_identifier} := display_string;

return (TRUE);
endprocedure ! lse$$define_attr


! EVE$EXTEND.TPU 							Page 33

procedure lse$$build_attr_code ! As a range or buffer of code

    (code_mark,	! A mark were the code should be inserted

     resulting_code);   ! A range which encloses the result, or unspecified
			! if no range was built

! This routine takes all the attributes settings entered since the start of
! the editing session (including those specified from a command file or from
! the section file during startup) and creates a section of TPU code which
! restores those attributes.

! The generated code is copied to the specified mark, allowing the code to
! be inserted in a command file buffer or into a scratch buffer.

local   start_result,	! Starting mark of resulting range
	saved_window,
	saved_mark,
	attr_index;	! index into the array of code

on_error
    [TPU$_CONTROLC]:
	eve$$restore_position (saved_window, saved_mark);
	eve$learn_abort;
	abort;
    [OTHERWISE]:
	eve$$restore_position (saved_window, saved_mark);
endon_error;

!
! ### LSE replaces all eve$$x_attrs_array with lse$$x_attrs_array
!


position (search (ANCHOR, FORWARD));		! prevent padding
saved_mark := mark (FREE_CURSOR);
saved_window := current_window;

position (code_mark);
attr_index := get_info (lse$$x_attrs_array, "first");
if get_info (attr_index, "type") = STRING
then
    ! We have at least on element whose code needs to be extracted
    copy_text (lse$$x_attrs_array {attr_index});
    split_line;
    move_vertical (-1);
    start_result := mark (NONE);
    move_vertical (1);
    loop
	attr_index := get_info (lse$$x_attrs_array, "next");
	exitif get_info (attr_index, "type") <> STRING;
	copy_text (lse$$x_attrs_array {attr_index});
	split_line;
    endloop;
    resulting_code := create_range (start_result, mark (NONE), NONE);
    eve$$restore_position (saved_window, saved_mark);
    return (TRUE);
else
    ! No elements: return no range
    resulting_code := tpu$k_unspecified;
    eve$$restore_position (saved_window, saved_mark);
    return (FALSE);
endif;

endprocedure ! eve$$build_attr_code