MODULE TPUPLUS IDENT "921203"
!
! ----- [LOMASKY.EVE]TPUPLUS.TPU$COMMAND -----
! ----- Contains all of the TPUPLUS code which is being used in our -----
! ----- section files -----
!
!   PROCEDURE EVE_DELETE_CURRENT_BUFFER
!   PROCEDURE EVE_DISPLAY_CHARACTER
!   PROCEDURE EVE_PAD_LINES (COLUMN_TO_PAD_TO)
!   PROCEDURE EVE_SET_AUTO_INDENT
!   PROCEDURE EVE_SET_NOAUTO_INDENT
!   PROCEDURE EVE_SORT_BUFFER (BUFFER_TO_SORT)
!   PROCEDURE EVE_SPELL (SPELL_PARAMETER)
!   PROCEDURE EVE_TRIM
!   PROCEDURE EVE_WRITE_SELECT
! TPUPLUS utility procedures:
!   PROCEDURE TPUPLUS$Line_mode
!   PROCEDURE TPUPLUS$next_Token (additional_terms, term_char)
!   PROCEDURE TPUPLUS$range_specification (spec)
!   PROCEDURE TPUPLUS$delete_range ! support routine for line mode(delete cmd)
!   PROCEDURE TPUPLUS$line_mode_substitute
!   PROCEDURE TPUPLUS$find_sub_delimiter (line_length, cp)
!   PROCEDURE TPUPLUS$single_search_replace (string1, string2, query)
!   PROCEDURE TPUPLUS$global_search_replace (string1, string2, query)
!   PROCEDURE TPUPLUS$Replace_String
!   PROCEDURE TPUPLUS_INDENT_LINE
!   PROCEDURE TPUPLUS$WRITE_RANGE (RANGE_TO_WRITE)
! Sort utility procedures:
!   PROCEDURE TPUPLUS_FIND_BUFFER (BUFFER_NAME)
!   PROCEDURE TPUPLUS$SHELL_SORT (BUFFER_TO_SORT)
!   PROCEDURE TPUPLUS$STRING_COMPARE (STRING1, STRING2)
! Spell checker utility procedures
!   PROCEDURE CHECK_FOR_PARAGRAPH_BREAK
!   PROCEDURE SPELL_CHECK_RANGE (SPELL_RANGE)
!
!   version 5.03-004 - 921203 - Brian Lomasky:
!	Changed prompt message to include Ctrl/Z response
!   version 5.03-003 - 921123 - Brian Lomasky:
!	Changed message when SPELL encounters a word greater than 32 chars long
!   version 5.03-002 - 920106 - Brian Lomasky:
!	Removed the SET line mode commands
!	Renamed SPELL2 to SPELL and changed to call my spelling checker
!   version 5.03-001 - 920103 - Brian Lomasky:
!	Removed EVE_SET_ENTITY_WORD command
!	Removed Gold/KP8 key mapping for FILL command
!	Changed Gold/KP7 key mapping for TPUPLUS line mode to F8
!	Added Shift/Delete key mapping for DELETE CURRENT BUFFER
!	Changed all PCE and EDTP character sequences to TPUPLUS
!
PROCEDURE TPUPLUS$Line_mode

LOCAL   command_name ,
        continue_cmd,
        new_file_name,
        eve_cmd_line,
        term_char ,
        old_position,
        original_line,
        org_line_length,
        new_line_length,
        command_index,
        this_line_number;

on_error
endon_error;

continue_cmd    := "CONTINUE";
!
! Keep looping until we see something that will cause us to exit.
! Right now this is only the Change or Continue commands
!
LOOP
!    IF (Num_lines = TPUPLUS$Single_line) THEN
        TPUPLUS$x_line := READ_LINE ('EDIT Command >');
!    ELSE
!        message ('Type CONTINUE to exit from line mode to screen mode');
!        TPUPLUS$x_line := READ_LINE ('*');
!    ENDIF;
! Save the original line in case this is a substitute command
    original_line   := TPUPLUS$x_line;
    org_line_length := LENGTH (original_line);

! If they don't type something, set up the continue command
    if org_line_length = 0 then
        TPUPLUS$x_line := continue_cmd;
    endif;

! upshift the command line
    change_case (TPUPLUS$x_line, upper);

! if continue cmd, return
    if TPUPLUS$x_line = continue_cmd then
        message (" ");
        message (" ");
        return;
    endif;

! Did user enter a number only ???
    this_line_number := int (TPUPLUS$x_line);
    if this_line_number <> 0 then
! go to line number entered
        eve_line (this_line_number, "");
        return;
    endif;

! What command is it?
    command_name := TPUPLUS$next_token ('/', term_char);
    if command_name = "" then
        if TPUPLUS$x_line <> "" then
            command_name := TPUPLUS$x_line;
        endif;
    endif;
    command_index := index (TPUPLUS$x_commands, (' ' + command_name));
    command_index := ((command_index + TPUPLUS$x_command_length)-1) /
        TPUPLUS$x_command_length;

!TPUPLUS$x_commands             :=
!    ' CONTINUE   DELETE     EXIT       SUBSTITUTE';

    case command_index from 1 to 4
        [outrange]:
            eve_do (original_line);
        [1]:
            message (" ");
            message (" ");
            return;
        [2]:
            TPUPLUS$delete_range;
        [3]:
! What command is it?
            new_file_name := TPUPLUS$next_token ('/', term_char);
            if new_file_name = "" then
                exit;
            else
                eve_write_file (new_file_name);
                exit;
            endif;
        [4]:
