!Last Modified: 14-JUN-1989 10:13:13.75, By: FLEMING procedure eve_bufed_module_init bufed_x_active := FALSE; bufed_select_key_pgm := compile("message('Key not defined');"); bufed_remove_key_pgm := compile("message('Key not defined');"); eve$arg1_destroy_buffer := eve$arg1_buffer; bufed_remove_key_pgm := 0; bufed_select_key_pgm := 0; ! Initialize file type recognition variables and array rtp_comment_index := create_array(30,1); rtp_comment_index{"COM"} := 1; ! command procedures DCL or Console rtp_comment_index{"C"} := 2; ! C programs (C food?) rtp_comment_index{"RPL"} := 2; ! RS/1 Procedure Language (Reverse Polish?) rtp_comment_index{"FOR"} := 3; ! Fortran (Foreign or Fortrash) rtp_comment_index{"MSS"} := 4; ! Scribe ManuScript Source rtp_comment_index{"MAK"} := 4; ! Scribe Database File rtp_comment_index{"MAR"} := 5; ! VAX/PDP Macro rtp_comment_index{"PAS"} := 6; ! Pascal, or Pasifier rtp_comment_index{"RNO"} := 7; ! Digital Runoff (Run Away!) rtp_comment_index{"RNH"} := 7; ! Runoff Help rtp_comment_index{"TPU"} := 8; ! Self Reference rtp_comment_index{"EVE"} := 8; ! Eve Init or Command file rtp_comment_index{"CLD"} := 8; ! DCL Command Language Definition rtp_comment_index{"DIS"} := 8; ! MAIL distribution (For handicapped files?) rtp_comment_index{"HLP"} := 8; ! HELP source files rtp_comment_index{"MMS"} := 8; ! MMS DESCRIP files (Melts in your hands) rtp_comment_index{"COB"} := 9; ! COBOL Source -- Corn (or is it kernel?) mode. rtp_comment_index{"CMD"} := 10; ! RSX command procedures comment_supported_types := "COM,FOR,C,PAS,MAR,MSS,CMD,RPL,MAK,RNO,"+ "TPU,EVE,CLD,DIS,HLP,MMS,COB"; edit(comment_supported_types,TRIM,UPPER,COLLAPSE); endprocedure; procedure eve_trim_buffer message("Triming buffer..."); eve$trim_buffer(current_buffer); message("Triming complete."); endprocedure procedure eveplus_set_right_margin local this_column,prompt; prompt := "Enter right margin: "; this_column := int(read_line(prompt)); ! this_column := get_info(current_window,"current_column"); eve_set_right_margin(this_column); endprocedure procedure eveplus_set_left_margin local this_column,prompt; prompt := "Enter left margin: "; this_column := int(read_line(prompt)); ! this_column := get_info(current_window,"current_column"); eve_set_left_margin(this_column); endprocedure ! This routine actually destroys a specific buffer. ! ! Inputs: ! the_name The name of the buffer (display only) ! the_buffer Pointer to the buffer to destroy ! procedure bufed_destroy_buffer(the_name, the_buffer) ! Delete a buffer local answer, problem, new_buffer; bufed_destroy_buffer := FALSE; problem := ""; if ((get_info(the_buffer, "modified")) and (get_info(the_buffer, "record_count") <> 0)) then problem := "modified "; endif; if (get_info(the_buffer, "system")) then problem := problem + "system "; endif; if (problem <> "") then answer := read_line(substr(the_name, 1, 32) + " is a " + problem + "buffer. Are you sure? "); change_case (answer, lower); if ((length (answer) = 0) or (answer <> substr ("yes", 1, length (answer)))) then message("No buffer deleted."); return; endif; endif; if (current_buffer <> the_buffer) then delete(the_buffer); else new_buffer := get_info(buffers, "first"); loop exitif (new_buffer = 0); exitif ((get_info(new_buffer, "system") = FALSE) and (new_buffer <> current_buffer)); new_buffer := get_info(BUFFERS, "next"); endloop; if (new_buffer = 0) then eve_buffer("Main"); else eve_buffer(get_info(new_buffer, "name")); endif; if (get_info (the_buffer, "name") = "MAIN") then erase (the_buffer); else delete (the_buffer); endif; endif; bufed_destroy_buffer := TRUE; message("Deleted buffer " + the_name); new_buffer := get_info(BUFFERS, "first"); endprocedure ! ; ! This routine scans the line the cursor is on and if it is in the ! proper format for a buffer listing, it reurns both the name of ! the buffer and a pointer to it. ! procedure bufed_get_the_buffer(the_name, the_buffer) ! Scan a buffer line local the_start; ! A mark pointing to the buffer name. the_name := ""; the_buffer := 0; if (get_info(current_buffer, "name") <> "LIST BUFFER") then message("Not in the LIST BUFFER"); else move_horizontal(-current_offset); if (search(ANCHOR & " ", FORWARD) = 0) then message("This is not a buffer listing"); else move_horizontal(2); the_start := mark(none); move_horizontal(-2); move_vertical(1); move_horizontal(-2); if (current_character = "-") then move_horizontal(-2); else move_horizontal(32-current_offset); endif; the_name := create_range(the_start, mark(none), bold); the_name := substr(the_name, 1, length(the_name)); edit(the_name, TRIM_TRAILING, OFF); the_buffer := eveplus_find_buffer(the_name); if (the_buffer = 0) then message("No such buffer: " + the_name); endif; move_horizontal(2-current_offset); endif; endif; bufed_get_the_buffer := the_buffer; endprocedure ! This routine translates a buffer name to a buffer pointer ! ! Inputs: ! buffer_name String containing the buffer name ! procedure eveplus_find_buffer(buffer_name) ! Find a buffer by name local the_buffer, ! Used to hold the buffer pointer the_name; ! A read/write copy of the name the_name := buffer_name; change_case(the_name, UPPER); the_buffer := get_info(buffers, "first"); loop exitif (the_buffer = 0); exitif (the_name = get_info(the_buffer, "name")); the_buffer := get_info(buffer, "next"); endloop; return the_buffer; endprocedure ! procedure eve_copy_buffer local old_buff,new_buff,loc_status,loc_buffer,prompt; if (old_buff = eve$kt_null) then prompt := "Copy from: "; oldbuff := read_line(prompt); edit(oldbuff,UPPER); endif; if (new_buff = eve$kt_null) then prompt := "Copy to: "; newbuff := read_line(prompt); edit(newbuff,UPPER); endif; loc_status := eve$copy_buffer(oldbuff,newbuff); eve$update_status_lines; endprocedure procedure eve_destroy_buffer(the_name) ! Delete a buffer by name local the_buffer, buffer_name, loc_buffer; loc_buffer := get_info(current_buffer,"name"); if (not eve$prompt_string(the_name, buffer_name, "Delete buffer: ", "")) then ! if the string is null assume the current buffer is to be deleted if (not eve$prompt_string(loc_buffer, buffer_name, " ", "Cancelled")) then return; ! whoops user won't let us delete it endif; endif; the_buffer := eveplus_find_buffer(buffer_name); if (the_buffer <> 0) then bufed_destroy_buffer(buffer_name, the_buffer); else message("No such buffer: " + buffer_name); endif; endprocedure Procedure eve$copy_buffer(oldbuff,newbuff) local loc_buffer,loop_buffer,bufferptr; loc_buffer := current_buffer; if (oldbuff = eve$kt_null) then message("Did not specify buffer to copy from"); return(0); endif; if (newbuff = eve$kt_null) then message("Did not specify buffer to copy to"); return(0); endif; bufferptr := eve$find_buffer(newbuff); if (bufferptr = 0) then !create it bufferptr := create_buffer(newbuff); set (margins,bufferptr,eve$x_default_left_margin,132); message("New buffer created"); endif; loop_buffer := eve$find_buffer(oldbuff); if (loop_buffer = 0) then message("Buffer to copy from doesn't exist-try again"); position(loc_buffer); ! return to starting buffer return(0); endif; erase(bufferptr); position(bufferptr); copy_text(loop_buffer); ! loop_buffer var pointing to oldbuff position(loc_buffer); ! return to starting buffer return(1); !successful endprocedure ; ! Include a buffer or file. If user doesn't supply a value to the prompt, ! then try to find an active select range to include, else if input is entered ! then if buffer is not present, then try for a file by that name. procedure eve_include_buffer_file local this_file,prompt,loop_buffer,found_buffer; if (get_info(current_buffer,"mode") = INSERT) then prompt := "Enter include file or buffer name--insert mode: "; else prompt := "Enter include file or buffer name--overstrike mode: " endif; this_file := read_line(prompt); if (this_file = "") then ! if a select isn't active then we can't do anything if (eve$x_select_position = 0) then message("No file or buffer name given"); return; endif; ! else there's a select active try merging it eve_store_text; ! get the select range and store in paste buffer copy_text(paste_buffer); ! copy it in move_vertical(-1); erase_line; ! get rid of blank line at end of paste buffer return; endif; edit(this_file,UPPER); ! buffers are uppercase if (current_buffer = this_file) then message("Buffer currently in use...can not merge into self"); return; endif; loop_buffer := get_info(buffers,"first"); found_buffer := 0; loop exitif(loop_buffer = 0); if (this_file = get_info(loop_buffer,"name")) then found_buffer := 1; exitif 1; endif; loop_buffer := get_info(buffers,"next"); endloop; if (found_buffer) then ! try to include the local buffer copy_text(loop_buffer); message("Buffer included..."); else eve_include_file(this_file); endif; endprocedure procedure eve_list_all_buffers ! List system and non-system buffers eve$bufed_show(TRUE); endprocedure ! ! Procedure to print the current buffer. ! procedure eve_print_buffer local this_position, loc_buffer, buffer_name, file_name, print_command, print_process; on_error if error = tpu$_createfail then message("Subprocess could not be created"); return; endif; endon_error; set(informational,off); set(success,off); this_position := mark(none); loc_buffer := current_buffer; if (get_info(translate_buffer,"type") = UNSPECIFIED) then translate_buffer := create_buffer ('translation'); set (no_write, translate_buffer); endif; eve$search_controls(loc_buffer,translate_buffer);! Translate control characters. ! Get the output file from the original buffer and use it to write the ! translated buffer. buffer_name := get_info(loc_buffer,"name"); file_name := eve_output_file_name(loc_buffer) ; if file_name = "" then file_name := read_line (fao("Enter a file name to write buffer !AS to cancel: ", buffer_name)); if file_name = "" then set(informational,on); set(success,on); return; endif; endif; ! get rid of any version number if ( index(file_name,";") <> 0 ) then file_name := substr(file_name,1,index(file_name,";") - 1); endif; ! Set the output file on the original buffer. Consistent with eve_write_file. set(output_file,loc_buffer,file_name); set(output_file,translate_buffer,file_name); write_file(translate_buffer); print_command := read_line("Print command: "); if print_command = "" then print_command := "PRINT"; endif; print_command := print_command + " "; message(fao("Printing !AS with command !AS",file_name,print_command)); print_process := create_process(message_buffer,"$set noon"); send(print_command + file_name, print_process); delete(print_process); set(informational,on); set(success,on); update(message_window); position(this_position); endprocedure; ! procedure to toggle thru buffers and map next one to current_window procedure eve$next_buffer local next_buff; if (eve$check_bad_window) then message("Bad text window, try again"); return; endif; next_buff := get_info(buffers,"next"); if (next_buff = 0) then next_buff := get_info(buffers,"first"); endif; map(current_window,next_buff); endprocedure !*** revised to leave unmodified buffer alone if it already has a mod date !*** and not to put in blank line if the insert is done at the end of the !*** buffer ! ! this procedure modifies or inserts a comment that marks the current ! date and time as the last date modified when writing out a file from TPU ! !***** procedure eve_update_mod_date(;input_buffer) Local work_buffer, RLB_DATE_PAT, user_test_pat, end_pat, EVE$X_DATE_TIME_PAT, date_range, UPDATE_FLAG, file_type, ! what type of file is it? date_string, ! when it's being updated upd_pat, ! search pattern for locating the date comment_begin, comment_end, Mod_string, insert_pos, mod_start, update_pos, update_user, upd_range, save_position, out_name, user_begin, user_end, comment_logical, ! is commenting turned off by user date_time, blank_or_null ; on_error if (TPU$_CALLUSERFAIL = ERROR) then comment_logical := index(error_text,"0001BC"); if (comment_logical = eve$kt_null) then ! call_user is in trouble--check external code message("%EVEplus-F-ERROR unable to mod-date buffer"); message(error_text); return; endif; else message(fao('EVE_UPDATE_MOD_DATE, !AS on line: !SL', error_text,error_line)); return; endif; endon_error; save_position := mark(none); ! get logical translation for TPU$COMMENT-- if one exists comment_logical := call_user(RTP$CALLUSER_TRNLNM,"TPU$COMMENT"); edit(comment_logical,TRIM,UPPER); ! if user has turned off comments by setting TPU$COMMENT="NO" then return if (index("NO",comment_logical) ) <> 0 then return; endif; if get_info(input_buffer,"type") = UNSPECIFIED then work_buffer := current_buffer; else work_buffer := input_buffer; endif; update_flag := true; file_type := substr(file_parse(eve_output_file_name(work_buffer), '','',type),2,128); ! see if the current type is supported... if not then check comment_logical if index(","+comment_supported_types,","+file_type) = 0 then if (comment_logical = eve$kt_null) or ( index("YES",comment_logical)<>0) then return; else ! try the value of the logical as a file type to use file_type := comment_logical; ! see if this type is supported if index(","+comment_supported_types,","+file_type) = 0 then return; endif; endif; endif; ! set up the default conditions ! message(fao("Type='!AS', Index=!SL",file_type,rtp_comment_index{file_type})); insert_pos := beginning_of(work_buffer); mod_string := 'Last Modified: '; comment_end := ''; CASE rtp_comment_index{file_type} [1] : ! see if it is a DCL command procedure or a console procedure. position(beginning_of(work_buffer)); if search_quietly("deposit",forward,no_exact) <> 0 then ! it is a console procedure comment_begin := "!" ! it is a DCL procedure else comment_begin := '$!'; endif; insert_pos := end_of(work_buffer); [2] : comment_begin := '/*'; comment_end := '*/'; [3] : comment_begin := 'C '; [4] : comment_begin := '@Comment['; comment_end := ']'; mod_string := 'LastEditDate='; [5] : comment_begin := ';'; [6] : comment_begin := '{'; comment_end := '}'; [7] : comment_begin := '.;'; [8] : comment_begin := '!'; [9] : comment_begin := '*'; [10] : comment_begin := ";" [OTHERWISE] : update_flag := false; position(save_position); return; ENDCASE; ! Message(fao("Comment structure: !AS !AS",comment_begin,comment_end)); ! get the username via hook or crook if (get_info(eve$x_username,'type')<>string) then eve$x_username := call_user(rtp$calluser_getjpi,'USERNAME'); edit(eve$x_username,TRIM); endif; position(beginning_of(work_buffer)); blank_or_null := span(' ') | '' ; ! build the search pattern ! ! This pattern will match either of 2 date formats ! rlb_date_pat := ( ( eve$x_span_digits+'-'+eve$x_span_alpha+'-'+eve$x_span_digits ) | (eve$x_span_digits+'/'+eve$x_span_digits+'/'+eve$x_span_digits ) ) @date_range ; ! ! This pattern matches the date&time portion ! eve$x_date_time_pat := rlb_date_pat @date_time + ( span(' :') @date_time + ( eve$x_span_digits + ( (':'+eve$x_span_digits @date_time + ( (':'+eve$x_span_digits @date_time + ( ('.'+eve$x_span_digits @date_time ) | '' ) ) | '' ) ) | '' ) ) ) ; ! Pattern to match & parse the "last date modified" comment ! the "@variable" stores the range that is matched to the point ! in the pattern where it is found. if comment_end = eve$kt_null then end_pat := line_end; else end_pat := ( match( comment_end) | line_end ) ; endif; upd_pat := line_begin & match(comment_begin) & match(mod_string) @mod_start & eve$x_date_time_pat @user_begin & end_pat; date_string := fao('!%D',0); date_time := 0; user_begin := 0; ! it could be anywhere so start from the top position(beginning_of(work_buffer)); ! search for the comment update_pos := search_quietly(upd_pat,forward,no_exact); ! Message("Finished first search"); ! highlite_range(mod_start,"MOD_START"); ! Is there already one of these lines? if ( mod_start = 0 ) or ( date_time = 0 ) then ! since there isn't one yet, insert one position(insert_pos); mod_start := mark(none); copy_text(comment_begin+mod_string+date_string+ ', By: '+eve$x_username+' '+comment_end); if mod_start <> end_of(current_buffer) then split_line; endif; ! see if it's really been modified. If not leave it alone. ! substitute the new date ELSE if get_info(current_buffer,'modified') then position(end_of(mod_start)); Move_horizontal(1); position(end_of(mod_start)); move_horizontal(1); mod_start := mark(none); upd_range:=create_range(mod_start,end_of(date_time),none); erase(upd_range); copy_text(date_string); position(end_of(user_begin)); ! build the pattern to find the boundaries of the By: username string user_test_pat := ANCHOR & ', By:' + blank_or_null @user_begin + span(eve$x_symbol_characters) @user_end + blank_or_null; if comment_end = eve$kt_null then user_test_pat := user_test_pat + line_end ; else user_test_pat := user_test_pat + ( comment_end | line_end ) ; endif; ! Message("Searching for By:"); update_pos := search_quietly(user_test_pat,forward,exact); if (update_pos<>0) then position(end_of(user_begin)); move_horizontal(1); mod_start := mark(none); upd_range:=create_range(mod_start,end_of(user_end),none); ! highlite_range(upd_range,"UPD_RANGE"); erase(upd_range); copy_text(eve$x_username); else copy_text(', By: '+eve$x_username+' '); endif; endif; endif; position(save_position); update(current_window); endprocedure; ! ! Inputs: ! show_system Flag - causes system buffers to be listed ! ! Modify to show all buffers at once. The default procedure in EVE will allow ! you to show either system or non-system buffers but not both (sigh). ! Modified to show user buffers first. Put in header lines. 11-Oct-1988 procedure eve$bufed_show (show_system) ! Build the buffer list local saved_mark, saved_window, the_buffer, ! The buffer being listed state_flag, ! Flag for error handler temp; ! Used to build the record count as a string on_error [TPU$_CONTROLC]: set (MODIFIABLE, eve$x_bufed_buffer, OFF); if state_flag ! unmap the BUFFER LIST buffer then eve_buffer (get_info (get_info (saved_mark, "buffer"), "name")); endif; eve$$restore_position (saved_window, saved_mark); eve$learn_abort; abort; [TPU$_ENDOFBUF]: ! prevent EOB message if BUFFER LIST blank [OTHERWISE]: endon_error; if eve$check_bad_window then eve$learn_abort; return (FALSE); endif; saved_mark := mark (FREE_CURSOR); saved_window := current_window; if get_info (eve$x_bufed_buffer, "type") <> BUFFER then eve$x_bufed_buffer := get_info (BUFFERS, "find_buffer", "BUFFER LIST"); if eve$x_bufed_buffer = 0 then eve$x_bufed_buffer := eve$init_buffer ("BUFFER LIST", ""); ! set the status line as unmodifiable by eve$set_status_line eve$set_fixed_status_line (eve$x_bufed_buffer, message_text (EVE$_SHOWBUFSSTATUS, 1)); endif; endif; position (eve$x_bufed_buffer); set (MODIFIABLE, eve$x_bufed_buffer, ON); erase (eve$x_bufed_buffer); split_line; copy_text(" ---------- USER BUFFERS ---------------------------------"); the_buffer := get_info (BUFFERS, "first"); loop !output user buffers first exitif the_buffer = 0; if not get_info (the_buffer, "system") then eve$$bufed_format_line (the_buffer); endif; the_buffer := get_info (BUFFERS, "next"); endloop; split_line; copy_text(" ---------- SYSTEM BUFFERS ---------------------------------"); the_buffer := get_info (BUFFERS, "first"); loop !output non "$" system buffers exitif the_buffer = 0; if get_info (the_buffer, "system") and (substr (get_info (the_buffer, "name"), 1, 1) <> "$") then eve$$bufed_format_line (the_buffer); endif; the_buffer := get_info (BUFFERS, "next"); endloop; split_line; the_buffer := get_info (BUFFERS, "first"); loop ! output "$" system buffers exitif the_buffer = 0; if get_info (the_buffer, "system") and (substr (get_info (the_buffer, "name"), 1, 1) = "$") then eve$$bufed_format_line (the_buffer); endif; the_buffer := get_info (BUFFERS, "next"); endloop; position (beginning_of (current_buffer)); loop temp := search_quietly (" ", FORWARD, EXACT); exitif temp = 0; position (temp); erase (temp); split_line; eve$insert_text (message_text (EVE$_SHOWBUF_ENTRY3, 1, eve$x_bufed_buffer_name_length)); endloop; position (beginning_of (current_buffer)); eve$insert_text (message_text (EVE$_SHOWBUF_HEAD, 1)); state_flag := TRUE; map (current_window, eve$x_bufed_buffer); set (STATUS_LINE, current_window, REVERSE, message_text (EVE$_SHOWBUFSSTATUS, 1)); split_line; position (beginning_of (current_buffer)); move_vertical (2); move_horizontal (2); set (MODIFIABLE, eve$x_bufed_buffer, OFF); return (TRUE); endprocedure; ! ! center a string of text on a line with a repeat character. ! string := rlb_center("=","This is a Heading",60) ;! produces the string below ! message(string); ! =====================This is a Heading===================== ! procedure rlb_center(marker_char,heading_text,line_length) local line_out, line_len, repeat_count; ! figure out how much space is needed to move the text to center repeat_count := (line_length-length(heading_text))/2; ! concatenate the 3 pieces rlb_center := fao("!#*"+marker_char+"!AS!#*"+marker_char, repeat_count,heading_text,repeat_count); endprocedure; ! Convert a string to numeric format for non-decimal strings procedure cnv_to_int(in_string,cnv_type) local work_num, len, base, ic,char, adder ; if cnv_type = eve$kt_null then cnv_type := "H" ; endif; if cnv_type = "D" then cnv_to_int := int(in_string); return; else if cnv_type = "H" then base := 16 ; else if cnv_type = "O" then base := 8 ; else message("Can't convert "+in_string+" to base "+cnv_type); return(0); endif; endif; endif; ic := 0; work_num := 0; len := length(in_string); loop ic:= ic+1; exitif ic > len ; char := substr(in_string,ic,1); case char from "0" to "F" ["0","1","2","3","4","5","6","7","8","9"] : adder := int(char) ; ["A"] : adder := 10 ; ["B"] : adder := 11 ; ["C"] : adder := 12 ; ["D"] : adder := 13 ; ["E"] : adder := 14 ; ["F"] : adder := 15 ; endcase; work_num := base*work_num+adder; endloop; cnv_to_int := work_num ; endprocedure procedure eve_end_of_line ! Move to end of the current line local cursor_is_bound; on_error [OTHERWISE]: endon_error; cursor_is_bound := get_info (current_buffer, "bound"); position (search (ANCHOR, FORWARD)); ! snap cursor to text if (mark (NONE) = end_of (current_buffer)) and (mark(none) = beginning_of(current_buffer)) then ! if file is empty if cursor_is_bound then eve$message (EVE$_ATEOL); return (FALSE); ! no learn_abort here endif; else !something out there... if (current_direction = reverse) then if mark(none) = beginning_of(current_buffer) then if cursor_is_bound then message("EVE-E-BOF already at beginning of buffer"); return; else return; ! just sit there endif; else ! else not at BOF if mark(none) = end_of(current_buffer) then ! just move one space back move_horizontal(-1); return; else ! else move to BOLN and up one move_horizontal(-current_offset); ! move to beginning of line move_horizontal(-1); ! move to EOLN previous line endif; endif; else ! else moving forward (and onward) if mark(none) = end_of(current_buffer) then if cursor_is_bound then message("EVE-E-EOB already at end of buffer"); return; else return; ! else just sit on the log endif; else if current_character = eve$kt_null then ! if at the EOLN move_vertical(1); endif; if mark(none) <> end_of(current_buffer) then ! after moving vertical goto EOLN position(search(line_end,forward)); ! else just goto EOL endif; endif; endif; endif; return (TRUE); endprocedure; procedure eve_exist_buffer(loop_buffer,found_buffer,this_file) loop_buffer := get_info(buffers,"first"); found_buffer := 0; loop exitif(loop_buffer = 0); if (this_file = get_info(loop_buffer,"name")) then found_buffer := 1; exitif 1; endif; loop_buffer := get_info(buffers,"next"); endloop; if (found_buffer) then return(1); else message("Error buffer doesn't exist"); return(0); endif; endprocedure ! This procedure will append a select range (if present) or buffer ! to another buffer. You need not be presently in either buffer ! If the buffer to be appended to doesn't exist then it's created. procedure eve_append_buffer local exists,from_buffervar,to_buffervar,prompt,this_buffer, that_buffer,found_buffer,loop_buffer,select_flag,save_buffer; save_buffer := current_buffer; ! save our current buffer select_flag := 0; from_buffervar := select_range; if (from_buffervar <> 0) then ! if a select is present use it select_flag := 1; prompt := "Append select range to buffer: "; that_buffer := read_line(prompt); edit(that_buffer,UPPER); exists := eve_exist_buffer(to_buffervar,found_buffer,that_buffer); if (exists = 0) then to_buffervar := create_buffer(that_buffer); message("Creating buffer..."); endif; else ! else prompt for a buffer prompt := "Append which buffer? "; this_buffer := read_line(prompt); edit(this_buffer,UPPER); exists := eve_exist_buffer(from_buffervar,found_buffer,this_buffer); if (exists = 0) then return; endif; prompt := "Append to buffer: "; that_buffer := read_line(prompt); edit(that_buffer,UPPER); exists := eve_exist_buffer(to_buffervar,found_buffer,that_buffer); if (exists = 0) then to_buffervar := create_buffer(that_buffer); message("Creating buffer..."); endif; endif; position(end_of(to_buffervar)); move_text(from_buffervar); if (select_flag) then eve$x_select_position := 0; ! turn it off message("Selection cancelled."); endif; position(save_buffer); endprocedure !procedure to erase the current buffer procedure rtp$erase_current_buffer local prompt,answer; prompt := "Really erase this buffer? : "; answer := read_line(prompt); edit(answer,UPPER); if ((answer = eve$kt_null) or (answer = 'N') or (answer = "NO")) then return; endif; erase(current_buffer); return; endprocedure; ! procedure to unmap current window from screen procedure rtp$unmap_window unmap(current_window); endprocedure; ! procedure to count the number of user buffers procedure eve$count_user_buffers local the_buffer,buffer_count; buffer_count := 0; the_buffer := get_info (BUFFERS, "first"); loop !output user buffers first exitif the_buffer = 0; if not get_info (the_buffer, "system") then buffer_count := buffer_count + 1; endif; the_buffer := get_info (BUFFERS, "next"); endloop; return(buffer_count); endprocedure; procedure eveplus_section if (current_direction = forward) then eve$move_by_screen(1); else eve$move_by_screen(-1); endif; endprocedure procedure eve_replace (target_arg, ! EVE Replace replacement_arg) ! Modify so that upon ctrl-C it toggles back to white map local target, ! Local copy of replace_parameter_1 replacement, ! Local copy of replace_parameter_2 this_buffer, ! Current buffer saved_mode, ! Keyword for current mode lowercase_target, ! Lowercase version of target string lowercase_replacement, ! Lowercase version of replacement string uppercase_target, ! Uppercase version of target string uppercase_replacement, ! Uppercase version of replacement string capital_target, ! Capitalized version of target string capital_replacement, ! Capitalized version of replacement string how_exact, ! Keyword to indicate replace's case-sensitivity search_exact, ! Keyword to indicate search's case-sensitivity repeat_find_range, ! Range of found string after reverse directn here, ! Position marker found_forward, ! Flag if found in forward found_reverse, ! Flag if found in reverse pivot_point, ! Marker on position where direction is changed this_direction, ! Current direction before find saved_direction, ! Current direction upon entry other_direction, ! Opposite direction for reverse search erasing_pivot_point, ! Flag if pivot_point marker text is replaced last_found, ! Marker at last string found in one dir find_reply, ! User's reply to find prompt change_direction_key, ! Key terminating reply switched_pivot_point, ! Flag if direction toggled temp_mark, ! Temporary marker replace_range, ! Range of current occurrence highlight_range, ! Reverse-video version of replace_range replace_action, ! String reply to prompt action_length, ! Length of replace_action colon_index, ! Index of : in 'all:' asking, ! True unless eve$x_all option has been chosen this_occurrence, ! String of replace_range saved_mark, ! Marker at start of procedure occurrences; ! Number of replacements made so far on_error [TPU$_CONTROLC]: eve$message (EVE$_REPLCTRLC, 0, occurrences); eve$$restore_position (saved_mark); set (saved_direction, current_buffer); set (saved_mode, current_buffer); set (SCREEN_UPDATE, ON); eve_toggle_white_map; ! if aborting then toggle back to white map eve$learn_abort; abort; [OTHERWISE]: eve$$restore_position (saved_mark); set (saved_direction, current_buffer); set (saved_mode, current_buffer); set (SCREEN_UPDATE, ON); endon_error; if not eve$test_if_modifiable (current_buffer) then eve$learn_abort; return (FALSE); endif; if not (eve$prompt_string (target_arg, target, message_text (EVE$_OLDPROMPT, 1), message_text (EVE$_NOREPLSTR, 0))) then eve$learn_abort; return (FALSE); endif; saved_mark := mark (FREE_CURSOR); position (search (ANCHOR, FORWARD)); ! snap cursor to prevent padding this_buffer := current_buffer; asking := TRUE; !+ ! Initialization !- saved_mode := get_info (current_buffer, "mode"); set (INSERT, this_buffer); switched_pivot_point := FALSE; pivot_point := mark (FREE_CURSOR); ! here's where we'll look in other_direction saved_direction := current_direction; if saved_direction = FORWARD then other_direction := REVERSE; else other_direction := FORWARD; endif; replacement := replacement_arg; if replacement = "" then replacement := eve$prompt_line (message_text (EVE$_NEWPROMPT, 1), eve$$x_prompt_terminators); if replacement = 0 then set (saved_mode, this_buffer); eve$learn_abort; return (FALSE); endif; endif; !+ ! Set up case of targets !- lowercase_target := target; if get_info (lowercase_target, "type") = STRING then change_case (lowercase_target, LOWER); endif; if (lowercase_target = target) then search_exact := eve$x_find_no_exact; else search_exact := eve$x_find_exact; endif; lowercase_replacement := replacement; change_case (lowercase_replacement, LOWER); if (lowercase_target = target) and (lowercase_replacement = replacement) then how_exact := eve$x_find_no_exact; uppercase_target := target; if get_info (uppercase_target, "type") = STRING then change_case (uppercase_target, UPPER); endif; capital_target := target; if get_info (capital_target, "type") = STRING then eve$capitalize_string (capital_target); endif; uppercase_replacement := replacement; change_case (uppercase_replacement, UPPER); capital_replacement := replacement; eve$capitalize_string (capital_replacement); else how_exact := eve$x_find_exact; endif; eve$x_target := target; ! eve$$find searches for eve$x_target found_forward := FALSE; found_reverse := FALSE; !%IF eve$x_option_fonts !%THEN !%eve$save_font; !%ENDIF !%IF eve$x_option_evej !%THEN !% eve$conversion_cancel; !%ENDIF eve$$remove_found_range; ! remove range so current position is searched !+ ! Search for target !- loop repeat_find_range := 0; erasing_pivot_point := FALSE; this_direction := current_direction; replace_range := eve$$find (search_exact, 1, 1); set (this_direction, current_buffer); if replace_range = 0 then if learn_abort ! Don't look in opposite dir if in LEARN SEQ then !%IF eve$x_option_fonts !%THEN !%eve$restore_font; !%ENDIF if not asking then position (saved_mark); ! return to old spot if 'all' endif; set (saved_direction, current_buffer); ! always restore original set (saved_mode, this_buffer); ! direction and mode set (SCREEN_UPDATE, ON); eve$message (EVE$_FINDFAIL); eve$message (EVE$_REPLCOUNT, 0, occurrences); eve$message (EVE$_LEARNABORTBIG); !%IF eve$x_option_evej !%THEN !% eve$conversion_start; !%ENDIF return (FALSE); endif; here := mark (FREE_CURSOR); ! remember last found string in case user ! doesn't want to go to next one !+ ! Search in other direction from pivot point. !- last_found := mark (FREE_CURSOR); ! (maybe = pivot_point) position (pivot_point); set (other_direction, current_buffer); this_direction := current_direction; replace_range := eve$$find (search_exact, 1, 0); set (this_direction, current_buffer); if (replace_range = 0) then !+ ! Couldn't find one on other side of pivot_point; so ! go to last one found, and search in other direction. !- position (last_found); pivot_point := mark (FREE_CURSOR); switched_pivot_point := TRUE; ! see if ANY other occurrences still exist this_direction := current_direction; repeat_find_range := eve$$find (search_exact, 1, 0); set (this_direction, current_buffer); exitif (repeat_find_range = 0); ! no more occurrences endif; if not asking ! We're in 'all' loop: during prompts, then ! return to location that's showing on temp_mark := mark (FREE_CURSOR); ! screen so the screen doesn't position (saved_mark); ! change (eve$prompt_line doesn't use set (SCREEN_UPDATE, ON); ! read_lines -> must turn on update) endif; if (repeat_find_range <> 0) or ((replace_range <> 0) and switched_pivot_point) or ((replace_range <> 0) and found_forward and found_reverse) then !+ ! Ask if ok to re-replace in another pass thru the buffer. !- if other_direction = FORWARD then find_reply := eve$prompt_line (message_text (EVE$_REPLACEFWDAGAIN, 1), eve$$x_prompt_terminators); else find_reply := eve$prompt_line (message_text (EVE$_REPLACEREVAGAIN, 1), eve$$x_prompt_terminators); endif; else if other_direction = FORWARD then ! ask if want to go in other dir find_reply := eve$prompt_line (message_text (EVE$_REPLACEFWD, 1), eve$$x_prompt_terminators); else find_reply := eve$prompt_line (message_text (EVE$_REPLACEREV, 1), eve$$x_prompt_terminators); endif; endif; if find_reply = 0 then set (saved_direction, current_buffer); ! always restore original set (saved_mode, this_buffer); ! direction and mode set (SCREEN_UPDATE, ON); eve$learn_abort; return (FALSE); endif; if not asking ! turn screen update off again, then return then ! to last found string and continue set (SCREEN_UPDATE, OFF); position (temp_mark); endif; ! Hitting return or do means yes; hitting another non-typing ! key is probably a mistake, so interpret as no. if find_reply = "" then change_direction_key := eve$$lookup_comment (last_key, ""); if eve$test_synonym ("do", change_direction_key) or eve$test_synonym ("return", change_direction_key) then if (repeat_find_range <> 0) or ((replace_range <> 0) and switched_pivot_point) or ((replace_range <> 0) and found_forward and found_reverse) then find_reply := eve$x_no; ! 2nd pass starting else find_reply := eve$x_yes; ! more new ones endif; else find_reply := eve$x_yes; ! not default key = yes endif; else change_case (find_reply, LOWER); endif; !+ ! test the reply and stop if 'no' !- position (here); exitif substr (eve$x_no, 1, length (find_reply)) = find_reply; if (replace_range = 0) and (repeat_find_range <> 0) then replace_range := repeat_find_range; ! new replace range endif; ! go to the find string (last find did not position to it) position (replace_range); if other_direction = FORWARD ! flip the direction for next find then other_direction := REVERSE; else other_direction := FORWARD; endif; endif; if replace_range <> 0 then ! any ELSE?? !+ ! Hilight the occurrence and ask user what to do with it. !- if current_direction = FORWARD then found_forward := TRUE; else found_reverse := TRUE; endif; if asking then highlight_range := create_range (beginning_of (replace_range), end_of (replace_range), eve$x_highlighting); endif; position (beginning_of (replace_range)); if mark (NONE) = pivot_point then erasing_pivot_point := TRUE; endif; if asking then update (current_window); endif; loop if asking then replace_action := eve$prompt_line (message_text (EVE$_REPLPROMPT, 1), eve$$x_prompt_terminators); if replace_action = 0 then ! always restore original direction and mode set (saved_direction, current_buffer); set (saved_mode, this_buffer); set (SCREEN_UPDATE, ON); eve$learn_abort; return (FALSE); endif; if eve$test_synonym ("exit", eve$$lookup_comment (last_key, eve$x_key_map_list)) then ! EXIT = quit replacing replace_action := eve$x_quit; endif; change_case (replace_action, LOWER); else replace_action := eve$x_yes; endif; action_length := length (replace_action); if (replace_action = substr (eve$x_yes, 1, action_length)) or (replace_action = substr (eve$x_all, 1, action_length)) or (replace_action = substr (eve$x_last, 1, action_length)) or (action_length = 0) then highlight_range := 0; !%IF eve$x_option_fonts !%THEN !% eve$match_font (replace_range); !%ENDIF this_occurrence := erase_character (length (replace_range)); if how_exact = eve$x_find_exact then copy_text (replacement); else ! Make sure non-alphabetic target is replaced by lowercase if this_occurrence = lowercase_target then copy_text (lowercase_replacement); else if this_occurrence = uppercase_target then copy_text (uppercase_replacement); else if this_occurrence = capital_target then copy_text (capital_replacement); else copy_text (lowercase_replacement); endif; endif; endif; endif; if erasing_pivot_point ! 'pivot_point' marker text erased, then ! redo the marker temp_mark := mark (FREE_CURSOR); move_horizontal (-length (replacement)); pivot_point := mark (FREE_CURSOR); position (temp_mark); endif; if current_direction = REVERSE then move_horizontal (-length (replacement)); endif; occurrences := occurrences + 1; if asking then update (current_window); if (replace_action = substr (eve$x_all, 1, action_length)) and (action_length > 0) then asking := FALSE; eve$message (EVE$_REPLALL, 0, target); saved_mark := mark (FREE_CURSOR);! return here when done set (SCREEN_UPDATE, OFF); endif; endif; exitif 1; else if (replace_action = substr (eve$x_no, 1, action_length)) or (replace_action = substr (eve$x_quit, 1, action_length)) then highlight_range := 0; if current_direction = FORWARD then position (end_of (replace_range)); move_horizontal (1); endif; update (current_window); exitif 1; endif; endif; endloop; exitif (action_length > 0) and ((replace_action = substr (eve$x_quit, 1, action_length)) or (replace_action = substr (eve$x_last, 1, action_length))); endif; endloop; !%IF eve$x_option_fonts !%THEN !%eve$restore_font; !%ENDIF if not asking then position (saved_mark); ! return to original spot only if 'all' endif; set (saved_direction, current_buffer); ! always restore original direction set (saved_mode, this_buffer); ! and mode set (SCREEN_UPDATE, ON); eve$message (EVE$_REPLCOUNT, 0, occurrences); !%IF eve$x_option_evej !%THEN !% eve$conversion_start; !%ENDIF return (TRUE); endprocedure;