From: HENRY::IN%"[email-masked]" 31-OCT-1986 12:50
To: cit-vax!csnet-relay.arpa!everhart@arisia%rca.com

Four files are included here

EDTPLUS.TPU - the source
EDTMEMORY.COM - command file to invoke EDTPLUS
EDT_PLUS_TPU.KEY - keypad definition summary
RECT.BUL - notes on rectangular cut and paste

note the use of logical name USR: for location of section file, etc

-- Portia Bjorndahl	UUCP -- {allegra|ihnp4}!scgvaxd!engvax!portia
   Hughes Aircraft Co.	ARPA -- [email-masked]
   (213) 616-2635
========================= cut here for EDTPLUS.TPU ==========================
!++
! FACILITY:
!	Text Processing Utility (VAXTPU)
!
! ABSTRACT:
!	This is the VAXTPU source program for the EDTplus emulator interface
!
!	compile this by
!		EDIT/TPU/SECTION=EDTSECINI/Command=EDTPLUS.TPU
!	then invoke TPU by
!		EDIT/TPU/SEC=Usr:EDTPLUS.GBL filename
!
! ENVIRONMENT:
!	VAX/VMS 4.2
!
! Author: Portia Bjorndahl
!
! CREATION DATE: 16-Oct-1985
! MODIFICATIONS: 22-Oct-1985	do not map more than one DCL window
!		 26-Nov-1985	ask for alternate file name if can't write
!				in write_current_buffer
!		 18-Feb-1986	fix end-of range for 1 character range in
!				replace
!		 16-May-1986	added rectangle cut and paste - F Kamgar
!                10-Jul-1986    added option to display line # at - F Kamgar
!		 23-Jul-1986	added mark checking in rectangular cut - FK
!--
Procedure include_file
LOCAL file;
  file:=read_line('Include file:');
  read_file(file);
endProcedure;	!include_file
Procedure goto_file
LOCAL file,buff,buffer_ptr;
  file:=read_line('Goto file:');
  buff:=file;
  buffer_ptr:=edt$find_buffer(buff);
  if buffer_ptr=0 then
    buffer_ptr:=create_buffer(buff,file);
  endif;
  map(current_window,buffer_ptr);
  show_status_line;
endProcedure;	!goto_file
Procedure goto_readonly_file
LOCAL file,buff,buffer_ptr,window_ptr;
  file:=read_line('Goto file <readonly>:');
  buff:=file;
  buffer_ptr:=edt$find_buffer(buff);
  if buffer_ptr=0 then
    buffer_ptr:=create_buffer(buff,file);
  endif;
  window_ptr:=half_window;
  set(scrolling,window_ptr,ON,0,0,0);
  map(window_ptr,buffer_ptr);
  set(NO_WRITE,current_buffer,ON);
  show_status_line;
endProcedure;	!goto_readonly_file
Procedure visit_file
LOCAL file,buff,buffer_ptr,window_ptr;
  file:=read_line('Visit file:');
  buff:=file;
  buffer_ptr:=edt$find_buffer(buff);
  if buffer_ptr=0 then
    buffer_ptr:=create_buffer(buff,file);
  endif;
  window_ptr:=half_window;
  set(scrolling,window_ptr,ON,0,0,0);
  map(window_ptr,buffer_ptr);
  show_status_line;
endProcedure;	!visit_file
Procedure write_current_buffer
LOCAL nowrite,file;
on_error
  file:=read_line('Enter another filename:');
  write_file(current_buffer,file);
endon_error;
  nowrite:=get_info(current_buffer,'no_write');
  if nowrite=1
  then
    file:=read_line('Buffer is READONLY, enter another filename:');
    write_file(current_buffer,file);
  else
    write_file(current_buffer);
  endif;
endProcedure;	!write_current_buffer
Procedure update_all_files
LOCAL buf;
  buf:=get_info(buffers,'first');
  loop
    exitif buf=0;
    if (get_info(buf,'modified')=1) AND (get_info(buf,'file_name')<>'')
       AND (get_info(buf,'no_write')=0)
    then
      write_file(buf);
    endif;
    buf:=get_info(buffers,'next');
  endloop;
endProcedure;	!update_all_files
Procedure map_to_buffer(buff)
LOCAL buffer_ptr;
  buffer_ptr:=edt$find_buffer(buff);
  if buffer_ptr=0
  then
    buffer_ptr:=create_buffer(buff);
  endif;
  map(current_window,buffer_ptr);
  show_status_line;
endProcedure;	!map_to_buffer
Procedure goto_buffer
LOCAL buff;
  buff:=read_line('Goto buffer:');
  map_to_buffer(buff);
endProcedure;	!goto_buffer
Procedure goto_main_buffer
LOCAL buff;
  buff:='MAIN';
  map_to_buffer(buff);
endProcedure;	!goto_main_buffer
Procedure next_window
LOCAL window_ptr;
  window_ptr:=current_window;
  loop
    window_ptr:=get_info(window_ptr,'next');
    exitif window_ptr=0;
    if get_info(window_ptr,'visible')=1
    then
      position(window_ptr);
      exitif;
    endif;
  endloop;
  if window_ptr=0
  then
    message('No next window');
  endif;
endProcedure;	!next_window
Procedure previous_window
LOCAL window_ptr;
  window_ptr:=current_window;
  loop
    window_ptr:=get_info(window_ptr,'previous');
    exitif window_ptr=0;
    if get_info(window_ptr,'visible')=1
    then
      position(window_ptr);
      exitif;
    endif;
  endloop;
  if window_ptr=0
  then
    message('No previous window');
  endif;
endProcedure;	!previous_window
Procedure window_half
LOCAL window_ptr;
  window_ptr:=half_window;
  set(scrolling,window_ptr,ON,0,0,0);
  map(window_ptr,current_buffer);
  show_status_line;
endProcedure;	! window_half
Procedure window_top
LOCAL cur_row,vtop,n;
  cur_row:=current_row;
  vtop:=get_info(current_window,'visible_top');
  n:=cur_row-vtop;
  scroll(current_window,n);
  cursor_vertical(-n);
