!++
! FILENAME: DELETE.TPU 
! FUNCTION: This file contains the procedures which delete ranges, lines
!           words or characters. They have been modified to save all of the
!           text being deleted into a delete_buffer just in case we want it
!           later.

! AUTHOR:   Steven K. Shapiro
!           (C) Copyright SKS Enterprises, Austin TX. All Rights Reserved.
!
!           The format, structure and contents of this file are the sole      
!           property  of Steven K. Shapiro  and are  copyrighted to  SKS
!           Enterprises, Austin Texas. 
!           
!           The information may be freely distributed, used and modified
!           provided  that the  information in this  header block is not 
!           changed, altered, disturbed or modified in any way.                 
!
! DATE:     15-NOV-1988 Original.
! HISTORY:  
! CONTENTS:
!           eve$edt: eve$edt_delete_line
!           eve$edt: eve$edt_delete_word
!           eve$edt: eve$edt_delete_char
!           eve$edt: eve$edt_delete_eol
!           eve$core: eve_erase_start_of_line
!           eve$core: eve$$store_remove 
!           eve$core: eve_delete
!           eve$core: eve$delete_start_line
!           eve$edt: eve$edt_delete_start_word
!
! 
!23456789A123456789B123456789C123456789D123456789E123456789F123456789G123456789H
!--
!*----------------------------------------------------------------------------*!

procedure delete_module_ident 

  local file_date,
        module_vers;

  file_date := "-<( 30-NOV-1988 16:10:27.71 )>-";
  module_vers := substr(file_date,5,2) +
                 substr(file_date,8,3) +
                 substr(file_date,14,2) +
                 substr(file_date,17,5) ;

  return module_vers;

endprocedure;

!*----------------------------------------------------------------------------*!

procedure eve$edt_delete_line           ! Delete line

local   this_position,
        start_mark,
        line_range,
        saved_mark;

on_error
    [TPU$_CONTROLC]:
        eve$$restore_position (saved_mark);     ! restore free cursor position
        eve$learn_abort;
        abort;
    [OTHERWISE]:
        eve$$restore_position (saved_mark);
endon_error;

saved_mark := mark (FREE_CURSOR);
if eve$edt_eol_nopad_delete
then
    return (1);
endif;

position (search (ANCHOR, FORWARD));    ! snap to text

if mark (NONE) = end_of (current_buffer)
then
    move_vertical (1);   ! force an error message
endif;

if eve$in_prompting_window
then
    if current_character = ""
    then
        eve$x_restore_line := 0;
        return (1);
    endif;
endif;

start_mark := mark (NONE);
move_horizontal (length (current_line) - current_offset);
if eve$in_prompting_window
then
    move_horizontal (-1);
endif;

line_range := create_range (start_mark, mark (NONE), NONE);
eve$x_erased_line_forward := TRUE;
eve$x_restore_line := eve$erase_text (line_range, eve$x_line_buffer,
                                      not eve$in_prompting_window);
if length (eve$x_restore_line) = 0
then
    position (saved_mark);
else
    ! save the string to be deleted into the delete_buffer for safety.

    this_position := mark (none);
    position (end_of (delete_buffer));
    split_line;
    copy_text (eve$x_restore_line);
    !split_line;
    position (this_position);
endif;

return (1);

endprocedure

!*----------------------------------------------------------------------------*!

procedure eve$edt_delete_word                   ! Delete word

local   this_position,
        text_mark,
        word_range,
        saved_mark;

on_error
    [TPU$_CONTROLC]:
        eve$$restore_position (saved_mark);     ! restore free cursor position
        eve$learn_abort;
        abort;
    [OTHERWISE]:
        eve$$restore_position (saved_mark);
endon_error;

saved_mark := mark (FREE_CURSOR);

if eve$edt_eol_nopad_delete
then
    return (1);
endif;

position (search (ANCHOR, FORWARD));    ! snap to text

text_mark := mark (NONE);
if text_mark = end_of (current_buffer)
then
    move_vertical (1);  ! force an error message
endif;

if current_character <> ""
then
    eve$end_of_word;
    move_horizontal (-1);
else
    if eve$in_prompting_window
    then
        eve$x_restore_word := 0;
        return (1);
    endif;
endif;

word_range := create_range (text_mark, mark (NONE), NONE);
eve$x_erased_word_forward := TRUE;
eve$x_restore_word := eve$erase_text (word_range, eve$x_word_buffer, FALSE);

if length (eve$x_restore_word) = 0
then
    position (saved_mark);