! Get the original line back because the case is important
            new_line_length := LENGTH (TPUPLUS$x_line);
            TPUPLUS$x_line :=
                substr (original_line, (org_line_length - new_line_length) + 1,
                new_line_length);
! Skip over blanks and tabs looking for a valid substitution delimiter
            loop
                exitif (term_char <> ' ') AND (term_char <> '	');
                term_char := substr (TPUPLUS$x_line, 1, 1);
                TPUPLUS$x_line := substr (TPUPLUS$x_line, 2, length (TPUPLUS$x_line)-1);
            endloop;
            TPUPLUS$x_subs_term := term_char;
            old_position := mark (none);
            TPUPLUS$line_mode_substitute;
            POSITION (old_position);
    endcase;

    update (current_window);
!    if (Num_lines = TPUPLUS$Single_line) then
        return;
!    endif;
endloop;

ENDPROCEDURE;

!****************************************
PROCEDURE TPUPLUS$next_Token (additional_terms, term_char)
!
! Line mode command parser. This will return the next token from the line.
!
!  TPUPLUS$x_line -  what is left of the  current line mode command
!
LOCAL   line_length ,   ! Length of line
        terminators ,   ! Token terminators
        cp ,            ! Current pointer into line
        sp ,            ! Saved pointer into the line
        char ,          ! Current character
        quoted ,        ! True if in a quoted string
        token ;         ! Token to return
terminators := TPUPLUS$x_terminators + additional_terms;

if get_info (TPUPLUS$x_line, "TYPE") = STRING then
    edit (TPUPLUS$x_line, trim_leading);
    line_length := length (TPUPLUS$x_line);
else
    line_length := 0;
endif;
term_char := "";
If line_length = 0 then
    RETURN "";
endif;
!
! Did we find =,   as in =buffer
!
char := substr (TPUPLUS$x_line, 1, 1);
if char  = '=' then
    TPUPLUS$x_line := substr (TPUPLUS$x_line, 2, line_length);
    term_char := '=';
    return '=';
endif;
!
! look for the end of the thing we are on.
!
! See if the thing we found is a terminator. If so, just
! return that.
if index (terminators, char) <> 0 then
    term_char := char;
    TPUPLUS$x_line := substr (TPUPLUS$x_line, 2, line_length);
    return "";
endif;
cp := 2;
quoted := 0;
loop
    exitif cp > line_length;
    char := substr (TPUPLUS$x_line, cp, 1);
    exitif (index (terminators, char) <> 0) and (quoted = 0);
    if char = '"' then
        quoted := 1-quoted;
    endif;
    cp := cp + 1;
endloop;

term_char := char;
token := substr (TPUPLUS$x_line, 1, (cp - 1));
TPUPLUS$x_line := substr (TPUPLUS$x_line, (cp + 1), line_length);
return token;

ENDPROCEDURE;

!****************************************
PROCEDURE TPUPLUS$range_specification (spec)
!
! Process a range specifier. We will return either a range or a buffer.
!
LOCAL   r_index,
        first_mark ;
!
! What did they give us
!
r_index := index (TPUPLUS$x_ranges, (' ' + spec));
r_index := ((r_index + TPUPLUS$x_range_length - 1) / TPUPLUS$x_range_length);

!TPUPLUS$x_ranges               :=
!    ' BEFORE  REST    WHOLE  ';

CASE r_index from 1 TO 3
    [outrange]:
        message ('Unsupported range specification:  ' + spec);
        return 0;
    [1]:
!BEFORE
        first_mark := select (none);
        position (beginning_of (current_buffer));
        r_index := select_range;
        return r_index;
    [2]:
!REST
        first_mark := select (none);
        position (end_of (current_buffer));
        r_index := select_range;
        return r_index;
    [3]:
!WHOLE
        r_index := current_buffer;
        return r_index;
ENDCASE;

message ('Unsupported range specification:  ' + spec);
return 0;

ENDPROCEDURE;

!****************************************
PROCEDURE TPUPLUS$delete_range ! support routine for line mode(delete cmd)

LOCAL   buffer_ptr,
        buffer_name,
        range_specifier ,
        term_char ,
        text_to_delete ;

!
! Now check for what to delete.
! I am only going to support WHOLE, REST, and BEFORE
!
range_specifier := TPUPLUS$next_token (':', term_char);
if (range_specifier = "") then
    message ("No range specified -- use WHOLE, REST, or BEFORE");
    return 0;
endif;

text_to_delete := TPUPLUS$range_specification (range_specifier);
if (text_to_delete = 0) then
    return 0;
endif;
erase(text_to_delete);

ENDPROCEDURE;

!****************************************
PROCEDURE TPUPLUS$line_mode_substitute
!
! This procedure searches and replaces a given string by a second string
! If found and more than one or global replacement requested, then the search
! and replace will continue until EOB or string-not-found@
!
! The command line reads:
!           SUBSTITUTE /old_string/new_string/ [whole] [/type]
!                     ^                        [rest]
!                     ^-- space is req'd.      [before]
!
!        delimiter (TPUPLUS$x_subs_term)
!        string to be replaced
!        delimiter (same as above)
!        new string
!        delimiter (same as above)
!        either 'whole' if from beginning to end of buffer
!            or first occurrence in the current line
!
! Parse the rest of the line looking for old string and new string
!

LOCAL   cp, 
        line_length, 
        old_index, 
        temp_mark, 
        offset, 
        whole_set, 
        query_set,
        rest_set, 
        before_set, 
        type_set, 
        old_string, 
        new_string;