endProcedure;	!window_top
Procedure window_bottom
LOCAL cur_row,vbot,n;
  cur_row:=current_row;
  vbot:=get_info(current_window,'visible_bottom');
  n:=vbot-cur_row;
  scroll(current_window,-n);
  cursor_vertical(n);
endProcedure;	!window_bottom
Procedure only_window
LOCAL vtop,vbot,tmp_pos;
  tmp_pos:=mark(none);
  vtop:=get_info(current_window,'visible_top');
  vbot:=get_info(current_window,'visible_bottom');
  adjust_window(current_window,1-vtop,20-vbot);
  position(tmp_pos);
  update(current_window);
endProcedure;	! only_window
Procedure grow_window
LOCAL vtop,vbot,n_lines;
  vtop:=get_info(current_window,'visible_top');
  vbot:=get_info(current_window,'visible_bottom');
  if vtop>1
  then
    adjust_window(current_window,-1,0);
  else
    adjust_window(current_window,0,1);
  endif;
endProcedure;	!grow_window
Procedure shrink_window
LOCAL vtop,vbot,n_lines;
  vtop:=get_info(current_window,'visible_top');
  vbot:=get_info(current_window,'visible_bottom');
  n_lines:=get_info(current_window,'visible_length')-1;
  if n_lines=2
  then
    message('Can not shrink more');
    return;
  endif;
  if vtop>1
  then
    adjust_window(current_window,1,0);
  else
    adjust_window(current_window,0,-1);
  endif;
endProcedure;	!shrink_window
Procedure change_window_width
LOCAL current_width;
  current_width:=get_info(current_window,'WIDTH');
  if current_width<=80
  then 
    set(width,current_window,132);
  else
    set(width,current_window,80);
  endif;
endProcedure;	!change_window_width
Procedure pick_range
LOCAL tmp_pos;
  edt$select_range;
  if edt$x_select_range<>0
  then
    tmp_pos:=mark(none);
    pick_buffer:=edt$find_buffer('PICK');
    if pick_buffer=0
    then
      pick_buffer:=create_buffer('PICK');
      set(NO_WRITE,pick_buffer,ON);
      set(eob_text,pick_buffer,'[End of Pick]');
      set(system,pick_buffer);
    else
      erase(pick_buffer);
    endif;
    position(pick_buffer);
    split_line;
    move_vertical(-1);
    copy_text(edt$x_select_range);
    position(tmp_pos);
    edt$x_select_range:=0;
  else
    message('No Select Active');
    edt$x_repeat_count:=1;
  endif;
endProcedure;	!pick_range
Procedure put_range
  if (beginning_of(pick_buffer)<>end_of(pick_buffer))
  then
    copy_text(pick_buffer);
    append_line;
  endif;
endProcedure;	!put_range
Procedure insert_rect
LOCAL col,counter,end_ins,extract_buff,ins_mark,llen,numlines,numlines_added,
  start_ins,tabs,tabsearch,temp,tflag;
  on_error
  endon_error;
  set (bell,all,on);
  extract_buff:=edt$find_buffer("EXTRACT");
  if (extract_buff<>0) then 
    numlines:=get_info(extract_buff,"record_count");
    if (numlines<>0) then 
      col:=current_column;
      move_horizontal(1-col);
      tflag:=0; ! flag to indicate inserting text at end of buffer
      if (mark(none)=end_of(current_buffer)) then
        tflag:=1;
        split_line;
        move_vertical(-1);
      endif;
      start_ins:=mark(none);
      counter:=0;
      numlines_added:=0;
      loop
        exitif (counter=numlines);
        if (mark(none)=end_of(current_buffer)) then
          split_line;
          numlines_added:=numlines_added+1;
        else
          move_vertical(+1);
        endif;
        counter:=counter+1;
      endloop;
      end_ins:=mark(none);
      if tflag=1 then
        move_vertical(-1);
        erase_line;
      endif;
      position(beginning_of(extract_buff));
      position(start_ins);
      tabsearch:=search('	',forward);
      if tabsearch=0 then 
        tabs:=0;
      else
        if beginning_of(tabsearch)>=end_ins then
          tabs:=0;
        else
          tabs:=1;
        endif;
      endif;
      if (tabs=0) then !no tabs in inserting range
        counter:=0;
        loop
          exitif (counter=numlines);
          llen:=length(current_line);
          if (llen<(col-1)) then !extend line with blanks if necessary
            move_horizontal(llen-get_info(current_buffer,"offset_column")+1);
            nb:=(col-llen-1);
            pad_w_nb_blanks;
          else
            move_horizontal(col-get_info(current_buffer,"offset_column"));
          endif;
          ins_mark:=mark(none);
          position(extract_buff);
          temp:=mark(none);
          move_vertical(+1);
          move_horizontal(-2);
          ins_range:=create_range(temp,mark(none),none);
          move_horizontal(+2);
          position(ins_mark);
          copy_text(ins_range);
          move_vertical(+1);
          counter:=counter+1;
        endloop;
      else
        message('cannot insert because tabs are imbedded in the text');
        position(end_ins);
        counter:=0;
        loop  ! delete extra lines added
          exitif (counter=numlines_added);
          move_vertical(-1);
          erase_line;
          counter:=counter+1;
        endloop;
      endif;
      position(start_ins);
      move_horizontal(col-1);
    else
      message("EXTRACT buffer empty");
    endif;
  else
    message("no data to insert");
  endif;
  set (bell,all,off);
  set (bell,broadcast,on);