else
    ! save the string to be deleted into the delete_buffer for safety.

    this_position := mark (none);
    position (end_of (delete_buffer));
    split_line;
    copy_text (eve$x_restore_word);
    !split_line;
    position (this_position);
endif;

return (1);

endprocedure

!*----------------------------------------------------------------------------*!

procedure eve$edt_delete_char                   ! Delete character

local   this_position,
        delete_eol,
        char_range,
        saved_mark;

on_error
    [TPU$_CONTROLC]:
        eve$$restore_position (saved_mark);     ! restore free cursor position
        eve$learn_abort;
        abort;
    [OTHERWISE]:
        eve$$restore_position (saved_mark);
endon_error;

saved_mark := mark (FREE_CURSOR);

if eve$edt_eol_nopad_delete
then
    return (1);
endif;

position (search (ANCHOR, FORWARD));    ! snap to text

if mark (NONE) = end_of (current_buffer)
then
    move_vertical (1);  ! force an error message
endif;

if current_character = ""
then
    if eve$in_prompting_window
    then
        eve$x_restore_char := 0;
        return (1);
    else
        delete_eol := TRUE;
    endif;
else
    delete_eol := FALSE;
endif;

char_range := create_range (mark (NONE), mark (NONE), NONE);
eve$x_erased_char_forward := TRUE;
eve$x_restore_char := eve$erase_text (char_range, eve$x_char_buffer,
                                      delete_eol);

if (get_info (current_buffer, "mode") = OVERSTRIKE)
then
    if not delete_eol
    then
        eve$insert_text (" ");
!%IF eve$x_option_evej
!%THEN
!%      eve$conversion_start;
!%ENDIF
    endif;
endif;

if length (eve$x_restore_char) = 0
then
    position (saved_mark);
else
    ! save the string to be deleted into the delete_buffer for safety.

    this_position := mark (none);
    position (end_of (delete_buffer));
    split_line;
    copy_text (eve$x_restore_char);
    !split_line;
    position (this_position);
endif;

return (1);

endprocedure

!*----------------------------------------------------------------------------*!

procedure eve$edt_delete_eol            ! Delete to end of line

local   this_position,
        start_mark,
        saved_mark,
        line_range;

on_error
    [TPU$_CONTROLC]:
        eve$$restore_position (saved_mark);     ! restore free cursor position
        eve$learn_abort;
        abort;
    [OTHERWISE]:
        eve$$restore_position (saved_mark);
endon_error;

saved_mark := mark (FREE_CURSOR);
if eve$edt_eol_nopad_delete
then
    return (1);
endif;

position (search (ANCHOR, FORWARD));    ! snap to text

if mark (NONE) = end_of (current_buffer)
then
    move_vertical (1);  ! force error message
endif;

start_mark := mark (NONE);
if current_character = ""
then
    if eve$in_prompting_window
    then
        eve$x_restore_line := 0;
        return (1);
    else
        move_horizontal (1);
    endif;
endif;
if mark (NONE) <> end_of (current_buffer)
then
    move_horizontal (length (current_line) - current_offset);
endif;
move_horizontal (-1);

line_range := create_range (start_mark, mark (NONE), NONE);
eve$x_erased_line_forward := TRUE;
eve$x_restore_line := eve$erase_text (line_range, eve$x_line_buffer, FALSE);

if length (eve$x_restore_line) = 0
then
    position (saved_mark);
else
    ! save the string to be deleted into the delete_buffer for safety.

    this_position := mark (none);
    position (end_of (delete_buffer));
    split_line;
    copy_text (eve$x_restore_line);
    !split_line;
    position (this_position);
endif;

return (1);

endprocedure

!*----------------------------------------------------------------------------*!

! Erase from current cursor position to start of line.
! For CTRL/U compatibility.

procedure eve_erase_start_of_line       ! Erase to start of line

local   this_position,
        erase_length,           ! How much of current line to erase
        end_of_range,           ! Marker for end of range
        saved_mark,
        erase_line_range;               ! Range to be erased

on_error
    [OTHERWISE]:
endon_error;

if mark (NONE) = end_of (current_buffer)
then
    eve$learn_abort;
    return (FALSE);
endif;

erase_length := current_offset;
if eve$in_prompting_window
then
    if not eve$in_prompt
    then
        if (current_window = eve$command_window)
        then
            erase_length := current_offset - eve$$x_command_prompt_length;
        else
            erase_length := current_offset - eve$x_prompt_length;
        endif;
    else
        eve$learn_abort;
        return (FALSE);
    endif;
endif;

if erase_length <= 0
then
    eve$learn_abort;
    return (FALSE);
endif;