whole_set   := "NO";
type_set    := "NO";
query_set   := "NO";
before_set  := "NO";
temp_mark   := mark (none);
line_length := length (TPUPLUS$x_line);
if (TPUPLUS$find_sub_delimiter (line_length, cp) = 0) then
    return 0;
endif;

old_string  := substr (TPUPLUS$x_line, 1, (cp - 1));
TPUPLUS$x_line := substr (TPUPLUS$x_line, (cp + 1), line_length);
line_length := length (TPUPLUS$x_line);
if (TPUPLUS$find_sub_delimiter (line_length, cp) = 0) then
    return 0;
endif;

new_string := substr (TPUPLUS$x_line, 1, (cp - 1));

if (cp = line_length) then          ! There are no options
! perform the EVE substitute command (eve_replace)
    eve_replace (old_string, new_string);
    return;
else
    TPUPLUS$x_line := substr (TPUPLUS$x_line, (cp + 1), line_length);
    edit (TPUPLUS$x_line, TRIM, UPPER, OFF);
! See if WHOLE was typed
    offset := INDEX (TPUPLUS$x_line, 'W');
    IF (offset <> 0) THEN
        whole_set := "YES";
    ENDIF;
! See if REST was typed
    offset := INDEX (TPUPLUS$x_line, 'R');
    IF (offset <> 0) THEN
        rest_set := "YES";
    ENDIF;
! See if BEFORE was typed
    offset := INDEX (TPUPLUS$x_line, 'B');
    IF (offset <> 0) THEN
        before_set := "YES";
    ENDIF;
! See if TYPE was typed
    offset := INDEX (TPUPLUS$x_line, '/T');
    IF (offset <> 0) THEN
        type_set := "YES";
    ENDIF;
! If no type use the eve_replace routine
    if type_set = "NO" then
        if whole_set = "YES" then
            position (beginning_of (current_buffer));
            eve_replace (old_string, new_string);
            eve$position_in_middle (temp_mark);
        else
            if rest_set = "YES" then
                set (forward, current_buffer);
                eve$set_status_line (current_window);
                eve_replace (old_string, new_string);
                eve$position_in_middle (temp_mark);
            else
                if before_set = "YES" then
                    set (reverse, current_buffer);
                    eve$set_status_line (current_window);
                    eve_replace (old_string, new_string);
                    eve$position_in_middle (temp_mark);
                else
                    eve_replace (old_string, new_string);
                    eve$position_in_middle (temp_mark);
                endif;
            endif;
        endif;
    else
! else use the TPUPLUS routines
        if whole_set = "YES" then
            position (beginning_of (current_buffer));
            TPUPLUS$global_search_replace (old_string, new_string, query_set);
            eve$position_in_middle (temp_mark);
        else
            if rest_set = "YES" then
                set (forward, current_buffer);
                eve$set_status_line (current_window);
                loop
                    test_result := TPUPLUS$single_search_replace (old_string,
                        new_string, query_set);
                    exitif test_result = 0;
                endloop;
                eve$position_in_middle (temp_mark);
            else
                if before_set = "YES" then
                    set (forward, current_buffer);
                    eve$set_status_line (current_window);
                    loop
                        test_result := TPUPLUS$single_search_replace
                            (old_string, new_string, query_set);
                        exitif test_result = 0;
                    endloop;
                    eve$position_in_middle (temp_mark);
                else
                    TPUPLUS$single_search_replace
                        (old_string, new_string, query_set);
                    eve$position_in_middle (temp_mark);
                endif;
            endif;
        endif;
    endif;
endif;

return 1;

ENDPROCEDURE;

!****************************************
PROCEDURE TPUPLUS$find_sub_delimiter (line_length, cp)
! Find the next delimiter in the command line
cp := 1;
loop
    if cp > line_length then
        message ('Delimiter for SUBSTITUTE could not be found');
        return 0;
    endif;
    exitif (substr (TPUPLUS$x_line, cp, 1) = TPUPLUS$x_subs_term);
    cp := cp + 1;
endloop;
return 1;

ENDPROCEDURE;

!****************************************
PROCEDURE TPUPLUS$single_search_replace (string1, string2, query)
!
! This procedure performs a search through the current
! buffer and replaces one string with another

LOCAL temp_mark, src_range, response, this_direction;

! Return to caller if string not found
on_error
    message ('No occurrences of ' + string1 + ' found in current line');
    position (temp_mark);
    return 0;
endon_error;

temp_mark       := mark(none);
this_direction  := current_direction;

if this_direction = forward then
    src_range := SEARCH (string1, forward); ! Search returns a range if found
else
    src_range := SEARCH (string1, reverse); ! Search returns a range if found
endif;

! If not found we never gets here
position(beginning_of(src_range));          ! Move to right place

loop
    if query = "YES" THEN
        response := READ_LINE('Replace String? (Y,N) ',1);
        CHANGE_CASE(response,UPPER);
    endif;
    if (response = 'Y') or (query = "NO") then
        erase (src_range);                  ! Remove first string
        position(end_of(src_range));        ! Move to right place
        copy_text(string2);                 ! Replace with second string
        message('First occurrence of ' + string1 + ' replaced with '
            + string2 + ' in current line');
        return 1;
    else
        IF response = 'N' THEN
            return 1;
        else
            message(' Please use Y(es) or N(o).');
        endif;
    endif;
endloop;

ENDPROCEDURE;