endProcedure;  !insert_rect
Procedure overlay_rect
LOCAL col,counter,end_ins,extract_buff,ins_mark,linelen,llen,numlines,
  numlines_added,start_ins,tabs,tabsearch,temp,temp_range,tflag;
  on_error
  endon_error
  set (bell,all,on);
  extract_buff:=edt$find_buffer("EXTRACT");
  if (extract_buff<>0) then 
    numlines:=get_info(extract_buff,"record_count");
    if (numlines<>0) then 
      col:=current_column;
      move_horizontal(1-col);
      tflag:=0;
      if (mark(none)=end_of(current_buffer)) then
        tflag:=1;
        split_line;
        move_vertical(-1);
      endif;
      start_ins:=mark(none);
      counter:=0;
      numlines_added:=0;
      loop
        exitif (counter=numlines);
        if (mark(none)=end_of(current_buffer)) then
          split_line;
          numlines_added:=numlines_added+1;
        else
          move_vertical(+1);
        endif;
        counter:=counter+1;
      endloop;
      end_ins:=mark(none);
      if tflag=1 then
        move_vertical(-1);
        erase_line;
      endif;
      position(beginning_of(extract_buff));
      linelen:=length(current_line);
      position(start_ins);
      tabsearch:=search('	',forward);
      if tabsearch=0 then 
        tabs:=0;
      else
        if beginning_of(tabsearch)>=end_ins then
          tabs:=0;
        else
          tabs:=1;
        endif;
      endif;
      if (tabs=0) then !no tabs in inserting range
        counter:=0;
        loop
          exitif (counter=numlines);
          llen:=length(current_line);
          if ((llen-col+1)<linelen) then !extend line with blanks if necessary
            move_horizontal(llen-get_info(current_buffer,"offset_column")+1);
            nb:=(linelen+col-llen-1);
            pad_w_nb_blanks;
          endif;
          move_horizontal(col-get_info(current_buffer,"offset_column"));
          temp:=mark(none);
          move_horizontal(linelen-1);
          temp_range:=create_range(temp,mark(none),none);
          erase(temp_range);
          ins_mark:=mark(none);
          position(extract_buff);
          temp:=mark(none);
          move_vertical(+1);
          move_horizontal(-2);
          ins_range:=create_range(temp,mark(none),none);
          move_horizontal(+2);
          position(ins_mark);
          copy_text(ins_range);
          move_vertical(+1);
          counter:=counter+1;
        endloop;
      else
        message('cannot overlay because tabs are imbedded in the text');
        position(end_ins);
        counter:=0;
        loop  ! delete extra lines added
          exitif (counter=numlines_added);
          move_vertical(-1);
          erase_line;
          counter:=counter+1;
        endloop;
      endif;
      position(start_ins);
      move_horizontal(col-1);
    else
      message("EXTRACT buffer empty");
    endif;
  else
    message("no data to insert");
  endif;
  set (bell,all,off);
  set (bell,broadcast,on);
endProcedure;  !overlay_rect
Procedure mark_it
  mark_1:=mark(reverse);
  col_1:=current_column;
endProcedure;   !mark_it
Procedure extract_rect
LOCAL col_2,dummy_buff,dumb,end_ext,ext_range,extract_buff,flag,last_line,
  leftcolm,llen,rect_width,ret_mark,tabs,temp; 
  on_error  !suppress WARNING error messages
  endon_error
  mark_2:=mark(none);
  set (bell,all,on);
  col_2:=current_column;
  if not(mark_1) then 
    message("no marker set");
  else
    if (mark_1<>mark_2) then
      if (mark_1<mark_2) then 
        flag:=1; !flag used for cursor placement after extract
        position(mark_1);
        move_horizontal(1-col_1); !beginning of line
        start_ext:=mark(none);
        position(mark_2);
        move_horizontal(length(current_line)-col_2+1); !end of line 
        end_ext:=mark(none);
      else
        position(mark_2);
        move_horizontal(1-col_2); !beginning of line
        start_ext:=mark(none);
        if (start_ext=beginning_of(current_buffer)) then
          flag:=2;
        else
          flag:=3;
          move_horizontal(-1);
          ret_mark:=mark(none);
        endif;
        position(mark_1);
        move_horizontal(length(current_line)-col_1+1); !end of line
        end_ext:=mark(none);
      endif;
      position(end_ext);
      ext_range:=create_range(start_ext,end_ext,none);
      dummy_buff:=create_buffer('DUMMY');
      set(no_write,dummy_buff,on);
      set(system,dummy_buff);
      position(dummy_buff);
      copy_text(ext_range);
      tabs:=search('	',REVERSE);
      if tabs=0 then 
        extract_buff:=edt$find_buffer('EXTRACT');
        if extract_buff=0 then 
          extract_buff:=create_buffer('EXTRACT');
          set(no_write,extract_buff,on);
          set(eob_text,extract_buff,'[End of Extract]');
          set(system,extract_buff);
        else
          erase(extract_buff);
        endif;
        erase(ext_range);
        leftcolm:=col_1;
        if col_1>col_2 then 
          leftcolm:=col_2;
          col_2:=col_1;
          col_1:=leftcolm;
        endif;
        rect_width:=col_2-col_1+1;
        position(beginning_of(dummy_buff));
        numlines:=get_info(current_buffer,"record_count");
        dumb:=1;
        loop
          llen:=length(current_line);
          if llen<col_2 then 
            move_horizontal(llen-get_info(current_buffer,"offset_column")+1);
            nb:=(col_2-llen);
            pad_w_nb_blanks;
          endif;
          exitif (dumb=numlines);
          dumb:=dumb+1;
          move_vertical(1);
        endloop;      
        dumb:=1;
        position(beginning_of(dummy_buff));
        loop
          move_horizontal(col_1-get_info(current_buffer,"offset_column"));
          temp:=mark(none);
          move_horizontal(rect_width-1);
          ext_range:=create_range(temp,mark(none),none);
          position(extract_buff);
          move_text(ext_range);
          split_line;
          position(dummy_buff);
          exitif (dumb=numlines);
          dumb:=dumb+1;
          move_vertical(1);
        endloop;
        position(extract_buff);
        erase_line;
        position(start_ext);
        move_text(dummy_buff);
        delete(dummy_buff);
        if (flag=1) then
          move_vertical(-1);
        else 
          if (flag=2) then 
            position(beginning_of(current_buffer));
          else 
            position(ret_mark);
            move_horizontal(+1);
          endif;
        endif;
        move_horizontal(leftcolm-1);
      else 
        message('cannot extract rectangle if tabs are imbedded in text');
        position(mark_2);
        delete(dummy_buff);
      endif; !tab check
    endif; ! if mark_1<>mark_2
    delete(mark_1);
  endif; ! if mark_1 exists
  set (bell,all,off);
  set (bell,broadcast,on);