move_horizontal (-1);
end_of_range := mark (NONE);
move_horizontal (1 - erase_length);
erase_line_range := create_range (mark (NONE), end_of_range, NONE);
eve$x_erased_line_forward := 0;
eve$x_restore_line := eve$erase_text (erase_line_range, eve$x_line_buffer,
                                      FALSE);

if length (eve$x_restore_line) = 0
then
    position (saved_mark);
else
    ! save the string to be deleted into the delete_buffer for safety.

    this_position := mark (none);
    position (end_of (delete_buffer));
    split_line;
    copy_text (eve$x_restore_line);
    !split_line;
    position (this_position);
endif;

!%IF eve$x_option_evej
!%THEN
!% eve$conversion_start;
!%ENDIF
return (TRUE);

endprocedure;

!*----------------------------------------------------------------------------*!

procedure eve$$store_remove (the_paste_buffer, delete_range) ! Store/remove text

local   remove_range,           ! Range being removed
        saved_mark,             ! Marker for current cursor position
        done_message;           ! Id of announcement message

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

remove_range := eve$selection (TRUE);
if remove_range <> 0
then
    saved_mark := mark (NONE);  ! OK to pad now

    ! save the range to be deleted into the delete_buffer for safety.
    position (end_of (delete_buffer));
    split_line;
    copy_text (remove_range);

    erase (the_paste_buffer);
    position (the_paste_buffer);
    if delete_range
    then
        done_message := EVE$_REMCOMPL;
        move_text (remove_range);
    else
        done_message := EVE$_COPYCOMPL;
        copy_text (remove_range);
    endif;
    if mark (NONE) = end_of (the_paste_buffer)
    then
        split_line;
    endif;
    position (saved_mark);
    remove_range := 0;
    eve$message (done_message);
!%IF eve$x_option_evej
!%THEN
!%    eve$conversion_start;
!%ENDIF
    return (TRUE);
endif;

eve$learn_abort;
return (FALSE);

endprocedure;

!*----------------------------------------------------------------------------*!

! Delete previous character
!
! If eve$x_fast_delete is true, then use the fast erase_character builtin
! which does not preserve font information;  otherwise, preserve
! fonts by using proc eve$erase_text (which uses ranges for deletes).
! Note: deletes in column 1 will be slower even with eve$x_fast_delete = 1
!       because ranges must be used to preserve the end-of-line information
!       for the undelete.

procedure eve_delete            ! Delete character to left of cursor

local   this_position,
        here,
        this_buffer,
        cursor_is_free,
        char_range,             ! Range containing the character to delete
        saved_mark;

on_error
    [TPU$_CONTROLC]:
        eve$$restore_position (saved_mark);
        eve$learn_abort;
        abort;
    [TPU$_BEGOFBUF]:
        if not eve$x_bound_cursor
        then
            return (TRUE);      ! silently return
        endif;
        eve$message (error_text, error);
        eve$learn_abort;
        return (FALSE);
    [OTHERWISE]:
        eve$$restore_position (saved_mark);
endon_error;

saved_mark := mark (FREE_CURSOR);       ! to restore buffer after errors

this_buffer := current_buffer;

if eve$in_prompting_window
then
    if eve$in_prompt
    then
        eve$learn_abort;
        return (FALSE);
    endif;
endif;

eve$x_erased_char_forward := FALSE;
cursor_is_free := not (get_info (current_buffer, "bound"));

if (current_offset = 0) and eve$x_fast_delete
then
    ! this will force an error if before_bol in buffer's 1st line
    move_horizontal (-1);
    ! the following code is a simple version of eve$erase_text
    here := mark (NONE);
    char_range := create_range (mark (NONE), mark (NONE), NONE);
    position (eve$x_char_buffer);
    erase (eve$x_char_buffer);
    copy_text (char_range);

    this_position := mark (none);
    position (end_of (delete_buffer));
    split_line;
    copy_text (char_range);
    position (this_position);

    move_horizontal (-1);
    eve$x_restore_char := create_range (beginning_of (eve$x_char_buffer),
                                        mark (NONE), NONE);
    this_position := mark (none);
    position (end_of (delete_buffer));
    split_line;
    copy_text (eve$x_restore_char);
    position (this_position);

    position (here);
    move_horizontal (1);
    if mark (NONE) = end_of (this_buffer)
    then
        move_horizontal (-1);
        if current_offset = 0
        then
            move_horizontal (1);
            append_line;        ! Warning issued in unmodifiable buffer
        endif;
    else
        append_line;            ! Warning issued in unmodifiable buffer
    endif;
    return (TRUE);