!****************************************
PROCEDURE TPUPLUS$global_search_replace (string1, string2, query)
!
! This procedure performs a search through the current
! buffer and replaces one string with another

LOCAL   msg_text,
        src_range,
        replacement_count,
        response,
        temp_line,
        rev_range,
        stop;

! Return to caller if string not found
on_error
    msg_text := FAO ('!UL  replacement!%S', replacement_count) + ' of '
                    + string1 + ' with ' + string2 + ' in current buffer';
    MESSAGE (msg_text);
    return 0;
endon_error;

replacement_count := 0;
response := "Y" ;
stop := "NO";

LOOP
    src_range := SEARCH (string1, forward);  ! Search returns a range if found
    POSITION (BEGINNING_OF (src_range));	! Move to right place
    Rev_range := CREATE_RANGE(BEGINNING_OF(src_range),END_OF(src_range),
    			REVERSE);
    update(current_window);

    loop
        IF query = "YES" THEN
            response := READ_LINE('Replace string? (Y, N, A, Q) ',1);
            CHANGE_CASE(response,UPPER);
        endif;
        IF response = "Y" THEN
            Rev_range := 0;
            ERASE (src_range);            ! Remove first string
            POSITION (END_OF (src_range));    ! Move to right place
            COPY_TEXT (string2);        ! Replace with second string
            replacement_count := replacement_count + 1;
            EXITIF response = "Y";
        else
            IF response = "N" THEN
                Rev_range := 0;
                MOVE_HORIZONTAL(+1);
                EXITIF response = "N";
            endif;
            IF response = "A" THEN
                Rev_range := 0;
                query := "NO";
                response := "Y";
                ERASE (src_range);              ! Remove first string
                POSITION (END_OF (src_range));  ! Move to right place
                COPY_TEXT (string2);            ! Replace with second string
                replacement_count := replacement_count + 1;
                EXITIF response = "Y";
            ELSE
                IF response = "Q" THEN
                    stop := "YES";
                    Rev_range := 0;
                    EXITIF stop = "YES";
                ELSE
                    MESSAGE(" Please use Y(es), N(o), A(ll), or Q(uit)");
                endif;
            endif;
        endif;
    endloop;
    EXITIF stop = "YES";
ENDLOOP;
RETURN 1;
ENDPROCEDURE;

!****************************************
PROCEDURE TPUPLUS$Replace_String

LOCAL   temp_pos, 
        string_1, 
        string_2, 
        query, 
        query_type;

    temp_pos := MARK (NONE);
    POSITION (BEGINNING_OF (CURRENT_BUFFER));
    string_1 := READ_LINE ("Old String? ");
    IF string_1 = "" then
        return 0;
    endif;
    message (" Replace: " + string_1);

    string_2 := READ_LINE ("New string? ");
    message (" With: " + string_2);

    query := READ_LINE (" Enter /Q for Query: ",2);
    change_case (query, upper);
    IF query = "/Q" THEN
        query_type := "YES";
    else
        query_type := "NO";
    endif;

    TPUPLUS$global_search_replace (string_1, string_2, query_type);
    position (temp_pos);
    refresh;

ENDPROCEDURE;
!
!
!
PROCEDURE EVE_DELETE_CURRENT_BUFFER
  local this_buffer, buffer_name;
  this_buffer := current_buffer;
  buffer_name := GET_INFO (this_buffer, "NAME" );
  eve_delete_buffer (buffer_name);
ENDPROCEDURE;
!
!
!
PROCEDURE EVE_SET_AUTO_INDENT

tpuplus_auto_indent := 1;
define_key ("tpuplus_indent_line",
            ret_key,                        "tpuplus_auto_indent (auto indent)",
            eve$x_standard_keys);

ENDPROCEDURE;
!
!
!
PROCEDURE EVE_SET_NOAUTO_INDENT

tpuplus_auto_indent := 0;
define_key ("eve_return",
            ret_key,                        "return",
            eve$x_standard_keys);

ENDPROCEDURE;
!
!
!
PROCEDURE TPUPLUS_INDENT_LINE

Local previous_line, space_char, tab_char, null_char, this_col,
    this_char, this_offset, length_prev_line;

if tpuplus_auto_indent = 0 then
    message ("Auto indentation not set -- procedure not executed");
    return;
endif;

if current_buffer = eve$command_buffer then
    eve_return;
    return;
endif;

space_char      := " ";
tab_char        := ascii(9);
null_char       := "";

this_offset := 1;
eve_return;
move_vertical (-this_offset);
previous_line       := current_line;
length_prev_line    := length (previous_line);
move_vertical (this_offset);

this_col := 0;

loop
    this_col    := this_col + 1;
    exitif this_col > length_prev_line;

    this_char   := substr (previous_line, this_col, 1);
    if length_prev_line > 0 then
        if (this_char <> space_char) and (this_char <> tab_char) and
            (this_char <> null_char) then
            eve$$indent_line_to (this_col);
            return;
        else
            if this_char = tab_char then
                message(
    "Previous line contains leading TABS (ascii(9)) - replace with spaces");

            endif
        endif;
    endif;
endloop;
! if by chance the above loop is exited then assume a blank line for prev. line
! or a line of blanks
eve$$indent_line_to (length_prev_line + 1);
ENDPROCEDURE;
!
!
!
PROCEDURE EVE_SORT_BUFFER (BUFFER_TO_SORT)
!
! Sort the named buffer.  Prompt for buffer name if not specified
!
local v_buf, p_buf, this_buffer;
this_buffer := current_buffer;
if not eve$prompt_string (buffer_to_sort, v_buf,
    "Buffer to sort (<RETURN> => current buffer, Ctrl-Z => Quit): ",
    "Cancelled") then
    message("Current buffer will be sorted in ascending order");
    v_buf := get_info(this_buffer, "name");