endProcedure;  !extract_rect
Procedure pad_w_nb_blanks
LOCAL loc,blanks_range,end_pad;
  if (nb<>0) then 
    loc:=mark(none);
    blanks_buff:=edt$find_buffer('BLANKS');
    if blanks_buff=0 then 
      blanks_buff:=create_buffer('BLANKS');
      set(no_write,blanks_buff,on);
      set(system,blanks_buff);
      position(blanks_buff);  !insert 132 blanks in blanks_buff for padding
! there are 72 blanks in each of the following two lines
      copy_text('                                                                  ');
      copy_text('                                                                  ');
      position(loc);
    endif;
    position(beginning_of(blanks_buff));
    move_horizontal(nb-1);
    end_pad:=mark(none);
    blanks_range:=create_range(beginning_of(blanks_buff),end_pad,none);
    position(loc);
    copy_text(blanks_range);
  endif;
endProcedure;  !pad_w_nb_blanks
Procedure copy_rect
LOCAL col_2,dummy_buff,dumb,end_ext,ext_range,extract_buff,
      last_line,llen,rect_width,tabs,temp; 
  on_error  !suppress WARNING error messages
  endon_error
  set (bell,all,on);
  mark_2:=mark(none);
  col_2:=current_column;
  if not(mark_1) then 
    message("no marker set");
  else
    if (mark_1<>mark_2) then
      if (mark_1<mark_2) then 
        position(mark_1);
        move_horizontal(1-col_1); !beginning of line
        start_ext:=mark(none);
        position(mark_2);
        move_horizontal(length(current_line)-col_2+1); !end of line 
        end_ext:=mark(none);
      else
        position(mark_2);
        move_horizontal(1-col_2); !beginning of line
        start_ext:=mark(none);
        position(mark_1);
        move_horizontal(length(current_line)-col_1+1); !end of line
        end_ext:=mark(none);
      endif;
      position(end_ext);
      ext_range:=create_range(start_ext,end_ext,none);
      dummy_buff:=create_buffer('DUMMY');
      set(no_write,dummy_buff,on);
      set(system,dummy_buff);
      position(dummy_buff);
      copy_text(ext_range);
      tabs:=search('	',reverse); !search for any imbedded tabs - this routine
      if tabs=0 then                !will not work with imbedded tabs
        extract_buff:=edt$find_buffer('EXTRACT');
        if extract_buff=0 then 
          extract_buff:=create_buffer('EXTRACT');
          set(no_write,extract_buff,on);
          set(eob_text,extract_buff,'[End of Extract]');
          set(system,extract_buff);
        else
          erase(extract_buff);
        endif;
        if col_1>col_2 then 
          dumb :=col_1;
          col_1:=col_2;
          col_2:=dumb;
        endif;
        rect_width:=col_2-col_1+1;
        position(beginning_of(dummy_buff));
        numlines:=get_info(current_buffer,"record_count");
        dumb:=1;
        loop
          llen:=length(current_line);
          if llen<col_2 then 
            move_horizontal(llen-get_info(current_buffer,"offset_column")+1);
            nb:=(col_2-llen);
            pad_w_nb_blanks;
          endif;
          exitif (dumb=numlines);
          dumb:=dumb+1;
          move_vertical(1);
        endloop;      
        dumb:=1;
        position(beginning_of(dummy_buff));
        loop
          move_horizontal(col_1-get_info(current_buffer,"offset_column"));
          temp:=mark(none);
          move_horizontal(rect_width-1);
          ext_range:=create_range(temp,mark(none),none);
          position(extract_buff);
          move_text(ext_range);
          split_line;
          position(dummy_buff);
          exitif (dumb=numlines);
          dumb:=dumb+1;
          move_vertical(1);
        endloop;
        position(extract_buff);
        erase_line;
      else 
        message('cannot copy a rectangle if tabs are imbedded in text');
      endif; ! if tab 
      position(mark_2);
      delete(dummy_buff);
    endif; ! if mark_1<>mark_2
    delete(mark_1);
  endif;
  set (bell,all,off);
  set (bell,broadcast,on);
endProcedure;  !copy_rect
Procedure replacement_log
LOCAL msg_text;
  case n from 0 to 1
  [0]: msg_text:='No replacements made';
  [1]: msg_text:='Replaced 1 occurrence';
  [outrange]:   msg_text:=FAO('Replaced !UL occurrences',n);
  endcase;
  erase(message_buffer);
  message(msg_text);
  position(here);
  update(current_window);
endProcedure;	!replacement_log
Procedure replace
LOCAL from_string,to_string,action,src_range;
!GLOBAL here, n
on_error
  replacement_log;
  return;
endon_error;
  n:=0;
  action:=' ';
  here:=mark(none);
  from_string:=read_line('replace old string> ');
  to_string:=read_line('with new string> ');
  loop
    src_range:=search(from_string,FORWARD);
    erase(message_buffer);
    message(
"' '->change,'!'->change all '.'->change and stop 'n'->don't change 's'->stop");
    position(src_range);
    update(current_window);
    loop
      action:=read_char;
      command_index := index(' !.nNsS',action);
      exitif command_index<>0;
    endloop;
    case command_index from 1 to 7
    [1]: ! change this occurrence
	 erase(src_range);
	 position(end_of(src_range));
	 copy_text(to_string);
	 n:=n+1;
    [2]: ! change all
	 loop
	   erase(src_range);
	   position(end_of(src_range));
	   copy_text(to_string);
	   n:=n+1;
	   src_range:=search(from_string,FORWARD);
	 endloop;
	 exitif;	!exit loop for each occurrence
    [3]: ! change and stop
	 erase(src_range);
	 position(end_of(src_range));
	 copy_text(to_string);
	 n:=n+1;
	 exitif;
    [4,5]:! don't change this one
	 if length(from_string)=1
	 then
	   move_horizontal(1)
	 else
	   position(end_of(src_range))
	 endif;
    [6,7]:! don't change and stop
	 exitif;
    endcase;
  endloop;
  replacement_log;
