                  { --- Delete subroutines --- }

procedure delete_chars(n:integer;display:boolean);
{ deletes n characters at position index }
var i,l,m,new_end,cr_count:integer;
    dummy:boolean;
begin
m:=min(n,text_end-index);
if (m>0) then
    begin
    cr_count:=0;
    for i:=index to index+m-1 do
        if eol(i) then cr_count:=cr_count+1;
    new_end:=text_end-m;
    if index<=new_end then
        begin
        scratch_length:=0; l:=SCRATCHLIMIT-SCRATCHSTART+1;
        while scratch_length<min(m,l) do
            begin
            scratch[SCRATCHSTART+scratch_length]:=text[index+scratch_length];
            scratch_length:=scratch_length+1;
            end;
        end;
    dummy:=move_down(m);
    if block_flag then
        begin
        if index<block_begin then block_begin:=block_begin-m;
        if index<=block_end then block_end:=block_end-m;
        end;
    cx:=min(cx,x_to_bol(index)+1);
    if cr_count>0 then
        begin
        n_lines:=n_lines-cr_count;
        find_page_bottom_line;
        find_page_bottom_index;
        if display then display_rest_page(index,cx,cy)
        end
    else
        begin
        if index<page_bottom_index then page_bottom_index:=page_bottom_index-m;
        if display then display_rest_line(index,cx,cy);
        end;
    end;
end; { delete_chars }

procedure delete_character_under_cursor;
begin
delete_chars(1,true);
end; { delete_character_under_cursor }

procedure delete_left_character;
begin
if index>TEXTSTART then
    begin character_left; delete_character_under_cursor; end;
end; { delete_left_character }

procedure delete_left_word;
var i:integer;
begin
i:=index; index:=index-1;
if text[index] in alphanums then
    while (index>=TEXTSTART) and (text[index] in alphanums) do index:=index-1
else
    while (index>=TEXTSTART) and (text[index] in separators) do index:=index-1;
index:=index+1; find_page(index,cx,cy);
delete_chars(i-index,true);
end; { delete_left_word }

procedure delete_right_word;
var i:integer;
begin
i:=index;
if text[i] in alphanums then
    while (i<text_end) and (text[i] in alphanums) do i:=i+1
else
    while (i<text_end) and (text[i] in separators) do i:=i+1;
delete_chars(i-index,true);
end; { delete_right_word }

procedure delete_line;
begin
index:=index-ch_to_bol(index); delete_chars(ch_to_eol(index)+1,true);
end;

procedure delete_to_end_of_line;
begin delete_chars(ch_to_eol(index),true); end;

procedure delete_to_beginning_of_line;
var i:integer;
begin
i:=ch_to_bol(index); index:=index-i; delete_chars(i,true); cx:=SCREENLEFT;
end;

procedure undelete;
var i,l,cr_count:integer;
    dummy:boolean;
begin
l:=min(scratch_length,TEXTLIMIT-text_end);
cr_count:=0;
for i:=0 to l-1 do if scratch[SCRATCHSTART+i]=CR then cr_count:=cr_count+1;
dummy:=move_up(l);
for i:=0 to l-1 do text[index+i]:=scratch[SCRATCHSTART+i];
n_lines:=n_lines+cr_count;
if l<scratch_length then
    prompt_for_esc('Text buffer full. Not completely undeleted.');
restore_page(index,cx,cy);
end; { undelete }