endif;
p_buf := TPUPLUS_find_buffer (v_buf);
if (p_buf <> 0) then
    TPUPLUS$shell_sort (p_buf);
else
    message ("Buffer "+v_buf+" not found");
endif;
ENDPROCEDURE;
!
!
!
PROCEDURE TPUPLUS_FIND_BUFFER (BUFFER_NAME)
!
!    This routine translates a buffer name to a buffer pointer
!
!    Inputs:
!        buffer_name    String containing the buffer name
!
local   the_buffer, ! Used to hold the buffer pointer
        the_name;   ! A read/write copy of the name
the_name := buffer_name;
change_case (the_name, UPPER);
the_buffer := get_info (buffers, "first");
loop
    exitif (the_buffer = 0);
    exitif (the_name = get_info (the_buffer, "name"));
    the_buffer := get_info (buffer, "next");
endloop;
return the_buffer;
ENDPROCEDURE;
!
!
!
PROCEDURE TPUPLUS$SHELL_SORT (BUFFER_TO_SORT)
!
! This is the shell sort, described in knuth and also
! referred to as the Diminishing Increment Sort.
!
local   v_pos,
        v_iline,
        v_jline,
        v_i,
        v_j,
        v_record;
on_error
    position (v_pos);
    return;
endon_error;
v_pos := mark (none);
position (buffer_to_sort);
TPUPLUS$x_shellstep_0   :=     1;
TPUPLUS$x_shellstep_1   :=     4;
TPUPLUS$x_shellstep_2   :=    13;
TPUPLUS$x_shellstep_3   :=    40;
TPUPLUS$x_shellstep_4   :=   121;
TPUPLUS$x_shellstep_5   :=   364;
TPUPLUS$x_shellstep_6   :=  1093;
TPUPLUS$x_shellstep_7   :=  3280;
TPUPLUS$x_shellstep_8   :=  9841;
TPUPLUS$x_shellstep_9   := 32767;
TPUPLUS$x_gshell        := 0;
TPUPLUS$x_shell_index   := 0;
!
! Find the highest step to use
!
loop
    TPUPLUS$x_gshell := 0;
    exitif (TPUPLUS$x_shell_index >= 6);
    execute ("if (get_info (current_buffer, 'record_count') <"+
        fao ("TPUPLUS$x_shellstep_!UL)",TPUPLUS$x_shell_index+2)+
        " then TPUPLUS$x_gshell := 1;endif;");
    if TPUPLUS$x_gshell then
        exitif 1;
    endif;
    TPUPLUS$x_shell_index := TPUPLUS$x_shell_index + 1;
endloop;
v_record := get_info (current_buffer, 'record_count');
!
! Now we can sort the buffer.  Outer loop loops over all the steps,
! decrementing TPUPLUS$x_shell_index.
!
loop
    execute (fao("TPUPLUS$x_gshell := TPUPLUS$x_shellstep_!UL",
        TPUPLUS$x_shell_index));
    v_j := TPUPLUS$x_gshell + 1;        !Set up loop for step+1-index
    loop
        position (beginning_of (current_buffer));
        move_vertical (v_j - 1);        !Get j'th line
        v_jline := current_line;
        v_i := v_j - TPUPLUS$x_gshell;  !i = j - h
        loop
            position (beginning_of (current_buffer));
            move_vertical (v_i - 1);
            v_iline := current_line;
            if (TPUPLUS$string_compare (v_jline, v_iline) >= 0) then
                position (beginning_of (current_buffer));
                move_vertical (v_i + TPUPLUS$x_gshell - 1);
                erase_line;
                split_line;
                move_vertical (-1);
                copy_text (v_jline);
                exitif 1;
            else
                position (beginning_of (current_buffer));
                move_vertical (v_i + TPUPLUS$x_gshell - 1);
                erase_line;
                split_line;
                move_vertical (-1);
                copy_text (v_iline);
                v_i := v_i - TPUPLUS$x_gshell;
                if (v_i < 1) then
                    position (beginning_of (current_buffer));
                    move_vertical (v_i + TPUPLUS$x_gshell - 1);
                    erase_line;
                    split_line;
                    move_vertical (-1);
                    copy_text (v_jline);
                    exitif 1;
                endif;
            endif;
        endloop;
        v_j := v_j + 1;
        exitif (v_j > v_record);
    endloop;
    TPUPLUS$x_shell_index := TPUPLUS$x_shell_index - 1;
    exitif (TPUPLUS$x_shell_index <  0);
endloop;
position (v_pos);
ENDPROCEDURE;
!
!
!
PROCEDURE TPUPLUS$STRING_COMPARE (STRING1, STRING2)
!
! Compare two strings
!
! Returns:
!    1 if string1 > string2
!    0 if string1 = string2
!    -1 if string1 < string2
!
local    v_alpha,
    v_c1,
    v_p1,
    v_c2,
    v_i,
    v_p2;
v_alpha := "                " +    !Treat all control chars as spaces???
       "                " +
       " !""#$%&'()*+,-./"+
       "0123456789:;<=>?" +
       "@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_" +
       "`abcdefghijklmnopqrstuvwxyz{|}~";
