MODULE TPUPlus_EDTP IDENT "900322"
!
!   PROCEDURE EDTP$Line_mode
!   PROCEDURE EDTP$next_Token (additional_terms, term_char)
!   PROCEDURE EDTP$range_specification (spec)
!   PROCEDURE EDTP$set          ! support routine for line mode (set cmd)
!   PROCEDURE EDTP$delete_range ! support routine for line mode (delete cmd)
!   PROCEDURE EDTP$line_mode_substitute
!   PROCEDURE EDTP$find_sub_delimiter (line_length, cp)
!   PROCEDURE EDTP$single_search_replace (string1, string2, query)
!   PROCEDURE EDTP$global_search_replace (string1, string2, query)
!   PROCEDURE EDTP$Replace_String
!   PROCEDURE EVE_SET_ENTITY_WORD (USERS_WORD_SEPARATORS)
!
!   version 5.00-000 - original
!   version 5.01-000 - 890303 - RHS - added "EXIT filename.ext" command to
!                                       'GOLD KP7' utilities
!   version 5.02-000 - 890404 - RHS - added same ability to VT100 keypad
!
!   version 5.03-000 - 900322 - RHS - added EVE_SET_ENTITY_WORD routine
!

!****************************************
PROCEDURE EDTP$Line_mode (num_lines)
!PROCEDURE EDTP$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 = EDTP$Single_line) THEN
        EDTP$x_line := READ_LINE ('EDIT Command >');
    ELSE
!        message ('Type CONTINUE to exit from line mode to screen mode');
        EDTP$x_line := READ_LINE ('*');
    ENDIF;
! Save the original line in case this is a substitute command
    original_line   := EDTP$x_line;
    org_line_length := LENGTH (original_line);

! If they don't type something, tell them so...
    if org_line_length = 0 then
        eve$clear_message;
        message ("You didn't type anything...");
        edtp$line_mode (num_lines);
    endif;

! upshift the command line
    change_case (EDTP$x_line, upper);
! trim trailing whitespace
    edit (edtp$x_line, trim_trailing);

! check for short continue cmd
    if (edtp$x_line = "C") or 
        (edtp$x_line = "CO") or 
        (edtp$x_line = "CON") or 
        (edtp$x_line = "CONT") or 
        (edtp$x_line = "CONTI") or 
        (edtp$x_line = "CONTIN") or 
        (edtp$x_line = "CONTINU") or 
        (edtp$x_line = "CONTINUE") then
        edtp$x_line := continue_cmd;
    endif;
! if continue cmd, return
    if EDTP$x_line = continue_cmd then
        eve$clear_message;
        return;
    endif;

