!**************************************** PROCEDURE EVE_LIST_BUFFERS ! List non-system buffers bufed_list_buffers(FALSE); ENDPROCEDURE; !**************************************** PROCEDURE EVE_LIST_ALL_BUFFERS ! List system and non-system buffers bufed_list_buffers(TRUE); ENDPROCEDURE; !**************************************** PROCEDURE EVE_DESTROY_BUFFER(THE_NAME) ! Delete a buffer by name local the_buffer, buffer_name; if(not eve$prompt_string(the_name, buffer_name, "Delete buffer: ", "Cancelled"))then return; 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 BUFED_LIST_BUFFERS(SHOW_SYSTEM) ! The following procedure actually creates the formatted buffer list. ! It also temporarily rebinds the SELECT and REMOVE keys to routines ! that goto the buffer listed on the line the cursor is on or to ! delete it. ! ! Inputs: ! show_system Flag - causes system buffers to be listed ! ! Build the buffer list local last_buffer, ! Used to tell when we've done the last one the_buffer, ! The buffer being listed temp; ! Used to build the record count as a string eve_buffer("LIST BUFFER"); set(system, current_buffer); set(no_write, current_buffer); erase(current_buffer); message("Collecting buffer list"); last_buffer := get_info(buffers, "last"); the_buffer := get_info(buffers, "first"); loop exitif (the_buffer = 0); if (show_system or (get_info(the_buffer, "system") = 0)) then split_line; eveplus_insert_text(" "); eveplus_insert_text(get_info(the_buffer, "name")); temp := fao("!6UL ", get_info(the_buffer, "record_count")); if (current_offset >= 33) then eveplus_insert_text(""); else loop exitif (current_offset > 33); eveplus_insert_text(" "); endloop; endif; eveplus_insert_text(temp); if (get_info(the_buffer, "modified")) then eveplus_insert_text("Modified "); else eveplus_insert_text(" "); endif; if (get_info(the_buffer, "no_write")) then eveplus_insert_text("No-write "); else eveplus_insert_text(" "); endif; if (get_info(the_buffer, "system")) then eveplus_insert_text("System "); else eveplus_insert_text(" "); endif; if (get_info(the_buffer, "permanent")) then eveplus_insert_text("Permanent"); else eveplus_insert_text(" "); endif; temp := current_line; move_horizontal (-current_offset); erase (create_range (mark (none), end_of (current_buffer), none)); edit (temp, trim_trailing); copy_text (temp); endif; exitif (the_buffer = last_buffer); the_buffer := get_info(buffers, "next"); endloop; if (eveplus_defined_procedure("eveplus_sort")) then message("Sorting buffer list"); execute('eveplus_sort ( current_buffer , "" ); '); endif; position(beginning_of(current_buffer)); loop temp := eveplus_search_quietly("", FORWARD); exitif (temp = 0); position(temp); erase(temp); eveplus_insert_text(" -"); split_line; eveplus_insert_text(" "); endloop; position(beginning_of(current_buffer)); eveplus_insert_text(" Buffer name Lines Attributes"); split_line; position(beginning_of(current_buffer)); move_vertical(2); move_horizontal(2); if (not bufed_x_active) then set(informational,off); if eve$x_vt200_keypad then eveplus_key("bufed_select_buffer", e4, "select buffer", "bufed_select_key"); eveplus_key("bufed_remove_buffer", e3, "remove buffer", "bufed_remove_key"); else eveplus_key("bufed_select_buffer", ctrl_g_key, "select buffer", "bufed_select_key"); eveplus_key("bufed_remove_buffer", key_name(ctrl_g_key,shift_key), "remove buffer", "bufed_remove_key"); endif; set(informational,on); endif; bufed_x_active := TRUE; message(" "); ENDPROCEDURE; !**************************************** PROCEDURE BUFED_REMOVE_BUFFER ! This routine is temporarily bound to the REMOVE key. It deletes ! the buffer listed on the current line. It only works in the ! "LIST BUFFER" buffer. If it is struck outside of that buffer, ! it restores the original binding of the SELECT and REMOVE keys and ! and executes the program originally associated with the REMOVE key. ! The routine bufed_select_buffer also unbinds this key. local the_buffer, ! Pointer to the buffer the_name, ! Name of the buffer as a string the_type; ! Type of the code bound to the key if (get_info(current_buffer, "name") <> "LIST BUFFER") then message("Not in the LIST BUFFER"); set(informational,off); eveplus_restore_key("bufed_select_key"); eveplus_restore_key("bufed_remove_key"); set(informational,on); bufed_x_active := FALSE; the_type := get_info(bufed_remove_key_pgm, "type"); if ((the_type = LEARN) or (the_type = PROGRAM) or (the_type = STRING)) then execute(bufed_remove_key_pgm); endif; else if (bufed_get_the_buffer(the_name, the_buffer) <> 0) then if (bufed_destroy_buffer(the_name, the_buffer)) then move_horizontal(-current_offset); move_vertical(1); move_horizontal(-2); if (current_character = "-") then move_horizontal(-current_offset); erase_line; else move_horizontal(-current_offset); endif; erase_line; endif; endif; endif; ENDPROCEDURE; !**************************************** PROCEDURE BUFED_DESTROY_BUFFER(THE_NAME, THE_BUFFER) ! 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 ! 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; !**************************************** PROCEDURE BUFED_SELECT_BUFFER ! This routine is temporarily bound to the SELECT. It puts you in ! the buffer listed on the current line, and restores the original ! meanings of the SELECT and REMOVE keys. It only works in the ! "LIST BUFFERS" buffer. If it is invoked outside of that buffer, ! it restores the original bindings of the SELECT and REMOVE keys, ! and executes the code originally associated with SELECT. ! local the_buffer, ! Pointer to the buffer the_name, ! Name of the buffer as a string the_type; ! Type of the code bound to the key if (get_info(current_buffer, "name") <> "LIST BUFFER") then message("Not in the LIST BUFFER"); set(informational,off); eveplus_restore_key("bufed_select_key"); eveplus_restore_key("bufed_remove_key"); set(informational,on); bufed_x_active := FALSE; the_type := get_info(bufed_select_key_pgm, "type"); if ((the_type = LEARN) or (the_type = PROGRAM) or (the_type = STRING)) then execute(bufed_select_key_pgm); endif; else if (bufed_get_the_buffer(the_name, the_buffer) <> 0) then eve_buffer(the_name); set(informational,off); eveplus_restore_key("bufed_select_key"); eveplus_restore_key("bufed_remove_key"); set(informational,on); bufed_x_active := FALSE; endif; endif; ENDPROCEDURE; !**************************************** PROCEDURE BUFED_GET_THE_BUFFER(THE_NAME, THE_BUFFER) ! This routine scans the line the cursor is on and if it is in the ! proper format for a buffer listing, it returns both the name of ! the buffer and a pointer to it. 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; !**************************************** PROCEDURE EVE_DESCRIBE_KEY ! This procedure will prompt for a key stroke or shift sequence and look ! up the comment that was attributed to the keystroke when it was defined. ! If there was no comment given, the message "Key Has No Function..." is ! displayed in the message area at the bottom of the screen. Otherwise, ! the key's function is displayed. This function assumes that there will ! always be some sort of comment given when keys are defined to user ! procedures. This may not be an acurate assumption in all circumstances. ! The value of this function depends on the descriptive nature of the names ! of user routines. It should be noted that this works on DEFINE KEY ! operations also. So use the whole function name to get the best ! description. LOCAL key_to_describe, key_description; MESSAGE("Press Key to Describe:"); key_to_describe := READ_KEY; key_description := LOOKUP_KEY(key_to_describe,COMMENT); IF key_description <> "" THEN MESSAGE("Function Description : " + key_description); ELSE MESSAGE("Key Has No Function..."); ENDIF; ENDPROCEDURE; !**************************************** PROCEDURE EVE_DISPLAY_CHARACTER ! This procedure writes a one line message describing the current character ! in terms of Octal, Decimal, Hexadecimal and (sometimes ) '^' notation. LOCAL i,cc; ! Handle end-of-buffer condition IF MARK( NONE ) = END_OF( CURRENT_BUFFER ) THEN MESSAGE( 'At end of buffer, no current character.' ); RETURN; ENDIF; ! Convert the character to an integer the hard way (no builtin yet) i := 0; LOOP; EXITIF i > 255; EXITIF CURRENT_CHARACTER = ASCII(i); i := i + 1; ENDLOOP; IF i > 255 THEN i := 0; ENDIF; ! On overflow, reset to NULL ! Provide ^ notation for ASCII control characters IF i < 32 THEN cc := ', ^' + ASCII(i+64); ELSE cc := ''; ENDIF; ! Format and output the results MESSAGE(FAO("Current Character is '!AS', Octal=!OB, Decimal=!-!UB, " + "Hex=!-!XB!AS", CURRENT_CHARACTER, i, cc ) ); ENDPROCEDURE; !**************************************** PROCEDURE EVE_FIX_CRLFS ! FIX_CRLFS.TPU - Routine to turn CRLFs into line breaks ! and remove leading CRs and trailing CRLFs LOCAL the_range; on_error if (ERROR <> tpu$_STRNOTFOUND) then message("Error (" + str(ERROR) + ") at line " + str(ERROR_LINE)); return; endif; endon_error; ! ! First remove the CRLFs. If they are not at the EOL, add a line break. ! position(beginning_of(current_buffer)); loop the_range := search(ascii(13)+ascii(10), FORWARD); exitif (the_range = 0); erase(the_range); position(beginning_of(the_range)); if (current_character <> "") then split_line; endif; endloop; ! ! Next remove naked LFs. If they are not at the EOL, add a line break. ! position(beginning_of(current_buffer)); loop the_range := search(ascii(10), FORWARD); exitif (the_range = 0); erase(the_range); position(beginning_of(the_range)); if (current_character <> "") then split_line; endif; endloop; ! ! Finally, remove naked CRs. If they are not at the BOL, add a line break. ! position(beginning_of(current_buffer)); loop the_range := search(ascii(13), FORWARD); exitif (the_range = 0); position(end_of(the_range)); if (current_offset <> 0) then split_line; endif; erase(the_range); endloop; ENDPROCEDURE; !**************************************** PROCEDURE EVE_LIST_COMMANDS ! LIST_COMMANDS.TPU - Routine to list all EVE (or EVEplus) ! commands (sort alphabetically, perhaps) local the_names, column_width, total_width, how_many_columns, temp; eve_mark("eveplus_saved_buffer"); the_names := expand_name("eve_", procedures) + " "; position(eve$choice_buffer); erase(eve$choice_buffer); message("Building command list"); loop exitif (the_names = eve$x_null); temp := index (the_names, " "); if (temp = 0) then message("Can't find space"); return; endif; copy_text (substr (the_names, 1, temp-1)); the_names := substr(the_names, temp+1, length(the_names)); split_line; erase_line; endloop; position(beginning_of(current_buffer)); loop temp := eveplus_search_quietly(line_begin & "EVE_", FORWARD); exitif (temp = 0); position(temp); erase(temp); endloop; position(beginning_of(current_buffer)); loop exitif (eveplus_replace(" EVE_", " ") = 0); endloop; position(beginning_of(current_buffer)); loop temp := eveplus_search_quietly(" ", FORWARD); exitif (temp = 0); position(temp); erase(temp); split_line; endloop; position(beginning_of(current_buffer)); loop exitif (eveplus_replace("_", " ") = 0); endloop; if (eveplus_defined_procedure("eveplus_sort")) then message("Sorting command list"); execute('eveplus_sort ( current_buffer , "" );'); endif; eve$format_choices; set (status_line, info_window, reverse, " Eve commands -- DO will remove this list"); position(show_buffer); erase(show_buffer); copy_text(eve$choice_buffer); position(beginning_of(current_buffer)); set(screen_update, off); eve_go_to("eveplus_saved_buffer"); set(screen_update, on); map (info_window, show_buffer); message(" "); ENDPROCEDURE; !**************************************** PROCEDURE EVE_SET_NOWRITE ! NO_WRITE.TPU - Routine to mark a buffer as NO_WRITE and cause ! status line to be bold for all NO_WRITE buffers. local buffer_name; if (get_info (current_buffer, "system") = 0) then buffer_name := get_info(current_buffer,"name"); set(no_write, current_buffer, on); message("Buffer " + buffer_name + " is write locked."); eve$update_status_lines; endif; ENDPROCEDURE; !**************************************** PROCEDURE EVE_SET_WRITE local buffer_name; if (get_info (current_buffer, "system") = 0) then buffer_name := get_info(current_buffer,"name"); set(no_write, current_buffer, off); message("Buffer " + buffer_name + " is write enabled."); eve$update_status_lines; endif; ENDPROCEDURE; !**************************************** PROCEDURE EVE$SET_STATUS_LINE (THIS_WINDOW) ! Set status line of a window to include buffer name and mode indications. ! Used primarily to indicate insert/overstrike and forward/reverse toggling. ! ! Parameters: ! ! this_window Window whose status line is being set - input local this_buffer, ! Current buffer mode_string, ! String version of current mode direction_string, ! String version of current direction buffer_name; ! String containing name of current buffer this_buffer := get_info (this_window, "buffer"); ! Don't add a status line to windows without a status line if (this_buffer = 0) or (get_info (this_window, "status_line") = 0) then return; endif; if get_info (this_buffer, "mode") = insert then mode_string := "Insert "; else mode_string := "Overstrike"; endif; if get_info (this_buffer, "direction") = reverse then direction_string := "Reverse"; else direction_string := "Forward"; endif; buffer_name := get_info (this_buffer, "name"); if length (buffer_name) > eve$x_max_buffer_name_length then buffer_name := substr (buffer_name, 1, eve$x_max_buffer_name_length); else buffer_name := buffer_name + substr (eve$x_spaces, 1, eve$x_max_buffer_name_length - length (buffer_name)); endif; if (get_info (this_buffer, "no_write")) and (get_info (this_buffer, "system") = 0) then set (status_line, this_window, bold, "X"); set (status_line, this_window, underline, "X"); else set (status_line, this_window, none, "X"); endif; set (status_line, this_window, reverse, " Buffer " + buffer_name + " " + mode_string + " " + direction_string); ENDPROCEDURE; !**************************************** !+ ! PRINT.TPU - !- ! ! A set of procedures that implement the following EVE commands for ! printing on the printer attached to your terminal. ! ! PRINT FILE - Print named file (will prompt if not specified) ! PRINT FF - Print a formfeed. ! PRINT RANGE - Print the current select range or the current buffer ! if no select active. ! PRINT SCREEN - Print the current screen display. ! ! In the interest of saving paper, these procedures do not automatically ! print a formfeed at the end of the listing. Use PRINT FF to cause ! paper eject between listings. ! PROCEDURE EVE_PRINT_SCREEN set (text, message_window, no_translate); message(ascii(27) + '[i'); update(message_window); set (text, message_window, blank_tabs); ! Put back the window the way it was erase(message_buffer); ENDPROCEDURE; !**************************************** PROCEDURE EVE$PRINT_RANGE (RANGE_TO_PRINT, BRIEF_MESSAGE) ! ! Procedure to print a range. Accepts the range as input ! local v_pos; v_pos := mark(none); set (text, message_window, no_translate); message(ascii(27) + '[5i'); !Turn on printer controller mode update (message_window); if (brief_message <> eve$x_null) then message (brief_message); update (message_window); endif; position(beginning_of(range_to_print)); ! ! Print the range. Note that we have to do carriage control ourselves ! loop exitif (mark(none) >= end_of (range_to_print)); message (current_line); !Write line to printer update (message_window); !Make sure it gets out message (ascii (13)+ascii(10)); !Write crlf update (message_window); move_vertical (1); !Next line in range endloop; message(ascii(27) + '[4i'); !Turn off printer controller mode update(message_window); set (text, message_window, blank_tabs); ! Put back the window the way it was erase(message_buffer); position(v_pos); ENDPROCEDURE; !**************************************** PROCEDURE EVE_PRINT_RANGE ! ! EVE command to print a range, or the whole buffer if ! there is no select active. Does not clear the select range ! local v_range, v_line, v_pos; v_pos := mark(none); if (eve$x_select_position = 0) then v_range := create_range (beginning_of(current_buffer), end_of(current_buffer), none); else v_range := create_range (eve$x_select_position, mark(none), none); endif; eve$print_range (v_range, eve$x_null); ENDPROCEDURE; !**************************************** PROCEDURE EVE_PRINT_FILE(FILE_TO_PRINT) ! ! EVE PRINT FILE command. Accepts a file name, and prints the ! file on the printer port. ! local print_file, v_pos, v_file, v_header; on_error position (v_pos); return; endon_error; v_pos := mark(none); if eve$prompt_string (file_to_print, print_file, "File to print: ", "No file printed") then position (eve$choice_buffer); erase (current_buffer); v_file := read_file (print_file); message (eve$x_null); v_header := fao("[!AS !%D]!/!/",v_file, 0); eve$print_range (create_range (beginning_of (current_buffer), end_of (current_buffer), none),v_header); erase (current_buffer); position (v_pos); endif; ENDPROCEDURE; !**************************************** PROCEDURE EVE_PRINT_FF ! ! Procedure to print a form feed on the printer port ! set (text, message_window, no_translate); message(ascii(27) + '[5i' +ascii(12) +ascii(27) + '[4i'); update(message_window); set (text, message_window, blank_tabs); ! Put back the window the way it was erase(message_buffer); refresh; ENDPROCEDURE; !**************************************** !+ ! PRINT_BUFFER.TPU !- ! ! The 3 following procedures copies the current buffer to another buffer, ! translates control characters to readable characters and writes the ! new buffer. It then submits the file to the specified print que (default ! SYS$PRINT). The first two procedures are taken from this note file ! and modified a bit. The last procedure calls the other two and creates ! the subprocess/writes the file/prints the file. ! PROCEDURE EVE_PRINT_BUFFER ! ! Procedure to print the current buffer. ! local this_position, this_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); this_buffer := current_buffer; eve$search_controls(this_buffer); ! Translate control characters. ! Get the output file from the original buffer and use it to write the ! translated buffer. buffer_name := get_info(this_buffer,"name"); file_name := get_info(this_buffer,"file_name"); if file_name = "" then file_name := read_line (fao("Enter a file name to write buffer !AS or press RETURN to cancel: ", buffer_name)); if file_name = "" then set(informational,on); set(success,on); return; endif; endif; 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,this_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; !**************************************** !+ ! RECCUTPAS.TPU - Eve version of rectangular cut and paste !- ! ! TPU emulation of rectangular CUT/PASTE including following routines: ! EVE_DRAW_BOX ! EVE_RECTANGULAR_REMOVE ! EVE_RECTANGULAR_INSERT_HERE ! EVE_RECTANGULAR_SELECT ! EVEPLUS_PAD_BLANK ! EVE_SET_RECTANGULAR ! EVE_SET_NORECTANGULAR ! EVEPLUS_SET_MODE ! EVEPLUS_BLANK_CHARS ! EVEPLUS_ADVANCE_HORIZONTAL ! ! Rectangular CUT/PASTE provides a way to select a corner of a rectangular ! region on the screen that is to be CUT. This select point is highlighted ! in reverse video. The cursor can then be positioned to the opposite ! corner of the box at which point the CUT can be done to place the rectangular ! region in paste_buffer. PASTE can then be done to overstrike the ! rectangular region in paste_buffer onto the current_buffer using the ! current position as the upper left corner for the pasted region. Note ! that no provision is made if there are TAB chars in the current buffer. ! Also, no provision is made if the cut or paste is done with part of the ! region to be cut or pasted over not being visible on the screen. ! ! These procedures can be run with the current buffer set to overstrike ! or insert mode - CUT/PASTE need to switch to insert mode temporarily ! to get the chars replaced properly, but the previous mode setting for ! the current buffer is restored when either the cut or paste routine completes. ! ! GLOBAL VARIABLES created/used ! eveplus_v_begin_select - position where selected region begins ! eve$x_vt200_keypad ! ! GLOBAL VARIABLES used ! current_buffer ! paste_buffer ! ! This TPU file rebinds the SELECT/REMOVE/INSERT HERE keys to the included ! routines and initializes the eveplus_v_begin_select variable when the ! eve_set_rectangular procedure is executed. The standard Eve key bindings ! are restored when the eve_set_norectangular procedure is executed. ! PROCEDURE EDD_CURRENT_COLUMN ! Procedure to calculate the current column from the current offset, treating ! TAB characters as up to 8 blanks. LOCAL i, line, col; line := current_line; IF INDEX(line,ASCII(9)) = 0 THEN edd_current_column := current_offset; ELSE i := 1; col := 0; LOOP EXITIF i > current_offset; IF SUBSTR(line,i,1) = ASCII(9) THEN col := ((col + 8)/8)*8; ELSE col := col + 1; ENDIF; i := i + 1; ENDLOOP; edd_current_column := col; ENDIF; ENDPROCEDURE; !**************************************** PROCEDURE EDD_REPLACE_TABS_WITH_BLANKS_AND_PAD(TARGET_LENGTH) ! Procedure to replace TAB characters by the appropriate number of ! blanks on the current line, then pad the line out to a given length, if it ! is shorter. The routine assumes overstrike mode is in ! effect. It leave the current position at the beginning of the line. LOCAL i, col, cur_length, new_line, eight_blanks; !+ ! Make sure we're not on the EOB marker. !- IF MARK(NONE) <> END_OF(CURRENT_BUFFER) THEN IF INDEX(CURRENT_LINE, ASCII(9)) <> 0 THEN new_line := ''; eight_blanks := " "; i := 1; col := 0; LOOP EXITIF i > LENGTH(CURRENT_LINE); IF SUBSTR(CURRENT_LINE,i,1) = ASCII(9) THEN col := ((col + 8)/8)*8; new_line := new_line + SUBSTR(eight_blanks,1,col-LENGTH(new_line)); ELSE new_line := new_line + SUBSTR(CURRENT_LINE,i,1); col := col + 1; ENDIF; i := i + 1; ENDLOOP; MOVE_HORIZONTAL(-CURRENT_OFFSET); COPY_TEXT(new_line); ENDIF; ENDIF; MOVE_HORIZONTAL(-CURRENT_OFFSET); !+ ! Now pad out the line if we have to !- IF MARK(NONE) = END_OF(CURRENT_BUFFER) THEN cur_length := 0; ELSE cur_length := LENGTH(CURRENT_LINE); ENDIF; IF cur_length < target_length THEN MOVE_HORIZONTAL(cur_length); COPY_TEXT(eveplus_blank_chars(target_length - cur_length)); ENDIF; MOVE_HORIZONTAL(-CURRENT_OFFSET); ENDPROCEDURE; !**************************************** PROCEDURE EVE_DRAW_BOX LOCAL saved_mode, end_column, start_column, temp, end_select, top_bottom_text; !+ ! Check for no select active !- IF eveplus_v_begin_select = 0 THEN MESSAGE("Select not active"); RETURN; ENDIF; !+ ! Set INSERT mode !- saved_mode := eveplus_set_mode(INSERT); !+ ! Make sure there is a character at the corner of the box opposite ! the begin_select mark. If the end_select mark is before the ! begin_select mark, juggle the markers so that begin_select precedes ! end_select. !- eveplus_pad_blank; IF MARK(NONE) >= eveplus_v_begin_select THEN end_select := MARK(NONE); ELSE end_select := eveplus_v_begin_select; eveplus_v_begin_select := MARK(NONE); POSITION(end_select); ENDIF; !+ ! Figure out what column the box ends in and set END_COLUMN there. ! Then, clear out the video on EVEPLUS_V_BEGIN_SELECT. Figure out ! the start column. !- end_column := edd_current_column; POSITION(eveplus_v_begin_select); eveplus_v_begin_select := MARK(NONE); start_column := edd_current_column; !+ ! We may have the upper right and lower left corners of the box ! selected. If so, START_COLUMN and END_COLUMN need to be reversed. !- IF start_column > end_column THEN temp := end_column; end_column := start_column; start_column := temp; ENDIF; !+ ! We may be building the box on the first line of the buffer. In ! that case, we must put a new top line in the buffer. !- MOVE_HORIZONTAL(-CURRENT_OFFSET); IF MARK(NONE) = BEGINNING_OF(CURRENT_BUFFER) THEN SPLIT_LINE; POSITION(BEGINNING_OF(CURRENT_BUFFER)); COPY_TEXT(eveplus_blank_chars(start_column)); MOVE_VERTICAL(1); MOVE_HORIZONTAL(-CURRENT_OFFSET); ENDIF; !+ ! Move back one line and put in the top line of the box !- top_bottom_text := '+' + eveplus_blank_chars(end_column-start_column+1) + '+'; TRANSLATE(top_bottom_text, "-", " "); SET(OVERSTRIKE, current_buffer); MOVE_VERTICAL(-1); !+ ! Replace all TABs with blanks on this line and pad it, if we need to. !- edd_replace_tabs_with_blanks_and_pad(end_column + 1); IF start_column <> 0 THEN MOVE_HORIZONTAL(start_column - 1); ENDIF; COPY_TEXT(top_bottom_text); MOVE_VERTICAL(1); MOVE_HORIZONTAL(-CURRENT_OFFSET); !+ ! Step through the selected lines, putting vertical bars on either side ! of the selected text. !- LOOP EXITIF MARK(NONE) > end_select; !+ ! Replace all TABs with blanks on this line, if we need to. !- edd_replace_tabs_with_blanks_and_pad(end_column + 1); !+ ! If START_COLUMN is zero, we must insert a vertical bar to do the ! left column, then put the right vertical bar one column farther out ! than normal. !- IF start_column = 0 THEN SET(INSERT, CURRENT_BUFFER); COPY_TEXT("|"); SET(OVERSTRIKE, CURRENT_BUFFER); MOVE_HORIZONTAL(end_column + 1); ELSE MOVE_HORIZONTAL(start_column-1); COPY_TEXT("|"); MOVE_HORIZONTAL(end_column - CURRENT_OFFSET + 1); ENDIF; COPY_TEXT("|"); MOVE_HORIZONTAL(-CURRENT_OFFSET); MOVE_VERTICAL(1); ENDLOOP; !+ ! Now put in the bottom line of the box. !- !+ ! Replace all TABs with blanks on this line, if we need to. !- edd_replace_tabs_with_blanks_and_pad(end_column + 1); IF start_column <> 0 THEN MOVE_HORIZONTAL(start_column - 1); ENDIF; COPY_TEXT(top_bottom_text); !+ ! Position to the beginning of the cut area, reset BEGIN_SELECT, ! restore old insert/overstrike setting !- POSITION(eveplus_v_begin_select); eveplus_v_begin_select := 0; MOVE_HORIZONTAL(-CURRENT_OFFSET); IF start_column = 0 THEN MOVE_HORIZONTAL(1); ELSE MOVE_HORIZONTAL(start_column); ENDIF; SET(saved_mode, CURRENT_BUFFER); ENDPROCEDURE; !**************************************** PROCEDURE EVE_RECTANGULAR_REMOVE LOCAL saved_mode, end_select, end_column, start_column, temp, pad_chars, save_position, blank_chars, cut_text; !+ ! Check for no select active !- IF eveplus_v_begin_select = 0 THEN MESSAGE("Select not active"); RETURN ENDIF; !+ ! Set INSERT mode and erase PASTE_BUFFER !- saved_mode := eveplus_set_mode(INSERT); ERASE(paste_buffer); !+ ! Make sure there is a character at the corner of the box opposite ! the begin_select mark. If the end_select mark is before the ! begin_select mark, juggle the markers so that begin_select precedes ! end_select. !- eveplus_pad_blank; IF MARK(NONE) >= eveplus_v_begin_select THEN end_select := MARK(NONE); ELSE end_select := eveplus_v_begin_select; eveplus_v_begin_select := MARK(NONE); POSITION(end_select); ENDIF; !+ ! Figure out what column the box ends in and set END_COLUMN there. ! Then, clear out the video on EVEPLUS_V_BEGIN_SELECT. Figure out ! the start column. !- end_column := edd_current_column; POSITION(eveplus_v_begin_select); eveplus_v_begin_select := MARK(NONE); start_column := edd_current_column; !+ ! We may have the upper right and lower left corners of the box ! selected. If so, START_COLUMN and END_COLUMN need to be reversed. !- IF start_column > end_column THEN temp := end_column; end_column := start_column; start_column := temp; ENDIF; !+ ! Get a string of the appropriate number of blanks to paste back in !- pad_chars := eveplus_blank_chars(end_column - start_column + 1); !+ ! Step through the selected lines, copying the text to the paste buffer ! and replacing it with blanks as we go. Replace all TABs with blanks ! before we look at it so we get the columns straight. !- MOVE_HORIZONTAL(-current_offset); SET(OVERSTRIKE, current_buffer); LOOP EXITIF MARK(NONE) > end_select; !+ ! Replace all TABs with blanks on this line, if we need to. !- edd_replace_tabs_with_blanks_and_pad(end_column + 1); !+ ! Obtain the text we're cutting !- cut_text := SUBSTR(CURRENT_LINE, start_column + 1, end_column - start_column + 1); !+ ! Replace the text with blanks !- MOVE_HORIZONTAL(start_column); COPY_TEXT(pad_chars); !+ ! Copy the text to the paste buffer !- save_position := MARK(NONE); POSITION(paste_buffer); COPY_TEXT(cut_text); MOVE_HORIZONTAL(1); !+ ! Reposition to the other buffer and move to the next line !- POSITION(save_position); MOVE_HORIZONTAL(-CURRENT_OFFSET); MOVE_VERTICAL(1); ENDLOOP; !+ ! Position to the beginning of the cut area, reset BEGIN_SELECT, ! restore old insert/overstrike setting !- POSITION(eveplus_v_begin_select); eveplus_v_begin_select := 0; MOVE_HORIZONTAL(-CURRENT_OFFSET); MOVE_HORIZONTAL(start_column); SET(saved_mode, CURRENT_BUFFER); ENDPROCEDURE; !**************************************** PROCEDURE EVE_RECTANGULAR_INSERT_HERE !+ ! This procedure pastes the rectangular region in the paste buffer ! using the current position in the current buffer as the upper left corner. !- LOCAL save_position, start_column, paste_line, save_buffer, save_mode; save_buffer := CURRENT_BUFFER; save_position := MARK(NONE); start_column := edd_current_column; save_mode := eveplus_set_mode(OVERSTRIKE); POSITION(BEGINNING_OF(paste_buffer)); IF MARK(NONE) = END_OF(paste_buffer) THEN MESSAGE("Paste buffer is empty"); RETURN; ENDIF; !+ ! Loop through lines in the paste buffer, putting them at the ! appropriate offset in the current buffer. !- LOOP EXITIF MARK(NONE) = END_OF(paste_buffer); !+ ! Get the current line of the paste buffer. !- paste_line := CURRENT_LINE; MOVE_VERTICAL(1); !+ ! Convert tabs to blanks on the line in the current buffer. !- POSITION(save_buffer); edd_replace_tabs_with_blanks_and_pad(start_column+1); !+ ! Position at the correct offset and overwrite the text there. !- MOVE_HORIZONTAL(start_column); COPY_TEXT(paste_line); MOVE_VERTICAL(1); POSITION(paste_buffer); ENDLOOP; !+ ! Position to start of pasted text and restore old mode setting. !- POSITION(save_position); MOVE_HORIZONTAL(-CURRENT_OFFSET); MOVE_HORIZONTAL(start_column); SET(save_mode, CURRENT_BUFFER); ENDPROCEDURE; !**************************************** PROCEDURE EVE_RECTANGULAR_SELECT if eveplus_v_begin_select = 0 then eveplus_pad_blank; eveplus_v_begin_select := mark(REVERSE); message("Selection started. Press Remove when finished."); else eveplus_v_begin_select := 0; message("Selection cancelled"); endif; ENDPROCEDURE; !**************************************** PROCEDURE EVEPLUS_PAD_BLANK !+ ! This procedure drops a space at the current position if the current ! character is null so that any mark will be for an existing character. ! In EDD, we really want a mark in a particular screen column. In TPU, ! an EOL mark would move if the line were extended. Also in EDD, we ! want to highlight the select point so we need a character there. ! The cursor is returned to its original position after the space is ! copied to the current position in the current buffer. !- IF MARK(NONE) = END_OF(CURRENT_BUFFER) THEN copy_text(" "); move_horizontal(-1) ELSE if current_character = "" then copy_text(" "); move_horizontal(-1); endif; ENDIF; ENDPROCEDURE; !**************************************** PROCEDURE EVE_SET_RECTANGULAR eveplus_v_begin_select := 0; if eve$x_vt200_keypad then define_key("eve_rectangular_remove", e3, "edd_remove"); define_key("eve_rectangular_insert_here", e2, "edd_insert_here"); define_key("eve_rectangular_select", e4, "edd_select"); else define_key("eve_rectangular_remove", key_name(ctrl_g_key,shift_key), "edd_remove"); define_key("eve_rectangular_insert_here", key_name(ctrl_i_key,shift_key), "edd_insert_here"); define_key("eve_rectangular_select", ctrl_g_key, "edd_select"); endif; message('Select mode is now rectangular'); ENDPROCEDURE; !**************************************** PROCEDURE EVE_SET_NORECTANGULAR eveplus_v_begin_select := 0; if eve$x_vt200_keypad then define_key("eve_remove", e3, "remove"); define_key("eve_insert_here", e2, "insert_here"); define_key("eve_select", e4, "select"); else define_key("eve_remove", key_name(ctrl_g_key,shift_key), "remove"); define_key("eve_insert_here", key_name(ctrl_i_key,shift_key), "insert_here"); define_key("eve_select", ctrl_g_key, "select"); endif; message('Select mode is now set to normal'); ENDPROCEDURE; !**************************************** PROCEDURE EVEPLUS_SET_MODE(NEW_MODE) !+ ! This procedure returns the current mode for the current buffer ! and sets it to the value in NEW_MODE. !- eveplus_set_mode := get_info(current_buffer,"MODE"); set(new_mode, current_buffer); ENDPROCEDURE; !**************************************** PROCEDURE EVEPLUS_BLANK_CHARS(EVEPLUS_V_BLANK_COUNT) !+ ! This procedure returns a string of eveplus_v_blank_count blank chars. !- local eveplus_v_blank_chars, eveplus_v_oldlen, eveplus_v_blanks_so_far; IF eveplus_v_blank_count = 0 THEN RETURN "" ENDIF; eveplus_v_blank_chars := " "; eveplus_v_blanks_so_far := 1; loop exitif eveplus_v_blanks_so_far >= eveplus_v_blank_count; eveplus_v_oldlen := LENGTH(eveplus_v_blank_chars); eveplus_v_blank_chars := eveplus_v_blank_chars + eveplus_v_blank_chars; eveplus_v_blanks_so_far := eveplus_v_blanks_so_far + eveplus_v_oldlen; endloop; IF eveplus_v_blanks_so_far > eveplus_v_blank_count THEN eveplus_v_blank_chars := SUBSTR(eveplus_v_blank_chars,1,eveplus_v_blank_count); ENDIF; RETURN eveplus_v_blank_chars; ENDPROCEDURE; !**************************************** PROCEDURE EVEPLUS_ADVANCE_HORIZONTAL(EVEPLUS_V_COLUMNS,EVEPLUS_V_BLANK_CHARS) !+ ! This procedure advances current_offset to be eveplus_v_columns from ! current_offset. eveplus_v_blanks_chars must be ! a string of blank chars of at least length eveplus_v_columns. !- local eveplus_v_save_offset, ! current_offset on entry to this procedure eveplus_v_eol_columns; ! Number of columns to [EOL] eveplus_v_save_offset := current_offset; if eveplus_v_columns <= 0 then move_horizontal(eveplus_v_columns); else !+ ! Find out how far to [EOL]. !- eveplus_v_eol_columns := length(current_line)-current_offset; if eveplus_v_eol_columns >= eveplus_v_columns then move_horizontal(eveplus_v_columns); else move_horizontal(eveplus_v_eol_columns); copy_text(substr(eveplus_v_blank_chars,1, eveplus_v_columns-eveplus_v_save_offset)); endif; endif; ENDPROCEDURE; !**************************************** !+ ! RELEASE_BUFFERS.TPU - Routine to release all buffers !- PROCEDURE EVEPLUS_WRITE_FILE(THE_BUFFER, FILE_NAME) ! ! Flush all modified buffers to their associated output files and delete ! the buffers. System buffers, and modified buffers that are either "no_write" ! or have no associated files, are not written out. ! ! ! Buffer Type Action ! ! SYSTEM Ignored (Retained) ! UNMODIFIED Erased and Deleted ! MODIFIED but NO-WRITE Retained ! MODIFIED w/ ASSOCIATED FILE Written out - Erased and Deleted ! MODIFIED w/ NO ASSOCIATED FILE Retained ! on_error return(0); endon_error; write_file (the_buffer, file_name); return(1); ENDPROCEDURE; !**************************************** PROCEDURE EVE_RELEASE_BUFFERS local the_buffer, file_name, i, success_flag, buffer_count; eve_buffer("CHOICES"); ! Make sure we can't eve_one_window; ! delete surrent_buffer i := 1; loop message(""); exitif (i > 18); i := i + 1; endloop; the_buffer := get_info (buffer, "last"); ! Do it in reverse buffer_count := 0; loop if (get_info(the_buffer, "system") = 0) then ! Only nonsystem buffers if (get_info (the_buffer, "modified")) then if (not get_info (the_buffer, "no_write")) then file_name := get_info (the_buffer, "output_file"); if (file_name = 0) then ! Original if no output ! file name file_name := get_info (the_buffer, "file_name"); endif; if (file_name <> "") then ! Modified files with i := index (file_name, ";");! an associated file: if (i <> 0) then ! Strip version number. file_name := substr (file_name, 1, i-1); endif; success_flag := get_info (system, "success"); if (success_flag = 0) then ! Force sucess messages set (success, on); endif; ! Write it out if (eveplus_write_file(the_buffer, file_name)) then erase(the_buffer); delete(the_buffer); ! and get rid of it the_buffer := 0; buffer_count := buffer_count + 1; else ! Stop on errors eve_buffer(get_info(the_buffer, "name")); return; endif; if (success_flag = 0) then ! Restore Success msgs set (success, off); endif; endif; else message(" ** Buffer " + get_info(the_buffer, "name") + " is no-write. **"); endif; else ! Unmodified non-system buffers are just disposed of. message("Buffer " + get_info(the_buffer, "name") + " deleted"); erase(the_buffer); delete(the_buffer); the_buffer := 0; buffer_count := buffer_count + 1; endif; endif; if (the_buffer = 0) then ! If we deleted it, the_buffer := get_info(buffer, "last"); ! restart at the end else the_buffer := get_info(buffer, "previous"); ! Else get the next endif; exitif (the_buffer = 0); ! That's all, folks! endloop; message(fao("Freed !SL buffer!%S", buffer_count)); eve_buffer("MESSAGES"); ! Make sure we're somewhere. ENDPROCEDURE; !**************************************** !+ ! SORT.TPU !-! ! PROCEDURE EVEPLUS_SORT (BNAME,ASTRING) eveplus$$shell_sort(bname); ENDPROCEDURE; !**************************************** PROCEDURE EVE_SORT_BUFFER (BUFFER_TO_SORT) ! ! Sort the named buffer. Prompt for buffer name if not specified ! local v_buf, p_buf, this_buffer; this_buffer := current_buffer; if not eve$prompt_string(buffer_to_sort, v_buf,"Sort buffer: ","Cancelled")then message("Current buffer will be sorted in ascending order"); v_buf := get_info(this_buffer, "name"); endif; p_buf := eveplus_find_buffer (v_buf); if (p_buf <> 0) then eveplus$$shell_sort (p_buf); else message ("Buffer "+v_buf+" not found"); endif; ENDPROCEDURE; !**************************************** PROCEDURE EVEPLUS$$STRING_COMPARE (STRING1, STRING2) ! ! Compare two strings ! ! Returns: ! 1 if string1 > string2 ! 0 if string1 = string2 ! -1 if string1 < string2 ! local v_alpha, v_c1, v_p1, v_c2, v_i, v_p2; v_alpha := " " + !Treat all control chars as spaces??? " " + " !""#$%&'()*+,-./"+ "0123456789:;<=>?" + "@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_" + "`abcdefghijklmnopqrstuvwxyz{|}~"; v_i := 1; loop if (length (string2) < v_i) then if (length (string2) = length (string1)) then return 0; else return 1; endif; endif; if (length (string1) < v_i) then return -1; endif; v_c1 := substr (string1, v_i, 1); change_case (v_c1, upper); v_c2 := substr (string2, v_i, 1); change_case (v_c2, upper); v_p1 := index (v_alpha, v_c1); v_p2 := index (v_alpha, v_c2); if (v_p1 < v_p2) then return -1; endif; if (v_p1 > v_p2) then return 1; endif; v_i := v_i + 1; endloop; return 1; ENDPROCEDURE; !**************************************** PROCEDURE EVEPLUS$$SHELL_SORT (BUFFER_TO_SORT) ! ! This is the shell sort, described in knuth and also ! referred to as the Diminishing Increment Sort. ! local v_pos ,v_iline ,v_jline ,v_i ,v_j ,v_record ; on_error position (v_pos); return; endon_error; v_pos := mark (none); position (buffer_to_sort); eveplus$x_shellstep_0 := 1; eveplus$x_shellstep_1 := 4; eveplus$x_shellstep_2 := 13; eveplus$x_shellstep_3 := 40; eveplus$x_shellstep_4 := 121; eveplus$x_shellstep_5 := 364; eveplus$x_shellstep_6 := 1093; eveplus$x_shellstep_7 := 3280; eveplus$x_shellstep_8 := 9841; eveplus$x_shellstep_9:= 32767; eveplus$x_gshell := 0; eveplus$x_shell_index := 0; ! ! Find the highest step to use ! loop eveplus$x_gshell := 0; exitif (eveplus$x_shell_index >= 6); execute ("if (get_info (current_buffer, 'record_count') <"+ fao ("eveplus$x_shellstep_!UL)",eveplus$x_shell_index+2)+ " then eveplus$x_gshell := 1;endif;"); if eveplus$x_gshell then exitif 1; endif; eveplus$x_shell_index := eveplus$x_shell_index + 1; endloop; v_record := get_info (current_buffer, 'record_count'); ! ! Now we can sort the buffer. Outer loop loops over all the steps, ! decrementing eveplus$x_shell_index. ! loop execute (fao("eveplus$x_gshell := eveplus$x_shellstep_!UL", eveplus$x_shell_index)); v_j := eveplus$x_gshell + 1; !Set up loop for step+1-index loop position (beginning_of (current_buffer)); move_vertical (v_j - 1); !Get j'th line v_jline := current_line; v_i := v_j - eveplus$x_gshell; !i = j - h loop position (beginning_of (current_buffer)); move_vertical (v_i - 1); v_iline := current_line; if (eveplus$$string_compare (v_jline, v_iline) >= 0) then position (beginning_of (current_buffer)); move_vertical (v_i + eveplus$x_gshell - 1); erase_line; split_line; move_vertical (-1); copy_text (v_jline); exitif 1; else position (beginning_of (current_buffer)); move_vertical (v_i + eveplus$x_gshell - 1); erase_line; split_line; move_vertical (-1); copy_text (v_iline); v_i := v_i - eveplus$x_gshell; if (v_i < 1) then position (beginning_of (current_buffer)); move_vertical (v_i + eveplus$x_gshell - 1); erase_line; split_line; move_vertical (-1); copy_text (v_jline); exitif 1; endif; endif; endloop; v_j := v_j + 1; exitif (v_j > v_record); endloop; eveplus$x_shell_index := eveplus$x_shell_index - 1; exitif (eveplus$x_shell_index < 0); endloop; position (v_pos); ENDPROCEDURE; !**************************************** PROCEDURE EVE_ELIMINATE_TABS ! TABS.TPU - Routine to remove tabs assuming SET TABS EVERY 8 local target, n; loop target := search(ascii(9), FORWARD); exitif (target = 0); position(beginning_of(target)); erase_character(1); n := current_offset; n := n - (8 * (n / 8)); eveplus_insert_text(substr(" ", 1, 8 - n)); endloop; ENDPROCEDURE; !**************************************** !+ ! TOGGLE_STATUS_LINE.TPU !- PROCEDURE EVE_STATUS_LINE_OFF ! Eve commands to turn the status line on and off for the current window. ! Having the status line off is particularly useful in making slides ! directly from the terminal. set (status_line, current_window, none, ""); ENDPROCEDURE; !**************************************** PROCEDURE EVE_STATUS_LINE_ON set (status_line, current_window, reverse, " Buffer"); eve$set_status_line (current_window); ENDPROCEDURE; !**************************************** PROCEDURE EVE_TRIM !+ ! TRIM_BUFFER.TPU !- message("Trimmimg buffer..."); eve$trim_buffer( current_buffer ); message("Trimming complete."); ENDPROCEDURE; !**************************************** PROCEDURE EVE_TYPE_ALL(SEARCH_STRING) ! new - 860626 -- RHS ! This procedure will find all occurances of a string in the current buffer ! and displays each record where the string occurs in the message buffer. ! For searching this procedure uses the EVEPlus macro for wildcard searching ! thereby allowing the user a much greater latitude in searching. ! Local search_string, this_string, this_range, temp, found_flag, old_position, the_direction; old_position := mark(none); this_string := search_string; if (current_direction = FORWARD) then the_direction := 'Forward '; else the_direction := 'Reverse '; endif; if search_string = '' then this_string := read_line('TYPE ALL ' + the_direction + 'wild-card search: '); endif; if this_string <> '' then if (build_pattern(this_string, this_string) = 1) then execute( 'eveplus_search_target := ' + this_string +';' ); else eveplus_search_target := this_string; endif; found_flag := 0; loop; this_range := search(eveplus_search_target, current_direction, EXACT); if this_range <> 0 then found_flag := 1; position(this_range); message(current_line); move_vertical(1); move_horizontal(-current_offset); else if found_flag = 1 then message('End of search'); endif; position(old_position); return; endif; endloop; endif ENDPROCEDURE; !**************************************** PROCEDURE EVE_EXCHANGE (CHANGE_PARAMETER_1, CHANGE_PARAMETER_2) ! ! Wildcard search and change procedure. Case-sensitivity of search is ! same as for the wildcard search routine. If case-insensitive, replacements ! are done to match case of current occurrence. Parameter 1 is wildcard ! for searching; parameter 2 is normal (not wildcard). ! ! Parameters: ! ! change_parameter_1 Old string - input ! change_parameter_2 New string - input local target, ! Local copy of change_parameter_1 replacement, ! Local copy of change_parameter_2 this_buffer, ! Current buffer this_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 case-sensitivity 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 asking, ! True unless "all" option has been chosen this_occurrence, ! String of replace_range occurrences; ! Number of replacements made so far this_buffer := current_buffer; this_mode := get_info (current_buffer, eve$kt_mode); set (insert, this_buffer); asking := 1; if not (eve$prompt_string (change_parameter_1, target, "(Wildcard Search) Old string: ", "No string to replace")) then return; endif; replacement := change_parameter_2; if replacement = eve$kt_null then ! empty string is ok here replacement := read_line ("New string: "); endif; lowercase_target := target; if get_info (lowercase_target, eve$kt_type) = string then change_case (lowercase_target, lower); endif; lowercase_replacement := replacement; change_case (lowercase_replacement, lower); if (lowercase_target = target) and (lowercase_replacement = replacement) then how_exact := no_exact; uppercase_target := target; if get_info (uppercase_target, eve$kt_type) = string then change_case (uppercase_target, upper); endif; capital_target := target; if get_info (capital_target, eve$kt_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 := exact; endif; loop replace_range := eve_search (target); exitif replace_range = 0; highlight_range := create_range (beginning_of (replace_range), end_of (replace_range), eve$x_highlighting); position (beginning_of (replace_range)); update (current_window); loop if asking then replace_action := read_line ("Replace? Type yes, no, all, last, or quit: "); change_case (replace_action, lower); else replace_action := "yes"; endif; action_length := length (replace_action); if (replace_action = substr ("yes", 1, action_length)) or (replace_action = substr ("all", 1, action_length)) or (replace_action = substr (eve$kt_last, 1, action_length)) or (action_length = 0) then highlight_range := 0; this_occurrence := erase_character (length (replace_range)); if how_exact = 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 current_direction = reverse then move_horizontal (- length (replacement)); endif; occurrences := occurrences + 1; update (current_window); if (replace_action = substr ("all", 1, action_length)) and (action_length > 0) then asking := 0; message ("Replacing all occurrences..."); set (screen_update, off); endif; exitif 1; else if (replace_action = substr ("no", 1, action_length)) or (replace_action = substr ("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 ("quit", 1, action_length)) or (replace_action = substr (eve$kt_last, 1, action_length))); endloop; set (screen_update, on); message (fao ("Replaced !SL occurrence!%S", occurrences)); set (this_mode, this_buffer); ENDPROCEDURE; !**************************************** PROCEDURE EVE_SEARCH(THE_ARG) ! WILD-CARD SEARCH PROCEDURE !+ ! WILD_SEARCH.TPU - Wild card searching !- local the_direction, the_target, my_key, start_find_key, stop_find_key; my_key := last_key; ! How were we invoked? if (my_key = RET_KEY) then ! Was it SEARCH ? my_key := DO; endif; if (current_direction = FORWARD) then the_direction := 'Forward '; else the_direction := 'Reverse '; endif; start_find_key := eve$lookup_comment (last_key); edit(start_find_key,LOWER); if the_arg <> eve$kt_null then the_target := the_arg; else the_target := read_line(the_direction + 'wild-card search: '); endif; stop_find_key := eve$lookup_comment (last_key); edit(stop_find_key,LOWER); if the_target = eve$kt_null then if (start_find_key = "search") and (stop_find_key = "find") then if eve$x_target = eve$kt_null then message ("No previous target to find"); return (0); else if get_info (eve$x_target, eve$kt_type) = string then message (fao("Finding previous target string: !AS", eveplus_search_target)); else message ("Finding previous target pattern"); endif; endif; else message ("Nothing to find -- search cancelled"); return (0); endif; else if (the_target = '') then if (last_key <> my_key) then return; endif; else if (build_pattern(the_target, the_target) = 1) then execute( 'eveplus_search_target := ' + the_target +';' ); else eveplus_search_target := the_target; endif; endif; endif; return (eve$find(eveplus_search_target, 0)); ENDPROCEDURE; !**************************************** PROCEDURE BUILD_PATTERN( INPUT_STRING, RESULT_STRING ) !+ ! Build a pattern for pattern searching. Pattern characters are: ! ! « - beginning of line ! » - end of line ! % - single-character wildcard ! * - multi-character wildcard, do not cross record boundaries ! # - multi-character wildcard, cross record boundaries ! \ - quote next character ! ^ - next char. is ctrl character ! ! BUILD_PATTERN takes a search string in INPUT_STRING and returns either ! a search string or a pattern string in RESULT_STRING. If RESULT_STRING ! is a search string, BUILD_PATTERN returns 0. If it is a pattern string, ! BUILD_PATTERN returns 1. !- LOCAL s1, s2, i, j, c, quote_next, ctrl_next, match_started, pat; s1 := ''; s2 := ''; i := 1; quote_next := 0; ctrl_next := 0; match_started := 0; pat := ''; !+ ! Process each character in the input string !- LOOP EXITIF i > LENGTH(input_string); c := SUBSTR(input_string, i, 1); !+ ! Do quoting if we're supposed to !- IF quote_next = 1 THEN IF c = "'" THEN s1 := s1 + "''" ELSE s1 := s1 + c ENDIF; s2 := s2 + c; i := i + 1; quote_next := 0 ELSE !+ ! Do CTRL/n quoting if we're supposed to !- IF ctrl_next = 1 THEN CHANGE_CASE(c, UPPER); c := ASCII(INDEX("@ABCDEFGHIJKLMNOPQRSTUVWXYZ[8901", c) - 1); s1 := s1 + c; s2 := s2 + c; i := i + 1; ctrl_next := 0 ELSE !+ ! A normal character or wildcard !- CASE c FROM '' TO 'ÿ' ['\']: !+ ! quote next character !- quote_next := 1; i := i + 1; ['^']: !+ ! CTRL next character !- ctrl_next := 1; i := i + 1; ['«']: !+ ! Begin-of-line !- IF match_started THEN pat := pat + "')"; match_started := 0 ENDIF; IF LENGTH(s1) > 0 THEN pat := pat + "& '" + s1 + "'"; s1 := '' ENDIF; pat := pat + "& LINE_BEGIN"; i := i + 1; ['»']: !+ ! End-of-line !- IF match_started THEN pat := pat + "')"; match_started := 0 ENDIF; IF LENGTH(s1) > 0 THEN pat := pat + "& '" + s1 + "'"; s1 := '' ENDIF; pat := pat + "& LINE_END"; i := i + 1; ['#']: !+ ! General match, crossing record boundaries. ! ! Start by eating all following wildcards. !- IF match_started THEN pat := pat + "')"; match_started := 0 ENDIF; LOOP EXITIF i > LENGTH(input_string); EXITIF INDEX('«»*#%', SUBSTR(input_string, i, 1)) = 0; i := i + 1 ENDLOOP; !+ ! Ignore the wildcard if at end-of-pattern string !- IF i <= LENGTH(input_string) THEN !+ ! Get the stop character (which may be quoted) !- CASE SUBSTR(input_string, i, 1) FROM '' TO 'ÿ' ['\']: IF i = LENGTH(input_string) THEN c := ASCII(0) ELSE c := SUBSTR(input_string, i+1, 1) ENDIF; ['^']: IF i = LENGTH(input_string) THEN c := ASCII(0) ELSE c := SUBSTR(input_string, i+1, 1); CHANGE_CASE(c, UPPER); c := ASCII(INDEX("@ABCDEFGHIJKLMNOPQRSTUVWXYZ[8901", c) - 1) ENDIF; [INRANGE]: c := SUBSTR(input_string, i, 1) ENDCASE; !+ ! Double it if apostrophe !- IF c = "'" THEN c := "''" ENDIF; !+ ! Put it in the pattern !- IF LENGTH(s1) > 0 THEN pat := pat + "& '" + s1 + "'"; s1 := '' ENDIF; pat := pat + "& SCANL('" + c + "')" ENDIF; ['*']: !+ ! General wildcard, not crossing record boundaries ! ! Eat following * and % !- IF match_started THEN pat := pat + "')"; match_started := 0 ENDIF; LOOP EXITIF i > LENGTH(input_string); EXITIF INDEX('*%', SUBSTR(input_string, i, 1)) = 0; i := i + 1 ENDLOOP; !+ ! Use REMAIN if at end of input_string !- IF i > LENGTH(input_string) THEN IF LENGTH(s1) > 0 THEN pat := pat + "& '" + s1 + "'"; s1 := '' ENDIF; pat := pat + "& REMAIN" ELSE !+ ! Ignore * if followed by # !- IF SUBSTR(input_string, i, 1) <> "#" THEN IF LENGTH(s1) > 0 THEN pat := pat + "& '" + s1 + "'"; s1 := '' ENDIF; !+ ! Use REMAIN if « or » follows !- IF (SUBSTR(input_string, i, 1) = "«") OR (SUBSTR(input_string, i, 1) = "»") THEN pat := pat + "& REMAIN" ELSE !+ ! Use the MATCH built-in. We will accumulate ! MATCH characters until another special marker ! is encountered. !- pat := pat + "& MATCH('"; match_started := 1 ENDIF; ENDIF; ENDIF; ['%']: !+ ! Single-character wildcard. ! ! Start by counting consecutive %s !- j := 0; LOOP EXITIF i > LENGTH(input_string); EXITIF SUBSTR(input_string, i, 1) <> "%"; i := i + 1; j := j + 1 ENDLOOP; !+ ! Put it in the pattern !- IF LENGTH(s1) > 0 THEN pat := pat + "& '" + s1 + "'"; s1 := '' ENDIF; pat := pat + "& ARB(" + STR(j) + ")"; ["'"]: !+ ! Apostrophes must be doubled in STR1 !- s1 := s1 + "''"; s2 := s2 + "'"; i := i + 1; [INRANGE]: !+ ! Just an ordinary character !- s1 := s1 + c; s2 := s2 + c; i := i + 1; ENDCASE; ENDIF; ENDIF; ENDLOOP; !+ ! Empty out STR1 !- IF (LENGTH(s1) > 0) AND (LENGTH(pat) > 0) THEN IF match_started THEN pat := pat + s1 + "')"; ELSE pat := pat + "& '" + s1 + "'"; ENDIF; ENDIF; !+ ! Return either a string or a pattern string !- IF LENGTH(pat) > 0 THEN result_string := SUBSTR(pat, 3, LENGTH(pat) - 2); RETURN 1; ELSE result_string := s2; RETURN 0; ENDIF; ENDPROCEDURE; !**************************************** PROCEDURE TPU$LOCAL_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; eve$arg1_print_file := eve$arg1_buffer; eve$arg1_sort_buffer := eve$arg1_buffer; eve$arg1_exchange := eve$arg1_buffer; eve$arg2_exchange := eve$arg1_buffer; eve$arg1_search := eve$arg1_buffer; eve$arg1_type_all := eve$arg1_buffer; eveplus_search_target := ''; ENDPROCEDURE; tpu$local_init; save ("tpu$eveplus:extended_eveplus.tpu$section"); quit;