!------------------------ start of lseplus.tpu ----------------------------- !++ ! FACILITY: ! text processing utility (VAXTPU) ! ! ABSTRACT: ! This is the VAXTPU source program for the EDTplus emulator interface ! rewritten to interface to LSE v2.1-39 ! ! compile this by ! LSE LSEPLUS.TPU ! Gold Ctrl-z ! TPU command> execute(current_buffer) ! then invoke LSE by ! LSE/SEC=yourdir:LSEPLUS filename (or define lse$section) ! ! ENVIRONMENT: ! VAX/VMS (VMS 5.0) (should work on VMS 4.7 too) ! ! CREATION DATE: 16-Oct-1985 original version - Portia R. Shao ! 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 rectangular cut and paste - Fred Kamgar ! 10-Jul-1986 added option to display line # at - FK ! 23-Jul-1986 added mark checking in rectangular cut - FK ! 06-Feb-1987 added untab, redefine_tab, better scolling ! using kp8, etc - PRS ! 16-Apr-1987 modified Gold-W to ask for file name - PRS ! 23-Jun-1987 replaced list_buffers -Dave S. Wallace ! 06-Jul-1987 modified do_dcl_command with $set noon -PRS ! 31-May-1988 modified checking for mark_1 to work for ! VMS 5, also modified EDTSESCINI for EDT$X_WORD ! so KP1 skips properly - PRS ! 4-AUG-1988 11:59:46.62 modified to work with LSE v2.1-39 ! with merged functions from EDTPLUS: ! ! insert date/time by a key ! narrow/widen-region ala Emacs ! sort/indent/write/filter a selected region ! mail/reply reformat/insert signature ! interface to Vassar spell ! 15-SEP-1988 12:49:15.19 - PRS ! fixed update_all_files so that a file which ! did not exist when opened will be written out ! ! unchanged behavior from previous version of EDTPLUS are simply listed, ! modified/new behavior is prefixed with * ! ! keys are grouped by functions (gold key is PF1) ! (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 before current line ! gold u - update all modified files to disk !*gold v - split screen and put another file in current window in READONLY mode ! the new window is UNMODIFIABLE, you can't even type into it, but ! you may cut (i.e. copy) out of it !*gold w - write current buffer out to specified file ! ! (buffers) ! gold b - goto buffer named !*gold l - list buffers so you can pick which one to go to or remove ! gold m - goto buffer called MAIN, the first buffer, for compatibility with EDT ! ! (windows) !*gold g - grow window height by number of lines specified !*gold s - shrink window height by number of lines specified ! 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) ! gold PF3 - find string ! PF3 - find next (regular or wildcard find) ! ctrl a - toggle between insert and overstrike mode ! gold r - replace a string with another, with confirm !*gold t - transpose current and previous character, now works across line boundary ! 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 PF2 - insert current date/time at cursor location ! 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 ! gold & - set tab stops, can set either interval (if only one number is entered) or actual tab stop setting. !*ctrl n - not used, this used to display what line # we are at ! 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 withour erasing messages buffer ! ctrl w - refresh screen, erase messages buffer !*f17 - sort selection, you specify keys !*gold j - put > in front of every line and insert signature for mail reply !*gold k - indent selected region by number of spaces specifed (left or right) !*gold ctrl-n - narrow region, move selected text to another buffer for work !*gold ctrl-w - widen region, move narrow region back in its original position !*gold ctrl-f - filter region, filters the selection to a dcl command as input ! - must specify sys$input and sys$output as input and output !*f17 - sort region selected, can specify any valid sort qualifier !*f18 - write region selected to a file as specified !*f19 - run selection (or entire buffer) through Vassar speller, must do ! - save in speller to get the results back (SPELL must be defined ! - system-wide in dcltables.exe ! ! functions not bound to keys: ! - USE_EVE_KEYS to get vanilla eve keys ! - USE_EDTPLUS_KEYS to get edtplus definitions back ! - UNTAB to convert all tabs from cursor to end of file to number of spaces ! defined by current tab setting ! - REDEFINE_TAB redefines the tab key, so the right number of spaces are ! inserted when you hit the TAB key. You can put this in TPU$COMMAND if ! you want this as default, or add it to tpu$local_init in this file. ! ! more things to do/fix in the future? ! - only window does not work ! - after region command, the reverse video is still on ! - mail/reply cursor not in right position ! - list buffer sometimes returns to one window regardless of how many there were ! - paren matching, begin-end matching ! !-- ! Procedure goto_file LOCAL file,buff,buffer_ptr; file:=read_line('Goto file:'); buff:=file; buffer_ptr:=find_buffer(buff); if buffer_ptr=0 then buffer_ptr:=create_buffer(buff,file); endif; map(current_window,buffer_ptr); lse$$update_status_lines; !eve$update_status_lines; endProcedure; !goto_file ! Procedure goto_readonly_file LOCAL file,buff,buffer_ptr,window_ptr,buf; file:=read_line('Goto file :'); buff:=file; buffer_ptr :=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(modifiable,current_buffer,off); lse$$update_status_lines; !eve$update_status_lines; endProcedure; !goto_readonly_file ! Procedure write_current_buffer LOCAL file_name; file_name := read_line('Enter filename or for default:'); if file_name = '' then write_file(current_buffer); else write_file(current_buffer,file_name); 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,'system')=0 ) 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:=find_buffer(buff); if buffer_ptr=0 then buffer_ptr:=create_buffer(buff); endif; map(current_window,buffer_ptr); lse$$update_status_lines; !eve$update_status_lines; endProcedure; !map_to_buffer ! Procedure goto_buffer LOCAL buff; buff:=read_line('Goto buffer:'); map_to_buffer(buff); endProcedure; !goto_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) and (window_ptr <> lse$message_window) 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) and (window_ptr <> lse$message_window) 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); lse$$update_status_lines; !eve$update_status_lines; endProcedure; ! window_half ! Procedure delete_window LOCAL window_ptr, enlarge_length, found_next, cur_window; found_next := 0; enlarge_length := get_info (current_window, "visible_length"); cur_window :=current_window; window_ptr :=current_window; loop ! try to find next window window_ptr:=get_info(window_ptr,'next'); exitif window_ptr=0; if (get_info(window_ptr,'visible') = 1) and (window_ptr <> lse$message_window) then found_next := 1; exitif; endif; endloop; if window_ptr=0 then ! try to find previous window window_ptr := current_window; loop window_ptr:=get_info(window_ptr,'previous'); exitif window_ptr=0; if (get_info(window_ptr,'visible') = 1) and (window_ptr <> lse$message_window) then found_next := 0; exitif; endif; endloop; endif; if window_ptr = 0 then ! this should not happen message('Can not delete only window'); return; endif; position(window_ptr); if found_next = 1 then adjust_window (window_ptr, -enlarge_length, 0); else adjust_window (window_ptr, 0, enlarge_length); endif; delete(cur_window); return; endProcedure; ! delete_window ! 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,vlen,tmp_pos; vlen:=get_info(SCREEN,'visible_length'); vtop:=get_info(current_window,'visible_top'); vbot:=get_info(current_window,'visible_bottom'); adjust_window(current_window,1-vtop,vlen-vbot-4); 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 !global pick_buffer LOCAL tmp_pos; lse$create_select_range; !edt$select_range; if lse$select_range <> 0 !edt$x_select_range<>0 then tmp_pos:=mark(none); if (get_info(pick_buffer,'type') <> BUFFER) 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(lse$select_range); position(tmp_pos); lse$select_range:=0; else message('No Select Active'); lse$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 !global extract_buff LOCAL col,counter,end_ins,ins_mark,llen,numlines,numlines_added, start_ins,tabs,tabsearch,temp,tflag; on_error endon_error; set (bell,all,on); extract_buff :=find_buffer('EXTRACT'); if extract_buff <> 0 then numlines:=get_info(extract_buff,"record_count"); if (numlines<>0) then col:=current_offset+1; 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(ascii(9),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 !global extract_buff LOCAL col,counter,end_ins,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:=find_buffer('EXTRACT'); if extract_buff<>0 then numlines:=get_info(extract_buff,"record_count"); if (numlines<>0) then col:=current_offset+1; 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(ascii(9),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) current_buffer) then message("no marker set in current buffer"); else if (mark_1<>mark_2) then if (mark_1 BUFFER) 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 llenmark_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 !global blanks_buff LOCAL n,loc,blanks_range,end_pad; if (nb<>0) then loc:=mark(none); if (get_info(blanks_buff,'type') <> BUFFER) 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 n := 0; loop copy_text(' '); n := n+1; exitif n=132; endloop; 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 !global extract_buff LOCAL col_2,dummy_buff,dumb,end_ext,ext_range,numlines, 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_offset+1; if (get_info(mark_1,"buffer") <> current_buffer) then message("no marker set"); else if (mark_1<>mark_2) then if (mark_1col_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 llenmark_2 delete(mark_1); endif; set (bell,all,off); set (bell,broadcast,on); endProcedure; !copy_rect ! Procedure replacement_log LOCAL msg_text; case n_replaced from 0 to 1 [0]: msg_text:='No replacements made'; [1]: msg_text:='Replaced 1 occurrence'; [outrange]: msg_text:=FAO('Replaced !UL occurrences',n_replaced); endcase; erase(message_buffer); message(msg_text); position(here); update(current_window); endProcedure; !replacement_log ! Procedure replace LOCAL command_index,from_string,to_string,action,src_range; !GLOBAL here, n_replaced on_error replacement_log; return; endon_error; n_replaced:=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_replaced:=n_replaced+1; [2]: ! change all loop erase(src_range); position(end_of(src_range)); copy_text(to_string); n_replaced:=n_replaced+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_replaced:=n_replaced+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 settabs LOCAL tabs,n; message('Enter actual tab stops separated by spaces or '); message('just one number for interval'); tabs := read_line ('tabs:'); edit(tabs,COMPRESS,TRIM); n := index(tabs,' '); if n = 0 then set(tab_stops,current_buffer,int(tabs)); else set(tab_stops,current_buffer,tabs); endif; endProcedure; !settabs ! Procedure untab ! Turn TABs to spaces LOCAL target,n; loop target := search(ascii(9), FORWARD); exitif (target = 0); position(beginning_of(target)); erase_character(1); n := current_offset; tab_indent; endloop; endProcedure; !eliminate_tabs ! Procedure tab_indent LOCAL n,b,tab_pos,this_pos,blanks; blanks := ' '; n := current_offset; tab_pos := get_info(current_buffer,'tab_stops'); if get_info(tab_pos,'type') = integer then n := tab_pos - n + ( tab_pos * (n/ tab_pos) ); copy_text(substr(blanks,1,n)); else loop b := index(tab_pos,' '); if b = 0 then this_pos := int(tab_pos); else this_pos := int(substr(tab_pos,1,b-1)); endif; exitif (this_pos > n+1) or (b = 0); tab_pos := substr(tab_pos,b+1,length(tab_pos)-b); endloop; if this_pos > n+1 then ! important to check this first copy_text(substr(blanks,1,this_pos-n-1)); else message('no further tabs are defined'); endif; endif; endProcedure; !tab_indent ! Procedure redefine_tab define_key('tab_indent',tab_key,'indent spaces'); endProcedure; !redefine_tab ! ! Procedure transpose local this_position, ! Marker for current cursor position save_character, ! Storage for twiddled character save_mode; ! Storage for mode save_mode := get_info (current_buffer, "mode"); set (insert, current_buffer); this_position := mark (none); if this_position = end_of (current_buffer) then return; else if current_offset = 0 then save_character := erase_character (1); move_horizontal (-1); copy_text (save_character); else save_character := erase_character (-1); move_horizontal (1); copy_text (save_character); move_horizontal (-1); endif; endif; set (save_mode, current_buffer); endProcedure; !transpose ! Procedure switch_case !gold kp1 (change case) LOCAL character,what_case,command_index,selected_range; lse$create_select_range; !eve$selection(TRUE); selected_range:= lse$select_range; if selected_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(selected_range,UPPER); [3,4]: change_case(selected_range,LOWER); [5,6]: change_case(selected_range,INVERT); [OUTRANGE]: change_case(selected_range,INVERT); endcase; lse$select_range:=0; selected_range:=0; return; endif; if current_character <> '' !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; lse$select_range:=0; endprocedure; !switch_case ! 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 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,main_pos,vtop,vbot,old_vtop,old_vbot; cur_buf:=current_buffer; erase(show_buffer); position(show_buffer); set(tab_stops,show_buffer,'21 33'); copy_text(' buffer name'); copy_text(ascii(9)); copy_text('lines'); copy_text(ascii(9)); copy_text('file'); split_line; copy_text(' -----------'); copy_text(ascii(9)); copy_text('-----'); copy_text(ascii(9)); 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(ascii(9)); ! insert a tab copy_text(str(get_info(buf,'record_count'))); copy_text(ascii(9)); ! insert a tab copy_text(get_info(buf,'file_name')); split_line; buf:=get_info(buffers,'next'); endloop; map(current_window,show_buffer); set(status_line,current_window,reverse, 'Position cursor on buffer with arrow keys and press ENTER'); position(beginning_of(show_buffer)); main_pos:=search("=",forward); position(main_pos); move_horizontal(-2); update(current_window); define_key('redefine_enter',enter); endprocedure; !list_buffers ! Procedure find_buffer(buffname) LOCAL buf; edit(buffname,UPPER,TRIM); buf:=get_info(buffers,'first'); loop exitif buf=0; if (get_info(buf,'name')=buffname) then return (buf); endif; buf:=get_info(buffers,'next'); endloop; return (buf); endProcedure; !find_bufer ! Procedure redefine_enter LOCAL file_line,i; file_line := current_line; file_line := substr(file_line,4,60); i := 0; loop i := i + 1; exitif(substr(file_line,i,1)=ascii(9)); exitif(substr(file_line,i,1)=' '); exitif(i=60); endloop; i := i - 1; file_line := substr(file_line,1,i); map_to_buffer(file_line); undefine_key (enter); endprocedure; !redefine_enter ! 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 vassar_spell ! modified eve version of spell ! SPELL.CLD must be set in the default dcltables.exe for this to work, ! since it uses the SPAWN command to interface to SPELL local selected_region, text_ptr, start_mark, end_mark, the_file, the_position, is_offset; !on_error ! [TPU$_CONTROLC]: ! set (SCREEN_UPDATE, ON); ! lse$$abort_on_error; !eve$learn_abort; ! abort; ! [TPU$_CREATEFAIL]: ! message ('can create spell process');!eve$message (EVE$_CANTCREASPELL); ! lse$$abort_on_error; !eve$learn_abort; ! return (FALSE); ! [OTHERWISE]: ! set (SCREEN_UPDATE, ON); !endon_error; lse$create_select_range; !eve$selection (TRUE); selected_region := lse$select_range; if selected_region = 0 then message('Using entire buffer'); text_ptr := current_buffer; else text_ptr := selected_region; endif; if (get_info(the_filter_buffer,'type') <> BUFFER) then the_filter_buffer := create_buffer('the_filter_buffer'); endif; if (get_info (filter_process, "type") = UNSPECIFIED) or (filter_process = 0) then filter_process := create_process (the_filter_buffer, "$ set noon"); endif; send ("$ delete:==delete", filter_process); ! disregard user symbols the_file := "sys$scratch:" +str(get_info(filter_process,"pid")) + ".tmp"; set (SCREEN_UPDATE, OFF); ! insure we do complete lines (otherwise single words selected in the middle of ! a line get read_file'd onto previous line, too nasty to prevent) if lse$select_in_progress <> 0 !eve$x_select_position <> 0 then start_mark := beginning_of (text_ptr); end_mark := end_of (text_ptr); if get_info (start_mark, "offset") > 0 then position (start_mark); position (LINE_BEGIN); start_mark := mark (NONE); endif; if get_info (end_mark, "offset") > 0 then position (end_mark); position (LINE_END); end_mark := mark (NONE); endif; text_ptr := create_range (start_mark, end_mark, NONE); endif; ! write out temp file to be checked by Vassar spell write_file (text_ptr, the_file); ! should on_error return spawn ("SPELL " + the_file ); lse$select_in_progress := 0; !eve$x_select_position := 0; the_position := beginning_of (text_ptr); erase (text_ptr); if (the_position <> beginning_of (current_buffer)) then move_horizontal (-1); the_position := mark (NONE); move_horizontal (1); is_offset := 1; endif; read_file (the_file); ! get corrected text position (the_position); if is_offset then move_horizontal (1); else position (beginning_of (current_buffer)); endif; send ("$ delete " + the_file + ";*", filter_process); lse$select_range:=0; selected_region :=0; set (SCREEN_UPDATE, ON); refresh; return; endprocedure; ! vassar_spell ! Procedure narrow_region !global wide_region_buffer, wide_region_buffer_name, narrow_region_buffer, ! wide_region_position local region_selected, narrow_region_buffer_name; if (get_info(narrow_region_buffer,'type') <> BUFFER) or (narrow_region_buffer = 0) then wide_region_buffer := current_buffer; wide_region_buffer_name := get_info(current_buffer,'name'); narrow_region_buffer_name := '<'+wide_region_buffer_name+'>'; narrow_region_buffer := create_buffer (narrow_region_buffer_name); else message('Narrow region already active'); return; endif; lse$create_select_range; !eve$selection(TRUE); region_selected := lse$select_range; if region_selected <> 0 then wide_region_position := mark(none); erase(narrow_region_buffer); position(narrow_region_buffer); move_text(region_selected); map (current_window, narrow_region_buffer); lse$$update_status_lines; !eve$update_status_lines; update (current_window); else lse$$abort_on_error; !eve$learn_abort; return; endif; lse$select_range:=0; region_selected:=0; endProcedure; !narrow_region ! Procedure widen_region if (current_buffer <> narrow_region_buffer) then message ('Current buffer is not the narrow region buffer'); return; endif; position(wide_region_position); move_text(narrow_region_buffer); map (current_window, wide_region_buffer); lse$$update_status_lines; !eve$update_status_lines; update (current_window); delete (narrow_region_buffer); endProcedure; !wide_region ! Procedure indent_region !glocal the_region_buffer; LOCAL selected_region, nlines, saved_pos, blanks, answer, nindent; blanks := ' '; lse$create_select_range; !eve$selection (TRUE); selected_region := lse$select_range; if selected_region = 0 then lse$$abort_on_error; !eve$learn_abort; return; else if (get_info(the_region_buffer,'type') <> BUFFER) then the_region_buffer := create_buffer('the_region_buffer',''); endif; answer :=read_line('Number of spaces to indent? (+ right/- left)'); nindent := int(answer); saved_pos :=mark(none); erase(the_region_buffer); position(beginning_of(the_region_buffer)); move_text(selected_region); position(beginning_of(the_region_buffer)); nlines := get_info(the_region_buffer,'record_count'); if nindent>0 then loop copy_text(substr(blanks,1,nindent)); move_vertical(1); move_horizontal(-current_offset); !eve$edt_line; nlines:=nlines -1; exitif nlines = 0; endloop; else loop erase_character(-nindent); move_vertical(1); move_horizontal(-current_offset); !eve$edt_line; nlines:=nlines -1; exitif nlines = 0; endloop; endif; position(saved_pos); move_text(the_region_buffer); endif; lse$select_range:=0; region_selected:=0; endProcedure ! indent_region ! Procedure sort_region ! global the_filter_buffer, filter_process; LOCAL selected_region, sort_command, sort_qualifier; lse$create_select_range; !eve$selection (TRUE); selected_region := lse$select_range; if selected_region = 0 then lse$$abort_on_error; !eve$learn_abort; return; else if (get_info(the_filter_buffer,'type') <> BUFFER) then the_filter_buffer := create_buffer('the_filter_buffer'); endif; if (get_info (filter_process, "type") = UNSPECIFIED) or (filter_process = 0) then filter_process := create_process (the_filter_buffer, "$ set noon"); endif; sort_qualifier:=read_line('Enter sort qualifier or CR for default> '); sort_command:='$sort ' + sort_qualifier + ' sys$input sys$output'; send(sort_command, filter_process); send(selected_region, filter_process); send_eof(filter_process); erase (selected_region); selected_region := 0; move_text(the_filter_buffer); message ('region sorted.'); lse$select_range:=0; return; endif; endProcedure; ! sort_region ! Procedure filter_region ! global the_filter_buffer, filter_process; LOCAL selected_region, filter_command, fliter_qualifier; lse$create_select_range; !eve$selection (TRUE); selected_region := lse$select_range; if selected_region = 0 then lse$$abort_on_error; !eve$learn_abort; return ; else if (get_info(the_filter_buffer,'type') <> BUFFER) then the_filter_buffer := create_buffer('the_filter_buffer'); endif; if (get_info (filter_process, "type") = UNSPECIFIED) or (filter_process = 0) then filter_process := create_process (the_filter_buffer, "$ set noon"); endif; message('use sys$input and sys$output for input and output if any'); filter_command :=read_line('Enter dcl filter command: '); send(filter_command, filter_process); send(selected_region, filter_process); send_eof(filter_process); erase (selected_region); selected_region := 0; move_text(the_filter_buffer); message ('region filtered.'); lse$select_range:=0; select_region:=0; return; endif; endProcedure; ! filter_region ! Procedure write_region LOCAL selected_region, filename; lse$create_select_range; !eve$selection (TRUE); selected_region := lse$select_range; if selected_region = 0 then lse$$abort_on_error; !eve$learn_abort; return; else filename :=read_line('Enter filename to write to: '); write_file (selected_region, filename); endif; lse$select_range:=0; return; endProcedure; ! write_region ! Procedure mail_reply local nlines, insertion_point; position(beginning_of(current_buffer)); nlines := get_info(current_buffer,'record_count'); loop copy_text('>'); move_vertical(1); move_horizontal(-current_offset); !eve$edt_line; nlines := nlines -1; exitif nlines = 0; endloop; move_horizontal(-1); insertion_point := mark (none); move_horizontal(1); read_file ('sys$login:signature.txt'); position (insertion_point); split_line; return; endProcedure; ! mail_reply ! !Procedure match_paren !endProcedure; ! match_paren ! Procedure do_DCL_command LOCAL DCLcmd,buff,buffer_ptr; !GLOBAL DCL_proc,DCL_window on_error if error = tpu$_createfail then message ("DCL subprocess could not be created"); return (0); endif; DCL_window:=half_window; set(scrolling,DCL_window,ON,0,0,0); map(DCL_window,buffer_ptr); lse$$update_status_lines; !eve$update_status_lines; endon_error; DCLcmd:=read_line('DCL command:'); buff:='DCL'; buffer_ptr:=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,"$ set noon"); DCL_window:=half_window; set(scrolling,DCL_window,ON,0,0,0); endif; send(DCLcmd,DCL_proc); map(DCL_window,buffer_ptr); lse$$update_status_lines; !eve$update_status_lines; endProcedure; !do_DCL_command ! Procedure show_ascii_table LOCAL buf; saved_buffer:=current_buffer; ascii_table_buffer:=create_buffer('ascii_table_buffer'); position(ascii_table_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(modifiable,ascii_table_buffer,off); map(current_window,ascii_table_buffer); set(eob_text,ascii_table_buffer,"[That's all, folks!]"); set(tab_stops,ascii_table_buffer,'8 16 24 32 40 48 56 64 72'); set(status_line,current_window,reverse, 'Press Return to remove this window and resume editing'); position(beginning_of(ascii_table_buffer)); update(current_window); define_key('redefine_cr',ret_key); endProcedure; !show_ascii_table ! Procedure redefine_cr map(current_window,saved_buffer); delete(ascii_table_buffer); undefine_key(ret_key); lse$$update_status_lines; endProcedure; !undefine_return ! Procedure help_key LOCAL which_key,key_info; erase(message_buffer); set(video,lse$message_window,none); set(video,lse$message_window,blink); message('Press the (shift/control) key you want help on'); set(video,lse$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_in_lse set(shift_key,pf1); ! enable gold key ! ! file related commands ! define_key('goto_file',key_name('c',shift_key), 'use current window to display another file'); define_key('window_half;goto_file',key_name('f',shift_key), 'visit file in another window'); define_key('read_file(read_line("include file> "))',key_name('i',shift_key), 'include file before current line'); define_key('goto_readonly_file',key_name('v',shift_key), 'visit another file READONLY in another window'); define_key('update_all_files',key_name('u',shift_key), 'update all modified files onto disk'); define_key('write_current_buffer', key_name('w',shift_key), 'write out current buffer in specified file'); ! ! buffer related commands ! define_key('goto_buffer',key_name('b',shift_key), 'goto buffer in current window'); define_key('list_buffers',key_name('l',shift_key),'list buffers'); define_key('map(current_window,lse$main_buffer);lse$$update_status_lines', key_name('m',shift_key),'return to main buffer'); ! ! windows related commands ! define_key('next_window',key_name('n',shift_key),'next window'); define_key('previous_window',key_name('p',shift_key),'previous window'); define_key('only_window',key_name('o',shift_key), 'make this the only window'); define_key('window_half',key_name('+',shift_key), 'split current window in 2'); define_key('delete_window',key_name('-',shift_key), 'unmap current window'); define_key('grow_window',key_name('g',shift_key), 'enlarge current window by lines specified'); define_key('shrink_window',key_name('s',shift_key), 'shrink current window by lines specified'); define_key('change_window_width',key_name(TAB_KEY,shift_key), 'change window width between 80 and 132'); 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('shift(current_window,-8)',key_name(RIGHT,shift_key), 'shift window right by number of columns specified'); define_key('shift(current_window,8)',key_name(LEFT,shift_key), 'shift window left by number of columns specified'); ! ! editing, pick/put, rectangular cut/paste ! ! define_key('eve_wildcard_find("")',ctrl_f_key,'wildcard find'); ! use the following line if you like EVE's replace better ! define_key('eve_replace("","")',key_name('r',shift_key),'replace string'); define_key('replace',key_name('r',shift_key),'replace string'); define_key('transpose',key_name('t',shift_key),'transpose two characters'); 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('copy_text(ascii(int(read_line('+ '"Enter ASCII code in decimal: "))))', key_name(KP3,shift_key),'special insert'); 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/remove rectangle'); define_key('overlay_rect',key_name(')',shift_key),'pasteover rectangle'); define_key('copy_rect',key_name('(',shift_key),'copy rectangle'); ! ! misc functions ! define_key('copy_text(fao("!%D",0))',key_name(PF2,shift_key), 'insert date/time'); define_key('switch_case',key_name(KP1,shift_key),'switch case'); define_key('do_dcl_command',key_name('d',shift_key),'do DCL command'); define_key('quit',key_name('q',shift_key),'quit'); define_key('exit',key_name('e',shift_key),'exit'); !want to write all modified ! unconditionally, eve_exit confirms for all but current buffer define_key('attach',key_name('z',shift_key),'attach to parent process'); define_key('help_key',key_name('h',shift_key), 'display comment on key definitions'); define_key('show_ascii_table',key_name('a',shift_key),'show ascii table'); define_key('display_row_column',key_name('?',shift_key),'display row,column'); 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('goto_line',key_name('#',shift_key),'goto line specified'); define_key('linenum',pf2,'display current line number'); define_key('refresh',ctrl_r_key,'refresh screen, keep messages'); define_key('mail_reply',key_name('j',shift_key), 'format mail reply/signature'); define_key('indent_region',key_name('k',shift_key), 'indent region selected'); define_key('sort_region',f17,'sort region selected'); define_key('write_region',f18,'write region selected'); define_key('narrow_region',key_name(ctrl_n_key,shift_key),'narrow region'); define_key('widen_region',key_name(ctrl_w_key,shift_key),'widen region'); define_key('filter_region',key_name(ctrl_f_key,shift_key),'filter region'); define_key('vassar_spell',f19,'Vassar speller interface'); endProcedure; !define_edt_plus_keys ! ! put your local modifications here ! Procedure tpu$local_init ! ! do not change these lines ! pick_buffer:=create_buffer("Pick Buffer",""); !create Pick buffer ! ! change these lines as you like ! lse$$word_term_string :="~`!@#$%^&*()_-+={}[]:;'"+'"<>,.?/|\'; endProcedure; define_edt_plus_keys_in_lse; ! then add our own shorthands lse$do_command('define key/if_state=gold do "find/file/ref=(env,inc)/disp=(nomod,noline,file) *"'); lse$do_command('define key/if_state=gold e1 "search/pattern"'); lse$do_command('define key/if_state=gold e4 "substitute/pattern"'); save('sys$disk:[]lseplus'); !quit; !------------------------ end of lseplus.tpu -----------------------------