endProcedure;	!replace
Procedure transpose
LOCAL char;
  char:=erase_character(1);
  move_horizontal(-1);
  copy_text(char);
endProcedure;	!transpose
procedure switch_case		!gold kp1 (change case)
LOCAL	 character,what_case,command_index;
  edt$select_range;	!check for active select
  if edt$x_select_range <> 0 
  then
    what_case:=read_line('change to Upper/Lower or Invert? [U/L/I]',1);
    command_index:=index('UuLlIi',what_case);
    case command_index from 1 to 6
    [1,2]:      change_case(edt$x_select_range,UPPER);
    [3,4]:      change_case(edt$x_select_range,LOWER);
    [5,6]:      change_case(edt$x_select_range,INVERT);
    [OUTRANGE]: change_case(edt$x_select_range,INVERT);
    endcase;
    edt$x_select_range:=0;
    return;
  endif;
  if current_character <> edt$x_empty	!change case of current character
  then
    character :=current_character;
    change_case(character,invert);
    erase_character(1);
    copy_text(character);
    if current_direction <> forward
    then
      move_horizontal(-2);
    endif;
    return;
  endif;
endprocedure;	!switch_case
Procedure change_mode
LOCAL current_mode;
  current_mode:=get_info(current_buffer,'MODE');
  if current_mode=INSERT
  then
    set(overstrike,current_buffer);
  endif;
  if current_mode=OVERSTRIKE
  then
    set(insert,current_buffer);
  endif;
  show_status_line;
endProcedure;	!change_mode
Procedure refresh_screen
  erase(message_buffer);
  refresh;
endProcedure;	!refresh_screen
Procedure start_learn;
  message('Remembering...');
  learn_begin(EXACT);
endProcedure;	!start_learn
Procedure end_learn;
  learned:=learn_end;
  message('Done remembering...');
endProcedure;	!end_learn
Procedure save_cursor
  save_buf:=current_buffer;
  save_cur:=mark(none);
  message('Saved current position');
endProcedure;	!save_cursor
Procedure goto_saved_cursor
  map(current_window,save_buf);
  position(save_cur);
  update(current_window);
endProcedure;	!goto_saved_cursor
Procedure display_row_column
LOCAL row_num,col_num;
  row_num:=get_info(current_window,'current_row');
  col_num:=get_info(current_window,'current_column');
  message(FAO('Cursor is at Row !UL Column !UL',row_num,col_num));
endProcedure;	!display_row_column
Procedure linenum !determine what line at in a file
LOCAL num_lines,temp,total_lines;
  temp:=mark(none);
  move_horizontal(1-get_info(current_buffer,"offset_column"));!pos @ beg of line
  total_lines:=get_info(current_buffer,"record_count");
  num_lines:=total_lines+1;
  loop !count how many lines to end_of(current_buffer)
    exitif (mark(none)=end_of(current_buffer));
    move_vertical(+1);
    num_lines:=num_lines-1;
  endloop;
  position(temp);
  message(FAO('you are at line !UL of !UL',num_lines,total_lines));
endProcedure;  !linenum
Procedure goto_line
LOCAL line_num;
  line_num:=int(read_line('Goto line number:'));
  position(beginning_of(current_buffer));
  move_vertical(line_num-1);
endProcedure;	!goto_line
Procedure list_buffers
LOCAL cur_buf,buf;
  save_pos:=current_window;
  cur_buf:=current_buffer;
  erase(show_buffer);
  position(show_buffer);
  set(tab_stops,show_buffer,'21 33');
  copy_text(' Buffer name        Lines       File');
  split_line;
  copy_text('------------------------------------------------------');
  split_line;
  buf:=get_info(buffers,'first');
  loop
    exitif buf=0;
    if get_info(buf,'modified')=1
    then
      copy_text('M');
    else
      copy_text(' ');
    endif;
    if get_info(buf,'system')=1
    then
      copy_text('S');
    else
      copy_text(' ');
    endif;
    if buf=cur_buf
    then
      copy_text('=');
    else
      copy_text(' ');
    endif;
    copy_text(get_info(buf,'name'));
    copy_text('	');              ! insert a tab
    copy_text(str(get_info(buf,'record_count')));
    copy_text('	');              ! insert a tab
    copy_text(get_info(buf,'file_name'));
    split_line;
    buf:=get_info(buffers,'next');
  endloop;
  set(width,info_window,get_info(screen,'width'));
  set(video,info_window,none);
  map(info_window,show_buffer);
  set(status_line,info_window,reverse,
    'Press CTRL-F to remove INFO_WINDOW and resume editing');
  position(beginning_of(show_buffer));
  update(info_window);
endProcedure;	!list_buffers
Procedure half_window
LOCAL vtop,vbot,half,window_ptr;
  vtop:=get_info(current_window,'visible_top');
  vbot:=get_info(current_window,'visible_bottom');
  half:=(vbot-vtop)/2+1;
  window_ptr:=create_window(vtop,half,ON);
  return window_ptr;
endProcedure;	!half_window
Procedure do_DCL_command
LOCAL DCLcmd,buff,buffer_ptr;
!GLOBAL DCL_proc,DCL_window
on_error
  DCL_window:=half_window;
  set(scrolling,DCL_window,ON,0,0,0);
  map(DCL_window,buffer_ptr);
  show_status_line;
endon_error;
  DCLcmd:=read_line('DCL command:');
  buff:='DCL';
  buffer_ptr:=edt$find_buffer(buff);
  if buffer_ptr=0 then
    buffer_ptr:=create_buffer(buff);
    set(NO_WRITE,buffer_ptr,ON);
    DCL_proc:=create_process(buffer_ptr,DCLcmd);
    DCL_window:=half_window;
    set(scrolling,DCL_window,ON,0,0,0);
  else
    send(DCLcmd,DCL_proc);
  endif;
  map(DCL_window,buffer_ptr);
  show_status_line;