else
    if eve$x_fast_delete
    then
        eve$x_restore_char := erase_character (-1);     ! Warning issued in
                                                        ! unmodifiable buffer
        this_position := mark (none);
        position (end_of (delete_buffer));
        split_line;
        copy_text (eve$x_restore_char);
        position (this_position);

        if get_info (current_buffer, "mode") = OVERSTRIKE
        then
            if current_character <> ""  ! no space at eol
            then
                eve$insert_text (" ");
                move_horizontal (-1);
            endif;
        endif;
        return (TRUE);
    endif;
endif;

! eve$x_fast_delete = 0

if cursor_is_free
then
    if current_offset = 0
    then
    ! this will force an error if before_bol in buffer's 1st line
        move_horizontal (-1);
        char_range := create_range (mark (NONE), mark (NONE), NONE);
        eve$x_restore_char := eve$erase_text (char_range, eve$x_char_buffer,
                                              FALSE);
        this_position := mark (none);
        position (end_of (delete_buffer));
        split_line;
        copy_text (eve$x_restore_char);
        position (this_position);
    else
        if not eve_move_left
        then
            return (FALSE);
        endif;
        eve$x_restore_char := eve$erase_text (" ", eve$x_char_buffer, FALSE);
        this_position := mark (none);
        position (end_of (delete_buffer));
        split_line;
        copy_text (eve$x_restore_char);
        position (this_position);
    endif;
else    ! get_info (current_buffer, "bound")
    move_horizontal (-1);
    char_range := create_range (mark (NONE), mark (NONE), NONE);
    eve$x_restore_char := eve$erase_text (char_range, eve$x_char_buffer,
                                          FALSE);
    this_position := mark (none);
    position (end_of (delete_buffer));
    split_line;
    copy_text (eve$x_restore_char);
    position (this_position);
endif;
return (TRUE);

endprocedure;

!*----------------------------------------------------------------------------*!

procedure eve$delete_start_line         ! EDT-like delete to beginning of line

local   this_position,
        end_mark,
        line_range,
        delete_eol;

on_error
    [OTHERWISE]:
endon_error;

if mark (NONE) = beginning_of (current_buffer)
then
    move_vertical (-1); ! on_error will output message and return 0
endif;

move_horizontal (-1);
end_mark := mark (NONE);
move_horizontal (1);

if eve$in_prompting_window
then
    if eve$in_prompt
    then
        return (1);
    endif;
endif;

delete_eol := (current_offset = 0);
if delete_eol
then
    if get_info (current_buffer, "record_count") <> 0
    then
        move_vertical (-1);
    endif;
endif;
position (LINE_BEGIN);

eve$move_prompt_end;

line_range := create_range (mark (NONE), end_mark, NONE);
eve$x_erased_line_forward := FALSE;
eve$x_restore_line := eve$erase_text (line_range, eve$x_line_buffer,
                                      delete_eol);

! save the string to be deleted into the delete_buffer for safety.

this_position := mark (none);
position (end_of (delete_buffer));
split_line;
copy_text (eve$x_restore_line);
!split_line;
position (this_position);

!%IF eve$x_option_evej
!%THEN
!% eve$conversion_start;
!%ENDIF
return (1);

endprocedure;

!*----------------------------------------------------------------------------*!

procedure eve$edt_delete_start_word             ! Delete word (reverse)

local   this_position,
        end_mark,
        word_range,
        number_chars;

on_error
    [OTHERWISE]:
endon_error;

if mark (NONE) = beginning_of (current_buffer)
then
    move_vertical (-1);         ! force an error message
    eve$learn_abort;
    return (0);
endif;

if eve$in_prompting_window
then
    if eve$in_prompt
    then
        return (1);
    endif;
endif;

move_horizontal (-1);
end_mark := mark (NONE);
move_horizontal (1);

number_chars := eve$start_of_word;
if number_chars = 0
then
    move_horizontal (-1);       ! erase line break
endif;

if eve$in_prompt
then
    eve$move_prompt_end;
endif;
word_range := create_range (mark (NONE), end_mark, NONE);
eve$x_erased_word_forward := FALSE;
eve$x_restore_word := eve$erase_text (word_range, eve$x_word_buffer, FALSE);

! save the string to be deleted into the delete_buffer for safety.

this_position := mark (none);
position (end_of (delete_buffer));
split_line;
copy_text (eve$x_restore_word);
!split_line;
position (this_position);

if current_character = ""
then
    move_horizontal (-1);
    if current_character = " "
    then
        erase_character (1);
        cursor_horizontal (1);
    else
        move_horizontal (1);
    endif;
endif;

!%IF eve$x_option_evej
!%THEN
!% eve$conversion_start;
!%ENDIF
return (1);

endprocedure