v_i := 1;
loop
    if (length (string2) < v_i) then
        if (length (string2) = length (string1)) then
            return 0;
        else
            return 1;
        endif;
    endif;
    if (length (string1) < v_i) then
        return -1;
    endif;
    v_c1 := substr (string1, v_i, 1);
    change_case (v_c1, upper);
    v_c2 := substr (string2, v_i, 1);
    change_case (v_c2, upper);
    v_p1 := index (v_alpha, v_c1);
    v_p2 := index (v_alpha, v_c2);
    if (v_p1 < v_p2) then
        return -1;
    endif;
    if (v_p1 > v_p2) then
        return 1;
    endif;
    v_i := v_i + 1;
endloop;
return 1;
ENDPROCEDURE;
!
!
!
PROCEDURE EVE_DISPLAY_CHARACTER
! This procedure writes a one line message describing the current character
! in terms of Octal, Decimal, Hexadecimal and (sometimes ) '^' notation.
LOCAL i,cc;
! Handle end-of-buffer condition
IF MARK (NONE) = END_OF (CURRENT_BUFFER) THEN
    MESSAGE ('At end of buffer, no current character.');
    RETURN;
ENDIF;
! Convert the character to an integer the hard way (no builtin yet)
i := 0;
LOOP;
    EXITIF i > 255;
    EXITIF CURRENT_CHARACTER = ASCII (i);
    i := i + 1;
ENDLOOP;
IF i > 255 THEN i := 0; ENDIF; ! On overflow, reset to NULL
! Provide ^ notation for ASCII control characters
IF i < 32 THEN
    cc := ', ^' + ASCII (i + 64);
ELSE
    cc := '';
ENDIF;
! Format and output the results
MESSAGE (FAO ("Current Character is '!AS', Octal=!OB, Decimal=!-!UB, " +
    "Hex=!-!XB!AS", CURRENT_CHARACTER, i, cc ));
ENDPROCEDURE;
!
!
!
PROCEDURE EVE_PAD_LINES (COLUMN_TO_PAD_TO)
local my_length;
my_length := column_to_pad_to;
if get_info (my_length, "type") <> integer then
    my_length := 0;
endif;
if my_length <= 0 then
    message ("No value given for pad value -- operation cancelled");
    return;
endif;
move_horizontal (-current_offset);
loop
    exitif mark (free_cursor) = end_of (current_buffer);
    if length (current_line) < my_length then
        cursor_horizontal (my_length - 1);
        copy_text (" ");
        move_horizontal (-current_offset);
    endif;
    move_vertical (1);
endloop;
ENDPROCEDURE;
!
!
!
PROCEDURE EVE_TRIM
message ("Trimmimg buffer...");
eve$trim_buffer (current_buffer);
message ("Trimming complete.");
ENDPROCEDURE;
!
! EVE command to write a select range to a file.
!
PROCEDURE EVE_WRITE_SELECT
local v_range, v_line, v_pos;
v_pos := mark (none);
if (eve$x_select_position = 0) then
    message ("No select range active -- write cancelled");
else
    v_range := create_range (eve$x_select_position, mark (none), none);
    tpuplus$write_range (v_range);
    eve$x_select_position := 0;
endif;
ENDPROCEDURE;
!
!
!
PROCEDURE TPUPLUS$WRITE_RANGE (RANGE_TO_WRITE)
!
! This procedure writes the current range to a file.
!
local   this_position,
        this_buffer, 
        tmp_buffer,
        tmp_buffer_name,
        tmp_file_name,
        buffer_name, 
        curr_buffer_name, 
        file_name;
set (informational,off);
set (success,off);
set (screen_update, off);
this_position   := mark (none);
this_buffer     := current_buffer;
buffer_name     := get_info (this_buffer, "name");
file_name       := get_info (this_buffer, "file_name");
tmp_file_name   := read_line (
                "Enter the filespec to be written or press RETURN to cancel: ");
if tmp_file_name = "" then
    set (informational, on);
    set (success, on);
    set (screen_update, on);
    message ("Write_Select cancelled at user's request");
    return;
endif;
eve_buffer ("temp");
tmp_buffer      := current_buffer;
tmp_buffer_name := get_info (tmp_buffer, "name");
copy_text (range_to_write);
eve_write_file (tmp_file_name);
! Mark a buffer as NO_WRITE and cause status line to be bold for all
! NO_WRITE buffers
if (get_info (current_buffer, "system") = 0) then
    curr_buffer_name := get_info (current_buffer,"name");
    set (no_write, current_buffer, on);
    eve$update_status_lines;
endif;
! Set the output file on the original buffer. Consistent with eve_write_file.
set (output_file, this_buffer, file_name);
eve_buffer (buffer_name);
delete (tmp_buffer);
set (informational, on);
set (success, on);
set (screen_update, on);
eve$position_in_middle (eve$x_select_position);
ENDPROCEDURE;
!
!
!
PROCEDURE EVE_SPELL (SPELL_PARAMETER)
!---------------------------------------------------------------------------
!  Select A Range Of Lines In The Current Buffer To Spell Check
!  And The Method Of How It Will Be Checked
!---------------------------------------------------------------------------
local cmd,              ! string  - first letter of selection
      current,          ! marker  - current position
      start_paragraph,  ! marker  - start of the current paragraph
      end_paragraph,    ! marker  - end of the current paragraph
      func,		! integer - call_user function code
      retstr,		! string  - call_user returned string
      spell_range;      ! range   - range to be spell checked

! set the buffer direction to forward
set (forward, current_buffer);

! check for empty buffer
if beginning_of (current_buffer) = end_of (current_buffer) then
   message ('Buffer empty');
   return (1);