endProcedure;	!do_DCL_command
Procedure show_status_line
LOCAL buff,file,mode,status;
  buff:=get_info(current_buffer,'NAME');
  file:=get_info(current_buffer,'FILE_NAME');
  mode:=get_info(current_buffer,'MODE');
  if mode=INSERT
  then
    status:='<I>';
  else
    status:='<O>';
  endif;
  if get_info(current_buffer,'NO_WRITE')=1
  then
    status:=status+'<Readonly>';
  endif;
  status:=status+' Buffer:'+buff;
  if file<>''
  then
    status:=status+' File:'+file;
  endif;
  set(status_line,current_window,reverse,status);
endProcedure;	!show_status_line
Procedure show_ascii_table
LOCAL cur_buf,buf;
  save_pos:=current_window;
  cur_buf:=current_buffer;
  erase(show_buffer);
  position(show_buffer);
  copy_text('	0	1	2	3	4	5	6	7');
  split_line;
  copy_text('    ----+-------+-------+-------+-------+-------+-------+-------+------');
  split_line;
  copy_text('    0	NUL  0	DLE  16	SP  32	0  48	@  64	P  80	`   96	p   112');
  split_line;
  copy_text('    1	SOH  1	DC1  17	!   33	1  49	A  65	Q  81	a   97	q   113');
  split_line;
  copy_text('    2	STX  2	DC2  18	"   34	2  50	B  66	R  82	b   98	r   114');
  split_line;
  copy_text('    3	ETX  3	DC3  19	#   35	3  51	C  67	S  83	c   99	s   115');
  split_line;
  copy_text('    4	EOT  4	DC4  20	$   36	4  52	D  68	T  84	d  100	t   116');
  split_line;
  copy_text('    5	ENQ  5	NAK  21	%   37	5  53	E  69	U  85	e  101	u   117');
  split_line;
  copy_text('    6	ACK  6	SYN  22	&   38	6  54	F  70	V  86	f  102	v   118');
  split_line;
  copy_text("    7	BEL  7	ETB  23	'   39	7  55	G  71	W  87	g  103	w   119");
  split_line;
  copy_text('    8	BS   8	CAN  24	(   40	8  56	H  72	X  88	h  104	x   120');
  split_line;
  copy_text('    9	HT   9	EM   25	)   41	9  57	I  73	Y  89	i  105	y   121');
  split_line;
  copy_text('    A	LF  10	SUB  26	*   42	:  58	J  74	Z  90	j  106	z   122');
  split_line;
  copy_text('    B	VT  11	ESC  27	+   43	;  59	K  75	[  91	k  107	{   123');
  split_line;
  copy_text('    C	FF  12	FS   28	,   44	<  60	L  76	\  92	l  108	|   124');
  split_line;
  copy_text('    D	CR  13	GS   29	-   45	=  61	M  77	]  93	m  109	}   125');
  split_line;
  copy_text('    E	SO  14	RS   30	.   46	>  62	N  78	^  94	n  110	~   126');
  split_line;
  copy_text('    F	SI  15	US   31	/   47	?  63	O  79	_  95	o  111	DEL 127');
  split_line;
  set(width,info_window,get_info(screen,'width'));
  set(video,info_window,none);
  map(info_window,show_buffer);
  set(tab_stops,show_buffer,'8 16 24 32 40 48 56 64 72');
  set(status_line,info_window,reverse,
    'Press CTRL-F to remove INFO_WINDOW and resume editing');
  position(beginning_of(show_buffer));
  update(info_window);
endProcedure;	!show_ascii_table
Procedure help_key
LOCAL which_key,key_info;
  erase(message_buffer);
  set(video,message_window,none);
  set(video,message_window,blink);
  message('Press the (shift/control) key you want help on');
  set(video,message_window,none);
  which_key:=read_key;
  key_info:=lookup_key(which_key,COMMENT);
  if key_info<>''
  then
    message('Comment for key is: '+key_info);
  else
    message('There is no comment for this key');
  endif;
endProcedure;	!help_key
Procedure define_edt_plus_keys
  define_key('include_file',key_name('i',shift_key),
    'include file before current line');
  define_key('goto_file',key_name('c',shift_key),
    'use current window to display another file');
  define_key('goto_readonly_file',key_name('v',shift_key),
    'use current window to display another file READONLY');
  define_key('visit_file',key_name('f',shift_key),
    'visit file in another window');
  define_key('write_current_buffer',key_name('w',shift_key),'save current file');
  define_key('update_all_files',key_name('u',shift_key),
    'update all modified files on disk');
  define_key('goto_buffer',key_name('b',shift_key),
    'display buffer in current window');
  define_key('goto_main_buffer',key_name('m',shift_key),'return to main buffer');
  define_key('next_window',key_name('n',shift_key),'next window');
  define_key('previous_window',key_name('p',shift_key),'previous window');
  define_key('window_half',key_name('+',shift_key),'split current window in half');
  define_key('delete(current_window)',key_name('-',shift_key),'unmap current window');
  define_key('window_top',key_name(UP,shift_key),
    'move current line to top of window');
  define_key('window_bottom',key_name(DOWN,shift_key),
    'move current line to bottom of window');
  define_key('only_window',key_name('o',shift_key),'make this the only window');
  define_key('grow_window',key_name('g',shift_key),
    'grow current window by one line');
  define_key('shrink_window',key_name('s',shift_key),
    'shrink current window by one line');
  define_key('change_window_width',key_name(TAB_KEY,shift_key),'toggle window width');
  define_key('shift(current_window,8)',key_name(LEFT,shift_key),'shift window left');
  define_key('shift(current_window,-8)',key_name(RIGHT,shift_key),'shift window left');
  define_key('pick_range',KP9,'Copy selected range to Pick buffer');
  define_key('put_range',key_name(KP9,shift_key),'put contents of Pick buffer here');
  define_key('mark_it',key_name('.',shift_key),'mark corner of rectangle');
  define_key('insert_rect',key_name('>',shift_key),'insert rectangle');
  define_key('extract_rect',key_name('<',shift_key),'extract rectangle');
  define_key('overlay_rect',key_name(')',shift_key),'paste over rectangle');
  define_key('copy_rect',key_name('(',shift_key),'take a copy rectangle');
  define_key('replace',key_name('r',shift_key),'replace string');
  define_key('copy_text(ascii(int(read_line("Enter ASCII code in decimal: "))))',
    key_name(KP3,shift_key),'special insert');
  define_key('copy_text(read_char)',ctrl_v_key,'Quote next character');
  define_key('transpose',key_name('t',shift_key),'transpose two characters');
  define_key('switch_case',key_name(KP1,shift_key),'switch case');
  define_key('change_mode',ctrl_a_key,'insert/overstrike toggle');
  define_key('refresh_screen',ctrl_w_key,
    'erase message buffer and refresh screen');
  define_key('start_learn',key_name('[',shift_key),'Start learn sequence');
  define_key('execute(learned)',key_name('x',shift_key),'Execute learn sequence');
  define_key('end_learn',key_name(']',shift_key),'End learn sequence');
  define_key('save_cursor',key_name('=',shift_key),'save current location');
  define_key('goto_saved_cursor',key_name('^',shift_key),'goto saved location');
  define_key('display_row_column',key_name('?',shift_key),'display row,column');
  define_key('goto_line',key_name('#',shift_key),'goto line specified');
  define_key('linenum',ctrl_n_key,'display line number currently at');
  define_key('list_buffers',key_name('l',shift_key),'list buffers');
  define_key('do_dcl_command',key_name('d',shift_key),'do DCL command');
  define_key('show_ascii_table',key_name('a',shift_key),'show ascii table');
  define_key('help_key',key_name('h',shift_key),
    'display comment on key definitions');
  define_key('attach',key_name('z',shift_key),'Attach to parent process');
  define_key('quit',key_name('q',shift_key),'quit');
  define_key('exit',key_name('e',shift_key),'exit');
