!++ ! 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 ! ! Authors: 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 !-- 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 :'); 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 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 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:=''; else status:=''; endif; if get_info(current_buffer,'NO_WRITE')=1 then status:=status+''; 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('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('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 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;