endif;

! open dictionaries and init spelling checker
func := 1;
retstr := call_user (func, '');
edit (retstr, trim);
func := int (retstr);
if (func <> 1) then
   message (fao ('--- Error !AS accessing spelling dictionaries ---', retstr));
   return (0);
endif;

! check for empty (null) parameter, if yes spell check current buffer.
if length (spell_parameter) = 0 then
   spell_range := create_range (beginning_of (current_buffer),
                  end_of (current_buffer), none);
   if spell_check_range (spell_range)then
      refresh;
      message ('End of Spelling Check');
   endif;
   return (1);
endif;

! get the first character of the parameter
change_case (spell_parameter, upper);

cmd := substr (spell_parameter, 1, 1);
edit (cmd, UPPER);

! check if the spell parameter is 'HERE'
if cmd = 'H' then
   move_horizontal (-current_offset);
   spell_range := create_range (mark (none), end_of (current_buffer), none);
   if spell_check_range (spell_range)then
      refresh;
      message ('End of Spelling Check');
   endif;
   return (1);
endif;

! check if the spell parameter is 'BUFFER'
if cmd = 'B' then
   spell_range := create_range (beginning_of (current_buffer),
                  end_of (current_buffer), none);
   if spell_check_range (spell_range)then
      refresh;
      message ('End of Spelling Check');
   endif;
   return (1);
endif;

! check if the spell parameter is 'PARAGRAPH'
if cmd = 'P' then
   ! save current position
   current := mark (none);

   ! find the beginning of the current paragraph
   move_horizontal (-current_offset);
   loop
      exitif mark (none) = beginning_of (current_buffer);
      move_vertical (-1);
      if check_for_paragraph_break then
         move_vertical (1);
         exitif 1;
      endif;
   endloop;

   start_paragraph := mark (none);

   ! find the end of the current paragraph
   position (current);

   move_horizontal (-current_offset);

   loop
      exitif mark (none) = end_of (current_buffer);
      exitif check_for_paragraph_break;
      move_vertical (1);
   endloop;

   end_paragraph := mark (none);

   ! set the spell check range to current paragraph
   spell_range := create_range (start_paragraph, end_paragraph, none);

   if spell_check_range (spell_range)then
      refresh;
      message ('End of Spelling Check');
   endif;
   return (1);

endif;
! display error message
message (fao ('Unknown spell parameter (!AS)', spell_parameter));
ENDPROCEDURE;
!
!
!
PROCEDURE SPELL_CHECK_RANGE (SPELL_RANGE)
!---------------------------------------------------------------------------
!  Spell Check A Specified Range
!---------------------------------------------------------------------------
local word_range,       ! range   - range of current word
      word_pattern,     ! pattern - word recognition pattern
      replacement_word, ! string  - replacement word
      spell_cmd,        ! string  - Spell command
      first_char,	! string  - first character of the return value
      func,             ! integer - call_user function code
      line_length,	! integer - length of line
      isnumeric,	! integer - 1 if string contains only digits
      cp,		! integer - current pointer into line
      char,		! string  - current character
      ret;              ! string  - call_user returned string

! ignore string not found error
on_error
   if error <> TPU$_STRNOTFOUND then
      message ('Internal error - contact MRP Programming Group');
      return (0);
   endif;
endon_error;

! set buffer direction
set (forward, current_buffer);

! check the spelling of all of the words within the range
word_pattern := span ('abcdefghijklmnopqrstuvwxyz');

position (beginning_of (spell_range));