endProcedure;	!define_edt_plus_keys
Procedure tpu$local_init
! space, tab, ff, cr, vt followed by the printable characters
  edt$x_word:=" 	!@()_-+={}[]:;'"+'"<>,.?/|\';
  set(prompt_area,(get_info(SCREEN,'VISIBLE_LENGTH')-2),1,NONE);
  set(scrolling,main_window,ON,0,0,0);
  set(informational,on);
  set(bell,broadcast,ON);
  show_status_line;
endProcedure;
define_edt_plus_keys;
compile('procedure define_edt_plus_keys endprocedure');
save('usr:edtplus.gbl');
quit;
========================= cut here for EDTMEMORY.COM =======================
$v='f$verify(0)
$!      filename = usr:edtmemory.com
$!	edt startup file which remembers the last file edited
$!      edt=="@usr:edtmemory"   !put this line in login.com
$ set noON
$ savemsg=f$environment("MESSAGE")
$ set message/facility/text/identification/severity
$!
$ n=2
$LOOP:
$ param=p'n'
$PARSE:
$ p'n'=""
$ file=f$extract(0,f$locate("/",param),param)
$ p'n'=param-file
$ if file.nes."" then goto GOT_FILE
$ n=n+1
$ if n.le.8 then goto LOOP
$ file=f$trnlnm("EDT$MEMORY")
$ASK_FILE:
$ if file.eqs."" .or. file.eqs."NULL" then inquire/nopunc file "$_File:"
$ if file.eqs."" then goto ASK_FILE
$GOT_FILE:
$ assign/user sys$command sys$input
$ edit/tpu/section=usr:edtplus.gbl 'file 'p2 'p3 'p4 'p5 'p6 'p7 'p8
$ deassign EDT$MEMORY
$ define EDT$MEMORY 'file'
$ set message'savemsg'
$ status=f$verify(v)
$ exit
========================= cut here for EDT_PLUS_TPU.KEY =====================
              (this file is in USR:EDT_PLUS_TPU.KEY updated 7/23/86)

     EDTmemory like key definitions for Text Processing Utility
     invoked by EDIT/TPU/SEC=USR:EDTPLUS.GBL (or @USR:EDTMEMORY)
     keptTPU is invoked by @usr:kepttpu filename

+-------+--------+---------+-------+      *gold a - show ASCII table
| gold  |  help  | fndnext | del l |      *gold b - goto  buffer
|       |        |  find   | und l |      *gold c - change the current window to edit another file
+-------+--------+---------+-------+      *gold d - do DCL command, output of command will go to DCL buffer
| page  |  sect  |  PICK * | del w |       gold e - exit editor, and save all modifed buffers, except read-only buffers
|command|  fill  |   PUT * | und w |      *gold f - split screen and put another file in current window
+-------+--------+---------+-------+      *gold g - grow window height by one line
|forward| reverse|   cut   | del c |      *gold h - help on key definitions
|bottom |   top  |  paste  | und c |       gold i - insert a file at current position
+-------+--------+---------+-------+      *gold l - list buffers
| word  |  eol   |  char   | enter |       gold m - goto buffer called MAIN, for compatibility with EDT
|chgcase|del eol | specins |       |      *gold n - next window
+-------+--------+---------+       |      *gold o - make this the only window
|        line    | select  |       |      *gold p - previous window
|    open line   |  reset  | SUBS  |       gold q - quit, reconfirm if there are modified buffers
+----------------+---------+-------+       gold r - replace a string with another, with confirm
                                          *gold s - shrink window height by one line
                                           gold t - transpose current and previous character
                                          *gold u - update all modified files to disk (except readonly files)