! Did user enter a number only ???
    this_line_number := int (EDTP$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 := EDTP$next_token ('/', term_char);
    if command_name = "" then
        if EDTP$x_line <> "" then
            command_name := EDTP$x_line;
        endif;
    endif;
    command_index := index (EDTP$x_commands, (' ' + command_name));
    command_index := ((command_index + EDTP$x_command_length)-1) /
        EDTP$x_command_length;

!EDTP$x_commands             :=
!    ' CONTINUE   DELETE     EXIT       SET        SUBSTITUTE TYPE      ';
    case command_index from 1 to 6
        [outrange]:
            eve_do (original_line);
        [1]:
            eve$clear_message;
            return;
        [2]:
            EDTP$delete_range;
        [3]:
! What command is it?
            new_file_name := EDTP$next_token ('/', term_char);
            if new_file_name = "" then
                exit;
            else
                eve_write_file (new_file_name);
                exit;
            endif;
        [4]:
            if EDTP$set = 0 then
                eve_do (original_line);
            endif;
        [5]:
! Get the original line back because the case is important
            new_line_length := LENGTH (EDTP$x_line);
            EDTP$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 (EDTP$x_line, 1, 1);
                EDTP$x_line := substr (EDTP$x_line, 2, length (EDTP$x_line)-1);
            endloop;
            EDTP$x_subs_term := term_char;
            old_position := mark (none);
            EDTP$line_mode_substitute;
            POSITION (old_position);
        [6]:
            eve_type_all;
    endcase;

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

ENDPROCEDURE;

!****************************************
PROCEDURE EDTP$next_Token (additional_terms, term_char)
!
! Line mode command parser. This will return the next token from the line.
!
!  EDTP$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 := EDTP$x_terminators + additional_terms;

if get_info (EDTP$x_line, "TYPE") = STRING then
    edit (EDTP$x_line, trim_leading);
    line_length := length (EDTP$x_line);
else
    line_length := 0;
endif;
term_char := "";
If line_length = 0 then
    RETURN "";
endif;
!
! Did we find =,   as in =buffer
!
char := substr (EDTP$x_line, 1, 1);
if char  = '=' then
    EDTP$x_line := substr (EDTP$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;
    EDTP$x_line := substr (EDTP$x_line, 2, line_length);
    return "";
endif;
cp := 2;
quoted := 0;
loop
    exitif cp > line_length;
    char := substr (EDTP$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 (EDTP$x_line, 1, (cp - 1));
EDTP$x_line := substr (EDTP$x_line, (cp + 1), line_length);
return token;

ENDPROCEDURE;

!****************************************
PROCEDURE EDTP$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 (EDTP$x_ranges, (' ' + spec));
r_index := ((r_index + EDTP$x_range_length - 1) / EDTP$x_range_length);

!EDTP$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 EDTP$set    !support routine for line mode (set cmd)
!
! EDTP line mode SET command
!
LOCAL
    set_index ,
    temp_value1,
    temp_value2,
    term_char ,
    set_type ;
!
! What are we setting?
!
set_type := EDTP$next_token ("", term_char);
if (set_type = "") then
    message ('Need to SET something!');
    return 0;
endif;
set_index := index (EDTP$x_sets, (' ' + set_type));
set_index := ((set_index + EDTP$x_set_length - 1) / EDTP$x_set_length);

!EDTP$x_sets                 :=
!    ' SEARCH  WRAP    NOWRAP ';

CASE set_index FROM 1 to 3
    [outrange]:
        return 0;
    [1]:
! SET SEARCH
        set_type := EDTP$next_token ("", term_char);
        if (set_type = "") then
            message('Missing parameter to SET SEARCH');
            return 0;
        endif;
        set_index := index (EDTP$x_searches, set_type);
        set_index := ((set_index + EDTP$x_searches_length - 1) / EDTP$x_searches_length);

!EDTP$x_searches             :=
!    ' EXACT   GENERAL OFF    ';

        CASE set_index FROM 1 to 3
            [outrange]:
                message ('Unsupported SET SEARCH option:  ' + set_type);
                return 0;
            [1]:
! SET SEARCH EXACT
                EDTP$x_search_case := exact;
            [2]:
! SET SEARCH GENERAL
                EDTP$x_search_case := no_exact;
            [3]:
! SET SEARCH OFF
                EDTP$x_search_case := "";
        ENDCASE;
    [2]:
! SET WRAP
        temp_value1 := EDTP$next_token ("", term_char);
        if (temp_value1 = "") then
            message ('Missing parameter to SET WRAP');
            return 0;
        endif;
        temp_value1 := int (temp_value1);
        set (right_margin, current_buffer, temp_value1);
        eve_set_wrap;
    [3]:
! SET NOWRAP
        eve_set_nowrap;
endcase;

return 1;

ENDPROCEDURE;

!****************************************
PROCEDURE EDTP$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 := EDTP$next_token (':', term_char);
if (range_specifier = "") then
    message ("No range specified -- use WHOLE, REST, or BEFORE");
    return 0;
endif;

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

ENDPROCEDURE;

!****************************************
PROCEDURE EDTP$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 (EDTP$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 (EDTP$x_line);
if (EDTP$find_sub_delimiter (line_length, cp) = 0) then
    return 0;
endif;

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

new_string := substr (EDTP$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
    EDTP$x_line := substr (EDTP$x_line, (cp + 1), line_length);
    edit (EDTP$x_line, TRIM, UPPER, OFF);
! See if WHOLE was typed
    offset := INDEX (EDTP$x_line, 'W');
    IF (offset <> 0) THEN
        whole_set := "YES";
    ENDIF;
! See if REST was typed
    offset := INDEX (EDTP$x_line, 'R');
    IF (offset <> 0) THEN
        rest_set := "YES";
    ENDIF;
! See if BEFORE was typed
    offset := INDEX (EDTP$x_line, 'B');
    IF (offset <> 0) THEN
        before_set := "YES";
    ENDIF;
! See if TYPE was typed
    offset := INDEX (EDTP$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 EDTP routines
        if whole_set = "YES" then
            position (beginning_of (current_buffer));
            EDTP$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 := EDTP$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 := EDTP$single_search_replace
                            (old_string, new_string, query_set);
                        exitif test_result = 0;
                    endloop;
                    eve$position_in_middle (temp_mark);
                else
                    EDTP$single_search_replace
                        (old_string, new_string, query_set);
                    eve$position_in_middle (temp_mark);
                endif;
            endif;
        endif;
    endif;
endif;

return 1;

ENDPROCEDURE;

!****************************************
PROCEDURE EDTP$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 (EDTP$x_line, cp, 1) = EDTP$x_subs_term);
    cp := cp + 1;
endloop;
return 1;

ENDPROCEDURE;

!****************************************
PROCEDURE EDTP$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 EDTP$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 EDTP$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;

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

ENDPROCEDURE;

!****************************************
PROCEDURE EVE_SET_ENTITY_WORD (USERS_WORD_SEPARATORS)

local   pce$word_separators,
        pce$pattern_blank_line;

pce$word_separators  := users_word_separators;

! pce$word_separators := ascii (9);                        ! <TAB> character
! pce$word_separators := pce$word_separators + ascii (10); ! <LF> character
! pce$word_separators := pce$word_separators + ascii (12); ! <FF> character
! pce$word_separators := pce$word_separators + ascii (13); ! <CR> character
! pce$word_separators := pce$word_separators + ascii (32); ! space character
! pce$word_separators := pce$word_separators + 
!    "~!@#%^&*()+-={}[]:;'|\,.?<>" + '"';

eve$x_word_separators := pce$word_separators;

pce$pattern_blank_line := line_begin & 
	 ((''| span(eve$x_word_separators)) & line_end);

eve$pattern_end_of_word := 
! Don't move off current character position
	      (
	      anchor
		&
! If on eol,then match that
              (
	      (line_end)
	      |
! No leading spaces, on a word delimiter, move one past it
	      (any(pce$word_separators))	)
	      |
! No leading spaces, on a real word, go one beyond it
	      (scan(pce$word_separators))
	      |
! No leading spaces, on a last real word of line, match reat of line
	      remain
             )
	     &
! After matching, skip over trailing spaces if any,
! except if match occurred at the eol. In this case, don't skip over blanks

	     (line_begin | span(eve$kt_whitespace) | '')
;

forward_word := eve$pattern_end_of_word;

ENDPROCEDURE;

eve$arg1_set_entity_word    := "string";

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

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

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

EDTP$x_sets                 := ' SEARCH ' +
                               ' WRAP   ' +
                               ' NOWRAP ';
EDTP$x_set_length           := 8;

EDTP$x_searches             := ' EXACT  ' +
                               ' GENERAL' +
                               ' OFF    ';
EDTP$x_searches_length      := 8;

ENDMODULE;

define_key (eve$$kt_return + "eve_fill",
            key_name (kp8, shift_key),      "fill", 
            eve$x_edt_keys);
define_key ("EDTP$line_mode (edtp$single_line)",
            key_name (kp7, shift_key),      "TPUPLUS EDTP$line_mode (LinMod)",
            eve$x_edt_keys);
define_key ("EDTP$line_mode (edtp$multi_line)",
            ctrl_z_key,                     "TPUPLUS EDTP$line_mode (LinMod)",
            eve$x_edt_keys);

define_key (eve$$kt_return + "eve_fill",
            key_name (kp8, shift_key),      "fill", 
            eve$x_vt100_keys);
define_key ("EDTP$line_mode",
            key_name (kp7, shift_key),      "EDTP$line_mode",
            eve$x_vt100_keys);
define_key ("EDTP$line_mode (edtp$multi_line)",
            ctrl_z_key,                     "TPUPLUS EDTP$line_mode (LinMod)",
            eve$x_vt100_keys);