loop
   word_range := search (word_pattern, forward, no_exact);
   exitif word_range = 0;
   exitif beginning_of (word_range) >= end_of (spell_range);
   position (end_of (word_range));
   word_range := create_range (beginning_of (word_range),
                 end_of (word_range), reverse);
   update (current_window);
   !
   ! see if this word is in any dictionary
   func := 2;
   ret := call_user (func, substr (word_range, 1, length (word_range)));
   first_char := substr (ret, 1, 1);
   if first_char = '2' then
       ! Auto-correct
       replacement_word := substr (ret, 2, length (ret));
       edit (replacement_word, trim);
       erase (word_range);
       copy_text (replacement_word);
       update (current_window);
   else
       edit (ret, trim);
       func := int (ret);
       if (func = 3) then
           message (' Fatal error from SPELL - Aborting...');
           return(0);
       endif;
       if (func = 8) then
          spell_cmd := read_line (
	    '                 Word is too long - Press <Return> to continue');
          update (eve$command_window);
          word_range := create_range (beginning_of (word_range),
                        end_of (word_range), none);
          if last_key = ctrl_z_key then
             return (1);
          endif;
          func := 1;
       endif;
       if (func = 0) then
          !
          ! this word is not in any dictionary
          spell_cmd := read_line (
'<Ret>=Leave, S=Skip, P=Add to dict, D=Search, C=Change, Ctrl/Z=Done, or numb :'
	  );
          update (eve$command_window);
          if last_key = ctrl_z_key then
             word_range := create_range (beginning_of (word_range),
                           end_of (word_range), none);
             return (1);
          endif;
          !
          ! See if Leaving word as it is
          if (length (spell_cmd) > 0) then
              func := 0;
              !
              ! see if numeric value entered
              line_length := length (spell_cmd);
              cp := 1;
              loop
                  isnumeric := 1;
                  exitif cp > line_length;
                  isnumeric := 0;
                  char := substr (spell_cmd, cp, 1);
                  exitif (index ('0123456789', char) = 0);
                  cp := cp + 1;
              endloop;
              if (isnumeric = 1) then
                  !
                  ! Return a word from the choices listing
                  func := 6;
                  ret := call_user (func, spell_cmd);
                  !message (fao ('DEBUG>ret= !AS', ret));
                  first_char := substr (ret, 1, 1);
                  update (eve$command_window);
                  if first_char = '2' then
                      !
                      ! Use this word as the new word
                      replacement_word := substr (ret, 2, length (ret));
                      edit (replacement_word, trim);
                      erase (word_range);
                      copy_text (replacement_word);
                      update (current_window);
                  else
                      edit (ret, trim);
                      message (fao (
                        '--- Word not replaced due to error !AS ---', ret));
                  endif;
                  spell_cmd := '*';
                  func := 0;
              endif;
              !
              ! get the first character of the response
              change_case (spell_cmd, upper);
              spell_cmd := substr (spell_cmd, 1, 1);
              edit (spell_cmd, UPPER);
              !
              ! Change the word
              if spell_cmd = 'C' then
                  replacement_word := read_line ('Enter new word : ');
                  update (eve$command_window);
                  if last_key = ctrl_z_key then
                     word_range := create_range (beginning_of (word_range),
                                   end_of (word_range), none);
                     return (1);
                  endif;
                  erase (word_range);
                  if (length (replacement_word) > 0) then
                     copy_text (replacement_word);
                     !
                     ! add this word to the internal list of correct words
                     func := 7;
                     ret := call_user (func, substr
                            (replacement_word, 1, length (replacement_word)));
                  endif;
                  update (current_window);
              endif;
              !
              ! Leave and Stop asking about this word
              if spell_cmd = 'S' then
                  func := 3;
              endif;
              !
              ! Leave, Stop asking about this word, and Store in Private Dictionary
              if spell_cmd = 'P' then
                  func := 4;
              endif;
              !
              ! Search the Dictionary for a range of spellings
              if spell_cmd = 'D' then
                  func := 5;
              endif;
              !
              ! Process this command and any error return
              if (func > 2) then
                  ret := call_user (func, substr (word_range, 1,
                                                  length (word_range)));
                  first_char := substr (ret, 1, 1);
                  if first_char = '2' then
                      ! Auto-correct
                      replacement_word := substr (ret, 2, length (ret));
                      edit (replacement_word, trim);
                      erase (word_range);
                      copy_text (replacement_word);
                      update (current_window);
                  else
                      edit (ret, trim);
                      func := int (ret);
                      if (func = 3) then
                          word_range := create_range (beginning_of (word_range),
                                        end_of (word_range), none);
                          message (' Fatal error from SPELL - Aborting...');
                          return(0);
                      endif;
                      if (func = 0) then
                          word_range := create_range (beginning_of (word_range),
                                        end_of (word_range), none);
                          message ('*** Unexpected error occurred ***');
                          return (0);
                      endif;
                  endif;
              endif;
          endif;
       endif;
   endif;
   word_range := create_range (beginning_of (word_range),
                 end_of (word_range), none);
   move_horizontal (1);
endloop;
position (end_of (spell_range));
return (1);
ENDPROCEDURE;
!
!
!
PROCEDURE CHECK_FOR_PARAGRAPH_BREAK
!---------------------------------------------------------------------------
!  Check If The Current Line Is A Paragraph Break
!---------------------------------------------------------------------------
local paragraph_break;
on_error
   return (0);
endon_error;
paragraph_break := anchor & line_begin &
                ((eve$x_null | span (word_separators)) & line_end);
if search (paragraph_break, forward) <> 0 then
   return (1);
endif;
ENDPROCEDURE;
!
!
!
PROCEDURE EVE$TPUPLUS_MODULE_INIT;
eve$arg1_sort_buffer    := eve$arg1_buffer;
eve$arg1_pad_lines      := "integer";
tpuplus_auto_indent     := 0;

TPUPLUS$x_line                 := ' ';

! Each command must be eleven characters long, with the first being a space
TPUPLUS$x_commands             := ' CONTINUE  ' +
                               ' DELETE    ' +
                               ' EXIT      ' +
                               ' SUBSTITUTE';
TPUPLUS$x_command_length       := 11;

TPUPLUS$x_ranges               := ' BEFORE ' +
                               ' REST   ' +
                               ' WHOLE  ';
TPUPLUS$x_range_length         := 8;

TPUPLUS$x_terminators          := ' 	=%';
TPUPLUS$x_subs_term            := '/`~!@#$%^&*()_+-={}[]:"|;''\,.?<>' +
                                'ABCDEFGHIJKLMNOPQRSTUVWXYZ' +
                                'abcdefghijklmnopqrstuvwxyz' +
                                '0123456789';

! definitions for the spelling checker
eve$arg1_spell       := 'string';
word_separators      := " "             ! space
                     + ascii (9)        ! horzontal tab
                     + ascii (12)       ! form feed
                     + ascii (13)       ! carriage return
                     + ascii (11)       ! vertical tab
                     + ascii (10);      ! line feed

! f8
define_key ("tpuplus$line_mode",
            f8,                             "TPUPLUS$line_mode",
            eve$x_edt_keys);
ENDPROCEDURE;
ENDMODULE;
!
! Add our module init call to EVE$CORE's TPU$INIT_POSTPROCEDURE:
!
procedure tpu$init_postprocedure	! Last procedure during startup
  eve$init_postprocedure;
  EVE$TPUPLUS_MODULE_INIT;
endprocedure;