* these functions are different from      *gold v      - split screen and put another file in current window in READONLY mode
  the default settings                    *gold w      - write current buffer out to file
                                          *gold x - execute keyboard learn sequence (keyboard macro)
                                          *gold z - attach to parent process, should be preceded by Gold-U
                                           3 (on keypad) - insert ASCII character in decimal
                                           9 (on keypad) - Pick range without erasing it, placing it in PICK buffer
                                           gold 9 (on keypad) - insert the PICK buffer at current position
                                           gold UP - goto top of buffer or make current line top line of window
                                          *gold DOWN - goto bottom line of buffer or make current line bottom line of window
                                           gold RIGHT - shift window to the left 8 columns
                                           gold LEFT - shift window to the right 8 columns
                                          *gold + - split window in half
                                          *gold - - delete current window
                                          *gold ? - display current row and column
                                          *gold TAB - toggle screen width between 80 and 132 columns
                                          *gold # - goto line number specified
                                          *gold = - save current cursor position
                                          *gold ^ - return to saved current cursor position
                                          *gold [ - start remembering keyboard learn sequence (keyboard macro)
                                          *gold ] - end remembering keyboard learn sequence (keyboard macro)
                                          *gold . - mark corner of rectangle (use keyboard period, not keypad)
                                          *gold < - extract rectangle of text    
                                          *gold > - insert rectangle of text here
                                          *gold ( - copy rectangle of text       
                                          *gold ) - overlay rectangle of text    
                                          *ctrl a - toggle between insert and overstrike mode
                                          *ctrl n - display what line number at in current file
                                           ctrl r - refresh screen                           
                                          *ctrl v - quote (insert) the next character        
                                          *ctrl w - refresh screen, erase message buffer     

                                          Note - lines marked with * are new to TPU EDTplus interface

        keys grouped by function

                (files)
*gold c - change the current window to edit another file
*gold f - split screen and put another file in current window
 gold i - insert a file at current position
*gold v - split screen and put another file in current window in READONLY mode
*gold u - update all modified files to disk
*gold w - write current buffer out to file, ask for file name if necessary

                (buffers)
*gold b - goto  buffer
*gold l - list buffers
 gold m - goto buffer called MAIN, for compatibility with EDT

                (windows)
*gold g - grow window height by one line
*gold s - shrink window height by one line
*gold n - next window
*gold p - previous window
*gold o - make this the only window
 gold UP - goto top of buffer or make current line top line of window
*gold DOWN - goto bottom line of buffer or make current line bottom line of window
 gold RIGHT - shift window to the left 8 columns
 gold LEFT - shift window to the right 8 columns
*gold + - split window in half
*gold - - delete current window
*gold TAB - toggle screen width between 80 and 132 columns

                (editing)
*ctrl a - toggle between insert and overstrike mode
 gold r - replace a string with another, with confirm
 gold t - transpose current and previous character
*ctrl v - quote (insert) the next character
 3 (on keypad) - insert ASCII character in decimal
 9 (on keypad) - Pick range without erasing it, placing it in PICK buffer
 gold 9 (on keypad) - insert the PICK buffer at current position
*gold . - mark corner of rectangle (use keyboard period, not keypad)
*gold < - extract rectangle of text
*gold > - insert rectangle of text here
*gold ( - copy rectangle of text
*gold ) - overlay rectangle of text   

                (misc)
*gold d - do DCL command, output of command will goto DCL buffer
 gold q - quit, reconfirm if there are modified buffers
 gold e - exit editor, and save all modifed buffers, except read-only buffers
*gold z - attach to parent process (only if KeptTPU is used)
*gold h - help on key definitions
*gold a - show ASCII table
*gold ? - display current row and column
*ctrl n - display what line # at in current file
*gold # - goto line number specified
*gold = - save current cursor position
*gold ^ - return to saved current cursor position
*gold [ - start remembering keyboard learn sequence (keyboard macro)
*gold ] - end remembering keyboard learn sequence (keyboard macro)
*gold x - execute keyboard learn sequence (keyboard macro)
 ctrl r - refresh screen
*ctrl w - refresh screen, erase message buffer
========================= cut here for RECT.BUL =============================

The option to perform a rectangular cut and paste has been added to TPU.  A
rectangular cut is not restricted to whole lines, it can start and end at any
column in the text as well as start and end at any line in the text.  The 
functions availible include: rectangular cut (remove designated rectangle of
text and save result), rectangular copy (copy designated text without removing
it), insert previously saved rectangle, and overlay rectangle (place saved 
rectangle over the text currently there).

The following keys are used to perform the different functions:
       mark a corner            -    GOLD "."
       insert rectangle here    -    GOLD ">"
       extract a rectangle      -    GOLD "<"
       overlay rectangle        -    GOLD ")"
       copy a rectangle         -    GOLD "("

Extracting a rectangle:
   (1) position cursor at one of the corners of the rectangle and mark the 
       corner by hitting GOLD "." (mark corner)
   (2) position the cursor at the corner diagonally opposite the previously
       marked corner and hit GOLD "<". (extract rectangle)

Copying a rectangle:
   (1) position cursor at one of the corners of the rectangle and mark the 
       corner by hitting GOLD "." (mark corner)
   (2) position the cursor at the corner diagonally opposite the previously
       marked corner and hit GOLD "(". (copy rectangle)

Inserting a rectangle:
   (1) position the cursor at the point where you want the UPPER LEFT corner
       of the inserted rectangle to be and hit GOLD ">" (insert rectangle)

Overlaying a rectangle:
   (1) position the cursor at the point where you want the UPPER LEFT corner
       of the overlayed rectangle to be and hit GOLD ")" (overlay rectangle)

NOTES:
   (1) this function will NOT work if there are imbedded tabs in the lines of 
       text which will be affected - if there are tabs in the text, a message
       will be printed out and the function requested will not be performed.
   (2) both copy and extract save the text in the same buffer, so every time
       a copy or extract is performed any previous rectangle stored in the
       save buffer (called "EXTRACT") is replaced.
   (3) whenever an extract or copy of a rectangle is made, all of the lines  
       in the rectangle are made the same length by padding any shorter      
       lines with spaces so that all of the lines extracted or copied are the
       width of the rectangle.  the reasoning behind this is so that an      
       inserted rectangle is just that, a rectangle, not lines of differing  
       lengths to mess up your table.                                        
   (4) if you try to insert or overlay a rectangle that will go beyond the end
       of the file, extra lines will be added to the end so that the rectangle
       will fit.
   (5) if you wish, you may edit the rectangle stored in EXTRACT before using
       it - just visit the buffer "EXTRACT" and perform the desired changes  
       (do NOT perform any rectangular cut and paste functions) making sure  
       that the text stays a rectangle (i.e. all lines the same length).