! EVE$EDIT.TPU 31-DEC-1992 10:14 Page 1 module eve$edit ident "V03-027" ! !************************************************************************* ! * ! © 2002 BY * ! COMPAQ COMPUTER CORPORATION * ! © 2002 BY * ! ELECTRONIC DATA SYSTEMS LIMITED * ! * ! THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED * ! ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE * ! INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER * ! COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY * ! OTHER PERSON. NO TITLE TO OR OWNERSHIP OF THE SOFTWARE IS HEREBY * ! TRANSFERRED. * ! * ! THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE * ! AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY COMPAQ COMPUTER * ! CORPORATION OR EDS. * ! * ! NEITHER COMPAQ NOR EDS ASSUME ANY RESPONSIBILITY FOR THE USE OR * ! RELIABILITY OF THIS SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY * ! COMPAQ. * ! * !************************************************************************* ! !++ ! FACILITY: ! DECTPU - Text Processing Utility ! EVE - Extensible Versatile Editor ! ! ABSTRACT: ! This is the source program for the EVE interface advanced move ! and delete features. This file was obtained from the old ! evesecini.tpu file. ! ! ENVIRONMENT: ! OpenVMS VAX, OpenVMS AXP, RISC/ULTRIX ! !Author: Bill Robinson ! ! CREATION DATE: 10-Oct-1986 ! ! MODIFIED BY: ! !-- ! EVE$EDIT.TPU Page 2 !++ ! Table of Contents ! ! EVE$EDIT.TPU ! 31-DEC-1992 10:14 ! ! Procedure name Page Description ! -------------- ---- ------------ ! ! eve_move_by_page 3 Move to next page break ! eve_erase_character 4 Erase character under cursor ! eve_erase_line 5 Erase from cursor to end of line ! eve_forward 6 Set buffer direction forward ! eve_reverse 6 Set buffer direction reverse ! eve_go_to 7 Go to user-defined mark ! eve_line 8 Go to line number in buffer ! eve_what_line 9 What line am I on? ! eve$what_line 10 WHAT LINE subprocedure ! eve_mark 11 Mark current position ! eve_move_by_word 12 Move to start of next/prev word ! eve_global_replace 13 = Replace All ! eve_replace 14 EVE Replace ! eve$$replace1 15 Replace subprocedure ! eve$$replace_init 16 Replace subprocedure ! eve$$replace_loop 17 Main replace loop ! eve$$replace_search_fail 18 Replace subprocedure ! eve$$replace_action 19 Replace subprocedure ! eve$$replace_no 20 Replace subprocedure ! eve$$replace_clean_up 21 Replace subprocedure ! eve$$replace_error_handler 22 Clean up after error or ^C ! eve_set_cursor_bound 23 Define EVE bound cursor motion ! eve$bound_cursor 23 Set bound cursor motion flag ! eve_set_cursor_free 24 Define EVE free cursor motion ! eve$free_cursor 24 Clear bound cursor motion flag ! eve$at_start_of_word 25 Test for start of word. ! eve$start_of_word 26 Go to start of word and return distance moved ! eve$end_of_word 27 Find distance to end of word & move there ! eve_erase_word 28 Erase next word ! eve$compress_whitespace 29 Remove excess whitespace around char ! eve_erase_previous_word 30 Erase previous word ! eve_erase_start_of_line 31 Erase to start of line ! eve$delete_start_line 32 EDT-like delete to beginning of line ! eve_end_of_line 33 Move to end of the current line ! eve_start_of_line 34 Move to start of line ! eve$append_line 35 Append line ! eve$split_line 36 Hook for user procedures ! eve$to_column 37 Insert spaces to reach a column ! eve$trim_line 38 Trim a line of trailing whitespace ! eve$erase_text 39 Erase text into the restore buffer ! eve_delete 40 Delete character to left of cursor ! eve_change_direction 41 Change direction ! eve_move_by_line 42 Move to start of line ! eve_move_down 43 Move down one row (free and bound cursor) ! eve_move_left 44 Move left one column (free and bound cursor) ! eve_move_right 45 Move right one column (free and bound cursor) ! eve_move_up 46 Move up one row (free and bound cursor) ! eve_next_screen 47 Scroll forward one screen ! eve_previous_screen 47 Scroll backwards one screen ! eve_bottom 48 BOTTOM ! eve_top 48 TOP ! eve$delete_start_word 49 EDT-like delete word (reverse) ! eve$delete_word 50 EDT-like Delete word ! eve$eol_nopad_delete 51 Padless delete from beyond_eol ! eve$set_action_facility 52 Enable a facility's edit handlers ! eve$declare_edit_handler 53 Create a pre/post edit handler ! eve$declare_intention 54 Intend to perform an editing operation ! eve$$detached_cursor_action 55 detached cursor post-action routine ! eve$move_to_visible 56 Move down to next visible line ! eve_box_select 57 Start a box select ! eve$$box_select 58 Box select subprocedure ! eve$$box_selection 59 Returns box selection array of ranges ! eve_box_copy 61 Box copy ! eve_box_cut 62 Box cut command ! eve_box_cut_overstrike 63 Overstrike box cut command ! eve_box_cut_insert 64 Insert box cut command ! eve$$box_cut 65 Box cut subprocedure ! eve_box_paste 66 Box paste command ! eve_box_paste_overstrike 67 Overstrike box paste command ! eve_box_paste_insert 68 Insert box paste command ! eve$$box_paste 69 Box paste subprocedure ! eve$$box_overstrike 70 Box overstrike ! eve$$box_insert 71 Box insert ! eve_set_box_select 72 Set box select mode ! eve_set_box_noselect 72 Disable box select mode ! eve_set_box_pad 73 Set overstrike-pad box select mode ! eve_set_box_nopad 73 Disable overstruck-pad box select mode !-- ! EVE$EDIT.TPU Page 3 procedure eve_move_by_page ! Move to next page break local saved_mark, ! Marker where we started saved_scrolls, ! Boolean set if saved_scroll_xxx valid saved_scroll_top, ! Original value of scroll_top saved_scroll_bottom, ! Original value of scroll_bottom saved_scroll_amount, ! Original value of scroll_amount window_length, ! For finding bottom of scroll region count, ix; on_error [TPU$_CONTROLC]: if saved_scrolls then set (SCROLLING, current_window, eve$x_scrolling, saved_scroll_top, saved_scroll_bottom, saved_scroll_amount); update (current_window); endif; eve$learn_abort; abort; [TPU$_STRNOTFOUND]: if current_window = eve$prompt_window then eve$learn_abort; return (FALSE); endif; if current_direction = FORWARD then position (end_of (current_buffer)); if mark (NONE) <> saved_mark then eve$message (EVE$_NONEXTPAGE); endif; else position (beginning_of (current_buffer)); if mark (NONE) <> saved_mark then eve$message (EVE$_NOPREVPAGE); endif; endif; [OTHERWISE]: if saved_scrolls then set (SCROLLING, current_window, eve$x_scrolling, saved_scroll_top, saved_scroll_bottom, saved_scroll_amount); update (current_window); endif; endon_error; if not eve$declare_intention (eve$k_action_reposition) then return (FALSE); endif; saved_mark := mark (FREE_CURSOR); ! prevent padding position (TEXT); ! snap cursor to prevent padding position (search (PAGE_BREAK, current_direction, EXACT)); ! want error if none if mark (NONE) = saved_mark then if current_direction = FORWARD then move_horizontal (1); else move_horizontal (-1); endif; position (search (PAGE_BREAK, current_direction, EXACT)); endif; if eve$x_repeat_count = 0 then eve$init_repeat; endif; ix := get_info (eve$x_repeat_count, "last"); if ix = tpu$k_unspecified then count := 1; else count := eve$x_repeat_count {ix}; endif; ! Only position the cursor on the last repeat count if count <= 1 then ! save old scrolling region saved_scroll_amount := get_info (current_window, "scroll_amount"); saved_scroll_bottom := get_info (current_window, "scroll_bottom"); saved_scroll_top := get_info (current_window, "scroll_top"); saved_scrolls := TRUE; ! for error handler window_length := get_info (current_window, "visible_bottom") - get_info (current_window, "visible_top"); ! find # of lines from bottom to place cursor window_length := window_length - saved_scroll_top; ! quickly force cursor to top of screen set (SCROLLING, current_window, eve$x_scrolling, saved_scroll_top, window_length, 0); update (current_window); ! be sure to show it ! reset old scrolling region set (SCROLLING, current_window, eve$x_scrolling, saved_scroll_top, saved_scroll_bottom, saved_scroll_amount); endif; return (TRUE); endprocedure; ! eve_move_by_page ! EVE$EDIT.TPU Page 4 procedure eve_erase_character ! Erase character under cursor ! Delete current character local char_range, delete_eol, saved_mark, start_mark; on_error [TPU$_CONTROLC]: eve$$restore_position (saved_mark); ! restore free cursor position eve$learn_abort; abort; [OTHERWISE]: eve$$restore_position (saved_mark); endon_error; if not eve$declare_intention (eve$k_action_erase_character) then return (FALSE); endif; saved_mark := mark (FREE_CURSOR); if not get_info (current_window, "beyond_eob") then if not (get_info (current_window, "before_bol") or get_info (current_window, "middle_of_tab")) then position (TEXT); ! snap to text endif; else position (TEXT); ! snap to text saved_mark := mark (FREE_CURSOR); endif; if mark (NONE) = end_of (current_buffer) then move_vertical (1); ! force error msg and return endif; if current_character = "" then delete_eol := TRUE; else delete_eol := FALSE; endif; char_range := create_range (mark (NONE), mark (NONE), NONE); eve$x_erased_char_forward := FALSE; eve$x_restore_char := eve$erase_text (char_range, eve$x_char_buffer, delete_eol); if (get_info (current_buffer, "mode") = OVERSTRIKE) then if not delete_eol then eve$insert_text (" "); endif; endif; return (TRUE); endprocedure; ! eve_erase_character ! EVE$EDIT.TPU Page 5 procedure eve_erase_line ! Erase from cursor to end of line ! Erase from current position through end of line, including eol character local start_of_range, ! Marker for start of erase range erase_line_range, ! Range to erase saved_mark, start_mark; on_error [TPU$_CONTROLC]: eve$$restore_position (saved_mark); ! restore free cursor position eve$learn_abort; abort; [OTHERWISE]: eve$$restore_position (saved_mark); endon_error; if not eve$declare_intention (eve$k_action_erase_to_right) then return (FALSE); endif; saved_mark := mark (FREE_CURSOR); if not get_info (current_window, "beyond_eob") then if not (get_info (current_window, "before_bol") or get_info (current_window, "middle_of_tab")) then position (TEXT); ! snap to text endif; else position (TEXT); ! snap to text saved_mark := mark (FREE_CURSOR); endif; start_of_range := mark (NONE); position (LINE_END); erase_line_range := create_range (start_of_range, mark (NONE), NONE); eve$x_restore_line := eve$erase_text (erase_line_range, eve$x_line_buffer, TRUE); return (TRUE); endprocedure; ! eve_erase_line ! EVE$EDIT.TPU Page 6 procedure eve_forward ! Set buffer direction forward ! Change direction to forward set (FORWARD, current_buffer); eve$x_old_find_direction := FORWARD; ! change find's saved direction eve$update_status_lines; return (TRUE); endprocedure; ! eve_forward procedure eve_reverse ! Set buffer direction reverse ! Change direction to reverse set (REVERSE, current_buffer); eve$x_old_find_direction := REVERSE; ! change find's saved direction eve$update_status_lines; return (TRUE); endprocedure; ! eve_reverse ! EVE$EDIT.TPU Page 7 procedure eve_go_to ! Go to user-defined mark (go_to_parameter) ! String containing mark name - input ! Go to a mark. If mark is in a different buffer, map that ! buffer to the screen, and if there are two windows, map ! the new buffer to the other window. local a_mark, ! Local copy of mark_parameter, mark_name, ! Local copy of go_to_parameter the_index, ! Index into array of marks the_mark, ! Matching mark the_real_mark, ! Complete name, with prefix, of mark to go to buffer_of_mark, ! Buffer associated with marker saved_window, ! Current buffer saved_mark; ! Mark entry point on_error [TPU$_CONTROLC]: if mark (FREE_CURSOR) <> the_mark then eve$$restore_position (saved_window, saved_mark); endif; eve$learn_abort; abort; [OTHERWISE]: if mark (FREE_CURSOR) <> the_mark then eve$$restore_position (saved_window, saved_mark); endif; endon_error; if not eve$declare_intention (eve$k_action_reposition) then return (FALSE); endif; saved_window := current_window; saved_mark := mark (FREE_CURSOR); if not (eve$prompt_string (go_to_parameter, mark_name, message_text (EVE$_GOTOPROMPT, 1), message_text (EVE$_NOMARK, 0))) then eve$learn_abort; return (FALSE); endif; eve$cleanse_string (mark_name); a_mark := mark_name; edit (a_mark, TRIM, COMPRESS, LOWER); erase (eve$choice_buffer); position (eve$choice_buffer); ! spin thru the mark array the_index := get_info (eve$$x_mark_array, "first"); loop exitif the_index = tpu$k_unspecified; if substr (the_index, 1, length (a_mark)) = a_mark then eve$add_choice (the_index); the_mark := eve$$x_mark_array {the_index}; buffer_of_mark := get_info (the_mark, "buffer"); exitif the_index = a_mark; endif; the_index := get_info (eve$$x_mark_array, "next"); endloop; position (beginning_of (eve$choice_buffer)); the_real_mark := eve$get_choice (a_mark); position (saved_window); if the_real_mark <> "" then ! position to the correct buffer if buffer_of_mark <> current_buffer then if eve$check_bad_window then eve$message (EVE$_CURSINTEXT); eve$learn_abort; return (FALSE); endif; if eve$x_number_of_windows = 2 then if current_window = eve$top_window then position (eve$bottom_window); else position (eve$top_window); endif; endif; if buffer_of_mark <> current_buffer then map (current_window, buffer_of_mark); eve$set_status_line (current_window); endif; endif; eve$position_in_middle (the_mark); eve$message (EVE$_GOINGTO, 0, a_mark); else if get_info (eve$choice_buffer, "record_count") <> 0 then !** How do we replace 'go to' with the synonym for the key that was !** defined to this command? eve$display_choices (message_text (EVE$_AMBMARK, 0, mark_name), "go to ", mark_name); else eve$message (EVE$_MARKNOTSET, 0, mark_name); eve$$restore_position (saved_window, saved_mark); return (FALSE); endif; endif; return (TRUE); endprocedure; ! eve_go_to ! EVE$EDIT.TPU Page 8 procedure eve_line ! Go to line number in buffer (line_parameter, ! Line number to move to - input procedure_parameter) ! Procedure in which to move to line number ! Go to start of a certain line in the current buffer, or optionally to ! the line in a certain procedure local the_line, ! Local copy of line_parameter the_name, ! Local (and normalized) copy of 2nd arg saved_mark, ! Marker for current cursor position saved_window, ! Current window last_line, ! Number of lines in buffer, including eob_text procedure_pattern, ! Pattern that matchs the PROCEDURE and w/s search_pattern, ! Pattern that matches the procedure statement search_range, ! Range returned by search temp_mark, ! Beginning of a possible procedure start_mark, ! Start of the procedure end_mark, ! End of the procedure procedure_range, ! The name part of the procedure statement this_name; ! String version of procedure_range on_error [TPU$_CONTROLC]: eve$$restore_position (saved_window, saved_mark); eve$learn_abort; abort; [TPU$_ENDOFBUF]: [OTHERWISE]: eve$message (EVE$_CANTMOVE, 0, the_line); eve$$restore_position (saved_window, saved_mark); eve$learn_abort; return (FALSE); endon_error; if not eve$declare_intention (eve$k_action_reposition) then return (FALSE); endif; if not (eve$prompt_number (line_parameter, the_line, message_text (EVE$_LINENO, 1), message_text (EVE$_NOLINNO, 0))) then eve$learn_abort; return (FALSE); endif; if the_line <= 0 then eve$message (EVE$_CANTMOVE, 0, the_line); eve$learn_abort; return (FALSE); endif; last_line := get_info (current_buffer, "record_count"); ! do NOT include eob_text if last_line = 0 then eve$message (EVE$_BUFEMPTY); eve$learn_abort; return (FALSE); endif; saved_mark := mark (FREE_CURSOR); saved_window := current_window; position (TEXT); ! snap the cursor the_name := procedure_parameter; edit (the_name, UPPER, TRIM, COMPRESS); if the_name = "" then if the_line > last_line then position (end_of (current_buffer)); eve$message (EVE$_BUFHASONLY, 0, last_line); eve$learn_abort; return (FALSE); else position (the_line); return (TRUE); endif; else eve$message (EVE$_FINDINGPROC, 0, the_name); erase (eve$choice_buffer); procedure_pattern := ANCHOR + "procedure" + span (eve$x_whitespace); search_pattern := LINE_BEGIN + "procedure" + span (eve$x_whitespace) + the_name; position (beginning_of (current_buffer)); loop search_range := search_quietly (search_pattern, FORWARD); exitif search_range = 0; position (beginning_of (search_range)); temp_mark := mark (FREE_CURSOR); ! Get entire name of this procedure position (end_of (search_quietly (procedure_pattern, FORWARD))); move_horizontal (1); procedure_range := search_quietly (eve$pattern_procname, FORWARD); ! Find corresponding endprocedure search_range := search_quietly (eve$pattern_endprocedure, FORWARD); if search_range <> 0 then start_mark := temp_mark; position (end_of (search_range)); move_horizontal (1); end_mark := mark (FREE_CURSOR); this_name := substr (procedure_range, 1, length (procedure_range)); change_case (this_name, UPPER); if this_name = the_name then ! stop on exact match (ignore supersets) erase (eve$choice_buffer); eve$add_choice (this_name); exitif 1; else eve$add_choice (this_name); endif; endif; position (LINE_END); move_horizontal (1); endloop; case get_info (eve$choice_buffer, "record_count") from 0 to 1 [0]: eve$message (EVE$_PROCNOTFOUND, 0, the_name); eve$$restore_position (saved_window, saved_mark); eve$learn_abort; return (FALSE); [1]: position (get_info (start_mark, "record_number") + the_line - 1); if mark (FREE_CURSOR) > end_mark then eve$message (EVE$_LESSLINES, 0, this_name, the_line); position (end_mark); position (LINE_BEGIN); endif; [OUTRANGE]: eve$display_choices (message_text (EVE$_AMBPROC, 0, the_name), !** How do we get the synonym for the key that was defined to this command? "line " + str (the_line) + " ", procedure_parameter); eve$learn_abort; return (FALSE); endcase; endif; eve$position_in_middle (mark (FREE_CURSOR)); return (TRUE); endprocedure; ! eve_line ! EVE$EDIT.TPU Page 9 procedure eve_what_line ! What line am I on? ! Displays a message with the current line number, ! total number of lines in the file, and the percentage. local total_lines, ! total lines in buffer the_line, ! the line we're on status, ! result of eve$what_line call eob_flag, ! true if at eob percent; ! percent of way through buffer on_error [OTHERWISE]: endon_error; status := eve$what_line (total_lines, the_line, percent, eob_flag); ! Display message and return to original position if status then if eob_flag then eve$message (EVE$_WHATEOBLINE, 0, total_lines); else eve$message (EVE$_WHATLINE, 0, the_line, total_lines, percent); endif; endif; return (status); endprocedure; ! eve_what_line ! EVE$EDIT.TPU Page 10 procedure eve$what_line ! WHAT LINE subprocedure (total_lines, ! total lines in buffer, output low_line, ! the line we're on, output percent, ! percent of way through buffer, output eob_flag) ! true if at eob, output local here; on_error [TPU$_CONTROLC]: eve$learn_abort; abort; [OTHERWISE]: endon_error; here := mark (FREE_CURSOR); low_line := get_info (here, "record_number"); total_lines := get_info (current_buffer, "record_count"); if total_lines = 0 then eve$message (EVE$_BUFEMPTY); return (FALSE); endif; if (here = end_of (current_buffer)) or (get_info (here, "beyond_eob")) then eob_flag := TRUE; low_line := total_lines; endif; ! TPU will truncate numbers on division; make it round instead if low_line < 2000000 then percent := (((low_line * 1000) / total_lines) + 5) / 10; else percent := (((low_line) / (total_lines / 1000)) + 5) / 10; endif; return (TRUE); endprocedure; ! eve$what_line ! EVE$EDIT.TPU Page 11 procedure eve_mark ! Mark current position (mark_parameter) ! String to use as a mark name - input ! Set a mark for later use by go to command. local a_mark, ! Local copy of mark_parameter, the_index, ! Index into array of marks mark_name; ! Local copy of mark_parameter, on_error [OTHERWISE]: endon_error; if not (eve$prompt_string (mark_parameter, mark_name, message_text (EVE$_MARKPROMPT, 1), message_text (EVE$_NOTMARKED, 0))) then eve$learn_abort; return (FALSE); endif; eve$cleanse_string (mark_name); a_mark := mark_name; edit (a_mark, TRIM, COMPRESS, LOWER); ! delete existing mark with identical name the_index := get_info (eve$$x_mark_array, "first"); loop exitif the_index = tpu$k_unspecified; if the_index = a_mark then eve$$x_mark_array {the_index} := tpu$k_unspecified; endif; the_index := get_info (eve$$x_mark_array, "next"); endloop; ! now add the marker eve$$x_mark_array {a_mark} := mark (FREE_CURSOR); eve$message (EVE$_MARKEDAS, 0, mark_name); return (TRUE); endprocedure; ! eve_mark ! EVE$EDIT.TPU Page 12 procedure eve_move_by_word ! Move to start of next/prev word ! Move to start of next/previous word, depending on current direction. ! Newlines act like words. local saved_mark; on_error [TPU$_CONTROLC]: eve$$restore_position (saved_mark); ! restore free cursor position eve$learn_abort; abort; [OTHERWISE]: eve$$restore_position (saved_mark); endon_error; if not eve$declare_intention (eve$k_action_short_move) then return (FALSE); endif; saved_mark := mark (FREE_CURSOR); if not get_info (current_window, "bound") then if get_info (current_window, "beyond_eob") then position (TEXT); ! snap to text return (TRUE); else if get_info (current_window, "before_bol") then position (TEXT); ! snap to text at left margin if current_direction = REVERSE then move_horizontal (-1); ! force error if at BOB endif; return (TRUE); else position (TEXT); ! snap to text at EOL or middle of tab endif; endif; endif; if current_direction = REVERSE then if eve$in_prompt then if current_buffer = eve$help_prompt_buffer then ! eve$prompt_buffer should always have dir = FORWARD return (TRUE); endif; position (LINE_BEGIN); endif; if mark (NONE) = beginning_of (current_buffer) then move_vertical (-1); ! force error return endif; if (eve$start_of_word = 0) and (mark (FREE_CURSOR) <> beginning_of (current_buffer)) then move_horizontal (-1); endif; else if mark (NONE) = end_of (current_buffer) then move_vertical (1); ! force error return endif; if (eve$end_of_word = 0) then move_horizontal (1); endif; endif; return (TRUE); endprocedure; ! eve_move_by_word ! EVE$EDIT.TPU Page 13 procedure eve_global_replace ! = Replace All (target_arg, ! Old string - input replacement_arg) ! New string - input local status; on_error [OTHERWISE]: eve$$x_global_replace := FALSE; endon_error; eve$$x_global_replace := TRUE; status := eve_replace (target_arg, replacement_arg); eve$$x_global_replace := FALSE; return (status); endprocedure; ! EVE$EDIT.TPU Page 14 procedure eve_replace ! EVE Replace (target_arg, ! Old string - input replacement_arg) ! New string - input ! Search and replace procedure. Case-sensitivity of search is ! same as for the find command. If case-insensitive, replacements ! are done to match case of current occurrence. ! ! Replace strings in current direction first. When no more are found, ! then temporarily reverse direction, and search from the original ! position (the pivot_point). Two type of actions result: ! ! 1. None found in other direction: return to the location of the ! last one found, and look for any more in the buffer. Exit if ! no more are found. If any are found, ! we start alternately traversing the buffer from beginning to end or ! end to beginning (actually between the first and last found strings ! in the buffer), swapping the pivot_point with each traversal. ! This allows replacing a string with a superset ! of itself (FOO with FOOBAR) multiple times. ! ! 2. One or more are found in other direction: replace in the other ! direction. Then return to pivot point, and look in opposite ! direction. Exit if none found, or continue replacing in one direction ! from the pivot point, and returning to the pivot point to look in the ! opposite direction. ! ! Once the entire buffer has been traversed, then default ! to a NO answer when asking to change direction again. ! ! Syntax: ! REPLACE old_string new_string ! on_error [OTHERWISE]: endon_error; if not eve$test_if_modifiable (current_buffer) then eve$learn_abort; return (FALSE); endif; if not eve$declare_intention (eve$k_action_modify) then return (FALSE); endif; if get_info (eve$$x_replace_array, "type") = ARRAY then delete (eve$$x_replace_array); endif; eve$$x_replace_array := create_array (eve$$k_replace_array_length, eve$$k_state_array_indexes); eve$$x_replace_array {TYPE} := eve$$k_replace_context; eve$$x_replace_array {eve$$k_replace_occurrences} := 0; return (eve$$replace1 (target_arg, replacement_arg)); endprocedure; ! eve_replace ! EVE$EDIT.TPU Page 15 procedure eve$$replace1 ! Replace subprocedure (target_arg, replacement_arg; ignore_null_replacement) ! Boolean = 1 if replacement_arg can be "" local get_replacement, the_widget, temp_array, resource, status; on_error [TPU$_CONTROLC]: eve$message (EVE$_REPLCTRLC, 0, eve$$x_replace_array {eve$$k_replace_occurrences}); eve$$replace_error_handler; eve$learn_abort; abort; [OTHERWISE]: eve$$replace_error_handler; endon_error; eve$$x_replace_array {eve$$k_replace_target} := target_arg; eve$$x_replace_array {eve$$k_replacement} := replacement_arg; ! get the args if (target_arg = "") then if (eve$$x_state_array {eve$$k_command_line_flag} = eve$k_invoked_by_menu) and (eve$$x_state_array {eve$$k_dialog_box}) then %if eve$x_option_decwindows %then if eve$x_decwindows_active then if get_info (eve$x_replace_dialog, "type") <> WIDGET then eve$x_replace_dialog := eve$create_widget ("REPLACE_DIALOG"); endif; status := set (WIDGET, get_info (WIDGET, "widget_id", eve$x_replace_dialog, "REPLACE_DIALOG.REPLACE_OLD_LABEL"), eve$x_resource_array {eve$k_nlabel}, message_text (EVE$_OLDPROMPT)); status := set (WIDGET, get_info (WIDGET, "widget_id", eve$x_replace_dialog, "REPLACE_DIALOG.REPLACE_NEW_LABEL"), eve$x_resource_array {eve$k_nlabel}, message_text (EVE$_NEWPROMPT)); eve$manage_widget (eve$x_replace_dialog); endif; %endif return (eve$k_async_prompting); else if not (eve$prompt_string (target_arg, eve$$x_replace_array {eve$$k_replace_target}, message_text (EVE$_OLDPROMPT, 1), message_text (EVE$_NOREPLSTR, 0))) then eve$learn_abort; return (FALSE); endif; endif; endif; eve$$x_replace_array {eve$$k_replacement} := replacement_arg; if eve$$x_replace_array {eve$$k_replacement} = "" then if ignore_null_replacement <> tpu$k_unspecified then if ignore_null_replacement <> 1 then get_replacement := TRUE; endif; else get_replacement := TRUE; endif; endif; if get_replacement then eve$$x_replace_array {eve$$k_replacement} := replacement_arg; if eve$$x_replace_array {eve$$k_replacement} = "" then eve$$x_replace_array {eve$$k_replacement} := eve$prompt_line (message_text (EVE$_NEWPROMPT, 1), eve$$x_prompt_terminators ); if eve$$x_replace_array {eve$$k_replacement} = 0 then eve$learn_abort; return (FALSE); endif; endif; endif; eve$$replace_init; %if eve$x_option_decwindows %then if eve$x_decwindows_active and (eve$$x_state_array {eve$$k_command_line_flag} = eve$k_invoked_by_menu) then the_widget := get_info (WIDGET, "widget_id", eve$x_replace_dialog, "REPLACE_DIALOG.REPLACE_ALL"); temp_array := create_array; temp_array {eve$x_resource_array {eve$k_nset}} := ""; status := get_info (the_widget, "widget_info", temp_array); if temp_array {eve$x_resource_array {eve$k_nset}} then eve$$x_replace_all := TRUE; ! prevent REPLACE EACH dialog box return (eve$$replace_loop (1, eve$x_all)); ! REPLACE /ALL else return (eve$$replace_loop (1)); endif; endif; %endif if eve$$x_global_replace then eve$$x_replace_all := TRUE; return (eve$$replace_loop (1, eve$x_all)); ! REPLACE ALL command else return (eve$$replace_loop (1)); endif; endprocedure; ! eve$$replace1 ! EVE$EDIT.TPU Page 16 procedure eve$$replace_init ! Replace subprocedure on_error [OTHERWISE]: endon_error; eve$$x_replace_all := FALSE; ! Dialog box ALL button eve$$x_replace_array {eve$$k_replace_saved_mark} := mark (FREE_CURSOR); position (TEXT); ! snap cursor to prevent padding eve$$x_replace_array {eve$$k_replace_this_buffer} := current_buffer; eve$$x_replace_array {eve$$k_replace_asking} := TRUE; eve$$x_replace_array {eve$$k_replace_saved_mode} := get_info ( eve$$x_replace_array { eve$$k_replace_this_buffer }, "mode"); set (INSERT, eve$$x_replace_array {eve$$k_replace_this_buffer}); eve$$x_replace_array {eve$$k_switched_pivot_point} := FALSE; ! here's where we'll look in other_direction eve$$x_replace_array {eve$$k_pivot_point} := mark (FREE_CURSOR); eve$$x_replace_array {eve$$k_replace_saved_direction} := current_direction; if eve$$x_replace_array {eve$$k_replace_saved_direction} = FORWARD then eve$$x_replace_array {eve$$k_other_direction} := REVERSE; else eve$$x_replace_array {eve$$k_other_direction} := FORWARD; endif; ! Set up case of targets eve$$x_replace_array {eve$$k_lowercase_target} := eve$$x_replace_array {eve$$k_replace_target}; if get_info (eve$$x_replace_array {eve$$k_lowercase_target}, "type") = STRING then change_case (eve$$x_replace_array {eve$$k_lowercase_target}, LOWER); endif; eve$$x_replace_array {eve$$k_replace_search_exact} := eve$x_find_exact; if not eve$get_find_case_sensitivity then if (eve$$x_replace_array {eve$$k_lowercase_target} = eve$$x_replace_array {eve$$k_replace_target}) then eve$$x_replace_array {eve$$k_replace_search_exact} := eve$x_find_no_exact ; endif; endif; eve$$x_replace_array {eve$$k_lowercase_replacement} := eve$$x_replace_array {eve$$k_replacement}; change_case (eve$$x_replace_array {eve$$k_lowercase_replacement}, LOWER); if (eve$$x_replace_array {eve$$k_lowercase_target} = eve$$x_replace_array {eve$$k_replace_target}) and (eve$$x_replace_array {eve$$k_lowercase_replacement} = eve$$x_replace_array {eve$$k_replacement}) then eve$$x_replace_array {eve$$k_replace_how_exact} := eve$x_find_no_exact; eve$$x_replace_array {eve$$k_uppercase_target} := eve$$x_replace_array {eve$$k_replace_target}; if get_info (eve$$x_replace_array {eve$$k_uppercase_target}, "type") = STRING then change_case (eve$$x_replace_array {eve$$k_uppercase_target}, UPPER); endif; eve$$x_replace_array {eve$$k_capital_target} := eve$$x_replace_array {eve$$k_replace_target}; if get_info (eve$$x_replace_array {eve$$k_capital_target}, "type") = STRING then eve$capitalize_string (eve$$x_replace_array {eve$$k_capital_target}); endif; eve$$x_replace_array {eve$$k_uppercase_replacement} := eve$$x_replace_array {eve$$k_replacement}; change_case (eve$$x_replace_array {eve$$k_uppercase_replacement}, UPPER); eve$$x_replace_array {eve$$k_capital_replacement} := eve$$x_replace_array {eve$$k_replacement}; eve$capitalize_string (eve$$x_replace_array {eve$$k_capital_replacement}); else eve$$x_replace_array {eve$$k_replace_how_exact} := eve$x_find_exact; endif; ! eve$find searches for eve$x_target eve$x_target := eve$$x_replace_array {eve$$k_replace_target}; eve$$x_replace_array {eve$$k_found_forward} := FALSE; eve$$x_replace_array {eve$$k_found_reverse} := FALSE; eve$$remove_found_range; ! remove range so current position is searched endprocedure; ! eve$$replace_init ! EVE$EDIT.TPU Page 17 procedure eve$$replace_loop ! Main replace loop (find_flag; ! find_flag = 1 if ok to find replace_action) ! replace_action = "yes", "no", "quit", "last", "all" ! Main REPLACE loop local first_pass, status; on_error [TPU$_CONTROLC]: ! let it ripple up to where message is output eve$learn_abort; abort; [OTHERWISE]: eve$$replace_error_handler; endon_error; ! Search for target first_pass := TRUE; loop eve$$x_replace_array {eve$$k_repeat_find_range} := 0; eve$$x_replace_array {eve$$k_erasing_pivot_point} := FALSE; ! use find_flag only in first pass if (find_flag and first_pass) or (not first_pass) then eve$$x_this_direction := current_direction; eve$$x_replace_array {eve$$k_replace_range} := ! find and position to it eve$find_target (eve$$x_replace_array { eve$$k_replace_search_exact }, 1, 1); if eve$$x_replace_array {eve$$k_replace_range} = 0 then status := eve$$replace_search_fail; if status = eve$k_warning then ! no more occurrences eve$$replace_clean_up; return (status); endif; if status = eve$k_async_prompting then ! more occurrences, dialog box prompt return (status); endif; endif; endif; exitif eve$$x_replace_array {eve$$k_replace_range} = 0; if first_pass then ! use optional arg only in first pass status := eve$$replace_action (replace_action); else status := eve$$replace_action; endif; if status = eve$k_async_prompting then return (status); endif; exitif status = FALSE; first_pass := FALSE; endloop; eve$$replace_clean_up; return (TRUE); endprocedure; ! eve$$replace_loop ! EVE$EDIT.TPU Page 18 procedure eve$$replace_search_fail ! Replace subprocedure ! Did not find another occurrence in current direction, look in other direction local find_reply, change_direction_key, the_prompt, status, last_found; on_error [TPU$_CONTROLC]: ! let it ripple up to where message is output eve$learn_abort; abort; [OTHERWISE]: eve$$replace_error_handler; endon_error; if learn_abort ! Don't look in opposite direction if in LEARN SEQUENCE then if not eve$$x_replace_array {eve$$k_replace_asking} then ! reposition if 'all' position (eve$$x_replace_array {eve$$k_replace_saved_mark}); endif; ! always restore original direction and mode set (eve$$x_replace_array {eve$$k_replace_saved_direction}, eve$$x_replace_array {eve$$k_replace_this_buffer}); set (eve$$x_replace_array {eve$$k_replace_saved_mode}, eve$$x_replace_array {eve$$k_replace_this_buffer}); set (SCREEN_UPDATE, ON); eve$message (EVE$_FINDFAIL); eve$message (EVE$_REPLCOUNT, 0, eve$$x_replace_array {eve$$k_replace_occurrences}); eve$message (EVE$_LEARNABORTBIG); return (FALSE); endif; ! remember last found string in case user doesn't want to go to next one eve$$x_replace_array {eve$$k_replace_here} := mark (FREE_CURSOR); ! Search in other direction from pivot point. last_found := mark (FREE_CURSOR); ! (maybe = pivot_point) position (eve$$x_replace_array {eve$$k_pivot_point}); set (eve$$x_replace_array {eve$$k_other_direction}, eve$$x_replace_array {eve$$k_replace_this_buffer}); eve$$x_this_direction := current_direction; eve$$x_replace_array {eve$$k_replace_range} := eve$find_target (eve$$x_replace_array {eve$$k_replace_search_exact}, 1, 0); if (eve$$x_replace_array {eve$$k_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); eve$$x_replace_array {eve$$k_pivot_point} := mark (FREE_CURSOR); eve$$x_replace_array {eve$$k_switched_pivot_point} := TRUE; ! see if ANY other occurrences still exist eve$$x_this_direction := current_direction; eve$$x_replace_array {eve$$k_repeat_find_range} := eve$find_target (eve$$x_replace_array { eve$$k_replace_search_exact }, 1, 0); if (eve$$x_replace_array {eve$$k_repeat_find_range} = 0) then ! no more occurrences return (FALSE); endif; endif; if not eve$$x_replace_array {eve$$k_replace_asking} then ! We're in 'all' loop: during prompts, return to location that's ! showing on screen so the screen doesn't change (eve$prompt_line ! doesn't use read_lines -> must turn on update) eve$$x_replace_array {eve$$k_replace_temp_mark} := mark (FREE_CURSOR); position (eve$$x_replace_array {eve$$k_replace_saved_mark}); set (SCREEN_UPDATE, ON); update (current_window); ! show replacements if on screen endif; if (eve$$x_replace_array {eve$$k_repeat_find_range} <> 0) or ((eve$$x_replace_array {eve$$k_replace_range} <> 0) and eve$$x_replace_array {eve$$k_switched_pivot_point}) or ((eve$$x_replace_array {eve$$k_replace_range} <> 0) and eve$$x_replace_array {eve$$k_found_forward} and eve$$x_replace_array {eve$$k_found_reverse}) then !+ ! Ask if ok to replace again in another pass thru the buffer. !- %if eve$x_option_decwindows %then if eve$x_decwindows_active and (eve$$x_state_array {eve$$k_command_line_flag} = eve$k_invoked_by_menu) then if eve$$x_replace_array {eve$$k_other_direction} = FORWARD then the_prompt := message_text (EVE$_REPLACEFWDAGIN2, 1); else the_prompt := message_text (EVE$_REPLACEREVAGIN2, 1); endif; else %endif if eve$$x_replace_array {eve$$k_other_direction} = FORWARD then the_prompt := message_text (EVE$_REPLACEFWDAGAIN, 1); else the_prompt := message_text (EVE$_REPLACEREVAGAIN, 1); endif; %if eve$x_option_decwindows %then endif; %endif else %if eve$x_option_decwindows %then if eve$x_decwindows_active and (eve$$x_state_array {eve$$k_command_line_flag} = eve$k_invoked_by_menu) then if eve$$x_replace_array {eve$$k_other_direction} = FORWARD then the_prompt := message_text (EVE$_REPLACEFWDAGIN2, 1); else the_prompt := message_text (EVE$_REPLACEREVAGIN2, 1); endif; else %endif if eve$$x_replace_array {eve$$k_other_direction} = FORWARD then the_prompt := message_text (EVE$_REPLACEFWD, 1); else the_prompt := message_text (EVE$_REPLACEREV, 1); endif; %if eve$x_option_decwindows %then endif; %endif endif; if (eve$$x_state_array {eve$$k_command_line_flag} = eve$k_invoked_by_menu) and (eve$$x_state_array {eve$$k_dialog_box}) ! user hasn't disabled dialogs then ! set up for re-entry after dialog box dismissal if (eve$$x_replace_array {eve$$k_replace_range} = 0) and (eve$$x_replace_array {eve$$k_repeat_find_range} <> 0) then eve$$x_replace_array {eve$$k_replace_range} := ! new replace range eve$$x_replace_array { eve$$k_repeat_find_range }; endif; if not eve$$x_replace_array {eve$$k_replace_asking} then ! reposition if 'all' position (eve$$x_replace_array {eve$$k_replace_saved_mark}); else position (eve$$x_replace_array {eve$$k_replace_here}); endif; %if eve$x_option_decwindows %then if eve$x_decwindows_active then if get_info (eve$x_replace_go_each_dialog, "type") <> WIDGET then eve$x_replace_go_each_dialog := eve$create_widget ("REPLACE_GO_EACH_DIALOG"); endif; status := set (WIDGET, get_info (WIDGET, "widget_id", eve$x_replace_go_each_dialog, "REPLACE_GO_EACH_DIALOG.REPLACE_GO_EACH_LABEL"), eve$x_resource_array {eve$k_nlabel}, the_prompt); if get_info (eve$x_replace_each_dialog, "type") = WIDGET then ! don't manage two uncascaded modals at once unmanage_widget (eve$x_replace_each_dialog); endif; eve$manage_widget (eve$x_replace_go_each_dialog, "REPLACE_GO_EACH_DIALOG"); endif; %endif return (eve$k_async_prompting); else find_reply := eve$prompt_line (the_prompt, eve$$x_prompt_terminators); if find_reply = 0 then eve$$replace_error_handler; eve$learn_abort; return (FALSE); endif; endif; if not eve$$x_replace_array {eve$$k_replace_asking} then ! turn screen update off again, then return to last found string & continue set (SCREEN_UPDATE, OFF); position (eve$$x_replace_array {eve$$k_replace_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 (eve$$x_replace_array {eve$$k_repeat_find_range} <> 0) or ((eve$$x_replace_array {eve$$k_replace_range} <> 0) and eve$$x_replace_array {eve$$k_switched_pivot_point}) or ((eve$$x_replace_array {eve$$k_replace_range} <> 0) and eve$$x_replace_array {eve$$k_found_forward} and eve$$x_replace_array {eve$$k_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 return if 'no' !- position (eve$$x_replace_array {eve$$k_replace_here}); if substr (eve$x_no, 1, length (find_reply)) = find_reply then return (FALSE); endif; if (eve$$x_replace_array {eve$$k_replace_range} = 0) and (eve$$x_replace_array {eve$$k_repeat_find_range} <> 0) then eve$$x_replace_array {eve$$k_replace_range} := eve$$x_replace_array {eve$$k_repeat_find_range}; ! new replace range endif; ! go to the find string (these eve$find_targets do not position to it) position (eve$$x_replace_array {eve$$k_replace_range}); ! flip dir for next find if eve$$x_replace_array {eve$$k_other_direction} = FORWARD then eve$$x_replace_array {eve$$k_other_direction} := REVERSE; else eve$$x_replace_array {eve$$k_other_direction} := FORWARD; endif; return (TRUE); endprocedure; ! eve$$replace_search_fail ! EVE$EDIT.TPU Page 19 procedure eve$$replace_action ! Replace subprocedure (; the_action) local action_length, this_occurrence; on_error [TPU$_CONTROLC]: ! let it ripple up to where message is output eve$learn_abort; abort; [OTHERWISE]: eve$$replace_error_handler; endon_error; ! Hilight the occurrence and ask user what to do with it. if current_direction = FORWARD then eve$$x_replace_array {eve$$k_found_forward} := TRUE; else eve$$x_replace_array {eve$$k_found_reverse} := TRUE; endif; if eve$$x_replace_array {eve$$k_replace_asking} then eve$$x_replace_array {eve$$k_highlight_range} := create_range (beginning_of ( eve$$x_replace_array { eve$$k_replace_range }), end_of ( eve$$x_replace_array { eve$$k_replace_range }), eve$x_highlighting ); endif; position (beginning_of (eve$$x_replace_array {eve$$k_replace_range})); if mark (NONE) = eve$$x_replace_array {eve$$k_pivot_point} then eve$$x_replace_array {eve$$k_erasing_pivot_point} := TRUE; endif; if eve$$x_replace_array {eve$$k_replace_asking} then update (current_window); endif; loop if eve$$x_replace_array {eve$$k_replace_asking} and (the_action = tpu$k_unspecified) and (not eve$$x_replace_all) ! Dialog box ALL prevents prompting then if (eve$$x_state_array {eve$$k_command_line_flag} = eve$k_invoked_by_menu) and (eve$$x_state_array {eve$$k_dialog_box}) then %if eve$x_option_decwindows %then if eve$x_decwindows_active then eve$manage_widget (eve$x_replace_each_dialog, "REPLACE_EACH_DIALOG"); endif; %endif return (eve$k_async_prompting); else eve$$x_replace_array {eve$$k_replace_action} := eve$prompt_line (message_text (EVE$_REPLPROMPT, 1), eve$$x_prompt_terminators ); if eve$$x_replace_array {eve$$k_replace_action} = 0 then ! always restore original direction and mode eve$$replace_error_handler; 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 eve$$x_replace_array {eve$$k_replace_action} := eve$x_quit; endif; endif; change_case (eve$$x_replace_array {eve$$k_replace_action}, LOWER); else if eve$$x_replace_all then ! Dialog box ALL replaces all occurrences eve$$x_replace_array {eve$$k_replace_action} := eve$x_all; else if the_action = tpu$k_unspecified then eve$$x_replace_array {eve$$k_replace_action} := eve$x_yes; else eve$$x_replace_array {eve$$k_replace_action} := the_action; endif; endif; endif; action_length := length (eve$$x_replace_array {eve$$k_replace_action}); if (eve$$x_replace_array {eve$$k_replace_action} = substr (eve$x_yes, 1, action_length)) or (eve$$x_replace_array {eve$$k_replace_action} = substr (eve$x_all, 1, action_length)) or (eve$$x_replace_array {eve$$k_replace_action} = substr (eve$x_last, 1, action_length)) or (action_length = 0) then eve$$x_replace_array {eve$$k_highlight_range} := 0; this_occurrence := erase_character (length (eve$$x_replace_array {eve$$k_replace_range})); if eve$$x_replace_array {eve$$k_replace_how_exact} = eve$x_find_exact then copy_text (eve$$x_replace_array {eve$$k_replacement}); else ! Make sure non-alphabetic target is replaced by lowercase if this_occurrence = eve$$x_replace_array {eve$$k_lowercase_target} then copy_text (eve$$x_replace_array {eve$$k_lowercase_replacement}); else if this_occurrence = eve$$x_replace_array {eve$$k_uppercase_target} then copy_text (eve$$x_replace_array {eve$$k_uppercase_replacement}); else if this_occurrence = eve$$x_replace_array {eve$$k_capital_target} then copy_text (eve$$x_replace_array {eve$$k_capital_replacement}); else copy_text (eve$$x_replace_array {eve$$k_lowercase_replacement}); endif; endif; endif; endif; if eve$$x_replace_array {eve$$k_erasing_pivot_point} then ! 'pivot_point' marker text erased, redo the marker eve$$x_replace_array {eve$$k_replace_temp_mark} := mark (FREE_CURSOR); move_horizontal (-length ( eve$$x_replace_array {eve$$k_replacement})); eve$$x_replace_array {eve$$k_pivot_point} := mark (FREE_CURSOR); position (eve$$x_replace_array {eve$$k_replace_temp_mark}); endif; if current_direction = REVERSE then move_horizontal (-length ( eve$$x_replace_array {eve$$k_replacement})); endif; eve$$x_replace_array {eve$$k_replace_occurrences} := eve$$x_replace_array { eve$$k_replace_occurrences } + 1; if eve$$x_replace_array {eve$$k_replace_asking} then update (current_window); if (eve$$x_replace_array {eve$$k_replace_action} = substr (eve$x_all, 1, action_length)) and (action_length > 0) then eve$$x_replace_array {eve$$k_replace_asking} := FALSE; eve$message (EVE$_REPLALL, 0, eve$$x_replace_array {eve$$k_replace_target}); eve$$x_replace_array {eve$$k_replace_saved_mark} := mark (FREE_CURSOR );! return here when done set (SCREEN_UPDATE, OFF); endif; endif; exitif; else if (eve$$x_replace_array {eve$$k_replace_action} = substr (eve$x_no, 1, action_length)) or (eve$$x_replace_array {eve$$k_replace_action} = substr (eve$x_quit, 1, action_length)) then eve$$replace_no; exitif; endif; endif; endloop; if (action_length > 0) and ((eve$$x_replace_array {eve$$k_replace_action} = substr (eve$x_quit, 1, action_length)) or (eve$$x_replace_array {eve$$k_replace_action} = substr (eve$x_last, 1, action_length))) then return (FALSE); else return (TRUE); endif; endprocedure; ! eve$$replace_action ! EVE$EDIT.TPU Page 20 procedure eve$$replace_no ! Replace subprocedure on_error [TPU$_CONTROLC]: ! let it ripple up to where message is output eve$learn_abort; abort; [OTHERWISE]: eve$$replace_error_handler; endon_error; eve$$x_replace_array {eve$$k_highlight_range} := 0; if current_direction = FORWARD then position (end_of (eve$$x_replace_array {eve$$k_replace_range})); move_horizontal (1); endif; update (current_window); endprocedure; ! eve$$replace_no ! EVE$EDIT.TPU Page 21 procedure eve$$replace_clean_up ! Replace subprocedure on_error [TPU$_CONTROLC]: ! let it ripple up to where message is output eve$learn_abort; abort; [OTHERWISE]: eve$$replace_error_handler; endon_error; if not eve$$x_replace_array {eve$$k_replace_asking} then ! go to last saved_mark only if 'all' position (eve$$x_replace_array {eve$$k_replace_saved_mark}); endif; ! always restore original direction and mode set (eve$$x_replace_array {eve$$k_replace_saved_direction}, eve$$x_replace_array {eve$$k_replace_this_buffer}); set (eve$$x_replace_array {eve$$k_replace_saved_mode}, eve$$x_replace_array {eve$$k_replace_this_buffer}); set (SCREEN_UPDATE, ON); eve$message (EVE$_REPLCOUNT, 0, eve$$x_replace_array {eve$$k_replace_occurrences}); %if eve$x_option_decwindows %then if (eve$$x_state_array {eve$$k_command_line_flag} = eve$k_invoked_by_menu) and (eve$$x_state_array {eve$$k_dialog_box}) then if eve$x_decwindows_active then if get_info (eve$x_replace_each_dialog, "type") = WIDGET then unmanage_widget (eve$x_replace_each_dialog); endif; endif; endif; %endif endprocedure; ! eve$$replace_clean_up ! EVE$EDIT.TPU Page 22 procedure eve$$replace_error_handler ! Clean up after error or ^C on_error [OTHERWISE]: endon_error; eve$$x_replace_array {eve$$k_highlight_range} := 0; if not eve$$x_replace_array {eve$$k_replace_asking} then ! reposition if 'all' position (eve$$x_replace_array {eve$$k_replace_saved_mark}); endif; set (eve$$x_replace_array {eve$$k_replace_saved_direction}, current_buffer); set (eve$$x_replace_array {eve$$k_replace_saved_mode}, current_buffer); set (SCREEN_UPDATE, ON); %if eve$x_option_decwindows %then if (eve$$x_state_array {eve$$k_command_line_flag} = eve$k_invoked_by_menu) and (eve$$x_state_array {eve$$k_dialog_box}) then if eve$x_decwindows_active then if get_info (eve$x_replace_each_dialog, "type") = WIDGET then unmanage_widget (eve$x_replace_each_dialog); endif; endif; endif; %endif endprocedure; ! eve$$replace_error_handler ! EVE$EDIT.TPU Page 23 procedure eve_set_cursor_bound ! Define EVE bound cursor motion ! Procedure to set EDT style bound cursor motion. eve$message (EVE$_CURSORBOUND); eve$bound_cursor; position (TEXT); ! snap to text return (TRUE); endprocedure; ! eve_set_cursor_bound procedure eve$bound_cursor ! Set bound cursor motion flag eve$x_bound_cursor := TRUE; eve$define_attr ("eve_set_cursor_free", "eve_set_cursor_bound;", message_text (EVE$_CURSORBOUND)); endprocedure; ! eve$bound_cursor ! EVE$EDIT.TPU Page 24 procedure eve_set_cursor_free ! Define EVE free cursor motion ! Procedure to restore EVE's free cursor motion. eve$message (EVE$_CURSORFREE); eve$free_cursor; return (TRUE); endprocedure ! eve_set_cursor_free procedure eve$free_cursor ! Clear bound cursor motion flag eve$x_bound_cursor := FALSE; eve$define_attr ("eve_set_cursor_free", "eve_set_cursor_free;", message_text (EVE$_CURSORFREE)); endprocedure; ! eve$free_cursor ! EVE$EDIT.TPU Page 25 procedure eve$at_start_of_word ! Test for start of word. ! Tests for start of word. Returns true or false. ! We are on the start of a word if on a word separator, or on a non-separator ! just after a separator. on_error [OTHERWISE]: endon_error; position (TEXT); ! snap cursor to text if current_offset = 0 then return (1); endif; eve$at_start_of_word := 0; if index (eve$$x_word_separators, current_character) = 0 then move_horizontal (-1); if index (eve$$x_word_separators, current_character) <> 0 then eve$at_start_of_word := 1; endif; move_horizontal (1); else if index (eve$x_whitespace, current_character) = 0 then ! We are on a "real" separator, allow Erase Word to erase it. return (1); endif; endif; endprocedure; ! eve$at_start_of_word ! EVE$EDIT.TPU Page 26 procedure eve$start_of_word ! Go to start of word and return distance moved ! Go to the beginning of a word. Return amount moved, or 0 if at ! start of line. local temp_length, ! Distance moved temp, temp_char; ! Character to check on_error [OTHERWISE]: endon_error; position (TEXT); ! snap cursor to text if current_offset = 0 then return (0); endif; move_horizontal (-1); ! Skip current character ! Count any spaces temp_length := current_offset + 1; position (search_quietly (notany (eve$x_whitespace) | LINE_BEGIN, REVERSE, EXACT)); temp_length := temp_length - current_offset; ! If we are on a word separator count that one character. ! Otherwise scan to the next word separator. if (index (eve$$x_word_separators, current_character) = 0) then temp := current_offset; position (search_quietly (any (eve$$x_word_separators) | LINE_BEGIN, REVERSE, EXACT)); if index (eve$$x_word_separators, current_character) <> 0 then move_horizontal (1); endif; temp_length := temp_length + (temp - current_offset); endif; return (temp_length); endprocedure; ! eve$start_of_word ! EVE$EDIT.TPU Page 27 procedure eve$end_of_word ! Find distance to end of word & move there local saved_mark, ! Current location temp_length, ! Distance moved temp_range; ! Range from current position to end of word on_error [TPU$_CONTROLC]: eve$$restore_position (saved_mark); ! restore free cursor position eve$learn_abort; abort; [TPU$_NOEOBSTR]: eve$$restore_position (saved_mark); return (FALSE); [OTHERWISE]: eve$$restore_position (saved_mark); endon_error; position (TEXT); ! snap cursor to text if current_character = "" then return (0); endif; temp_range := search_quietly (eve$pattern_end_of_word, FORWARD); temp_length := length (temp_range); move_horizontal (temp_length); return (temp_length); endprocedure; ! eve$end_of_word ! EVE$EDIT.TPU Page 28 procedure eve_erase_word ! Erase next word local this_buffer, ! Current buffer temp_string, ! String used to check for start of line start_white, ! Marker for start of leading whitespace end_white, ! Marker for end of leading whitespace start_erase_word, ! Marker for beginning of this word end_erase_word, ! Marker for beginning of next word erase_word_range; ! Range for this word on_error [OTHERWISE]: endon_error; if eve$in_prompting_window then return (eve_erase_previous_word); ! failure does learn_abort endif; if not eve$declare_intention (eve$k_action_erase_to_right) then return (FALSE); endif; this_buffer := current_buffer; if mark (NONE) = end_of (this_buffer) ! pad if cursor is free then eve$learn_abort; return (FALSE); endif; ! If on whitespace between words, mark start of that whitespace so it can ! be removed, and move to end of the whitespace. Do not call ! eve$compress_whitespace. if index (eve$x_whitespace, current_character) <> 0 then position (search_quietly (notany (eve$x_whitespace) | LINE_BEGIN, REVERSE, EXACT)); if index (eve$x_whitespace, current_character) = 0 then move_horizontal (2); ! leave first whitespace if not at start of line endif; if index (eve$x_whitespace, current_character) <> 0 then start_white := mark (NONE); position (end_of (search (eve$pattern_whitespace, FORWARD))); end_white := mark (NONE); move_horizontal (1); endif; endif; ! Check for end of line if current_character = "" then if current_offset = 0 then ! Grab a separator so we can force the later test. temp_string := substr (eve$$x_word_separators, 1, 1); else move_horizontal (-1); temp_string := current_character; move_horizontal (1); endif; move_horizontal (1); ! Erase the text now so EOB is appended if last line is all whitespace eve$x_erased_word_forward := 0; if start_white = 0 then eve$x_restore_word := eve$erase_text (0, eve$x_word_buffer, TRUE); else ! erase whitespace at end of line eve$x_restore_word := eve$erase_text (create_range (start_white, end_white, NONE), eve$x_word_buffer, TRUE); endif; if not eve$append_line then move_horizontal (-1); eve$learn_abort; return (FALSE); endif; if mark (NONE) <> end_of (this_buffer) then if index (eve$$x_word_separators, temp_string) = 0 then if eve$insert_text (" ") = 0 then eve$learn_abort; return (FALSE); endif; endif; endif; else if not eve$at_start_of_word then eve$start_of_word; endif; start_erase_word := mark (NONE); eve$end_of_word; move_horizontal (-1); end_erase_word := mark (NONE); if start_white = 0 then erase_word_range := create_range (start_erase_word, end_erase_word, NONE); else erase_word_range := create_range (start_white, end_erase_word, NONE); endif; position (start_erase_word); eve$x_erased_word_forward := 0; eve$x_restore_word := eve$erase_text (erase_word_range, eve$x_word_buffer, FALSE); if mark (NONE) <> beginning_of (current_buffer) then if current_character = "" then move_horizontal (-1); if current_character = " " then erase_character (1); cursor_horizontal (1); else move_horizontal (1); endif; endif; endif; endif; return (TRUE); endprocedure; ! eve_erase_word ! EVE$EDIT.TPU Page 29 procedure eve$compress_whitespace ! Remove excess whitespace around char ! Delete all whitespace surrounding the current character, except for ! the first whitespace character to left (delete that too if at start of line). ! Position cursor at beginning of next word. No-op if current character ! is not whitespace. Trim spaces if at end of line. on_error [OTHERWISE]: endon_error if current_character = "" then eve$trim_line; return; endif; if index (eve$x_whitespace, current_character) = 0 then return; endif; position (search_quietly (notany (eve$x_whitespace) | LINE_BEGIN, REVERSE, EXACT)); if index (eve$x_whitespace, current_character) = 0 then move_horizontal (2); ! leave first whitespace if not at start of line endif; if index (eve$x_whitespace, current_character) <> 0 then erase (search (eve$pattern_whitespace, FORWARD)); endif; endprocedure; ! eve$compress_whitespace ! EVE$EDIT.TPU Page 30 procedure eve_erase_previous_word ! Erase previous word ! Erase a word. If at start of word (or preceding character is blank), ! erase preceding word; else erase current word. local this_buffer, ! Current buffer temp_string, ! String used to check for start of line start_erase_word, ! Marker for beginning of previous word end_erase_word, ! Marker for end of previous word erase_word_range; ! Range for previous word on_error [OTHERWISE]: endon_error; if not eve$declare_intention (eve$k_action_erase_to_left) then return (FALSE); endif; this_buffer := current_buffer; if current_offset = 0 then if mark (NONE) <> beginning_of (this_buffer) then if eve$append_line = 0 then eve$learn_abort; return (FALSE); else if current_offset = 0 then temp_string := ascii (10); else move_horizontal (-1); temp_string := current_character; move_horizontal (1); endif; if index (eve$$x_word_separators, temp_string) = 0 then if eve$insert_text (" ") = 0 then eve$learn_abort; return (FALSE); endif; endif; eve$x_erased_word_forward := 0; eve$x_restore_word := eve$erase_text (0, eve$x_word_buffer, TRUE); return (TRUE); endif; else eve$learn_abort; return (FALSE); endif; endif; eve$start_of_word; start_erase_word := mark (NONE); eve$end_of_word; move_horizontal (-1); ! don't want first character of next word end_erase_word := mark (NONE); erase_word_range := create_range (start_erase_word, end_erase_word, NONE); position (start_erase_word); eve$x_erased_word_forward := 0; eve$x_restore_word := eve$erase_text (erase_word_range, eve$x_word_buffer, FALSE); ! If space before eol, remove the space; then, if not beyond the ! screen edge then free cursor back to eol (so FILL won't add a 2nd space) if current_character = "" then ! Don't remove trailing space in command buffer if (not eve$in_prompt) and (current_window <> eve$command_window) then if mark (NONE) <> beginning_of (current_buffer) then move_horizontal (-1); if current_character = " " then erase_character (1); if (get_info (mark (FREE_CURSOR), "offset_column") + get_info (current_window, "shift_amount")) <= (get_info (current_window, "width")) then cursor_horizontal (1); endif; else move_horizontal (1); endif; endif; endif; endif; return (TRUE); endprocedure; ! eve_erase_previous_word ! EVE$EDIT.TPU Page 31 procedure eve_erase_start_of_line ! Erase to start of line ! Erase from current cursor position to start of line. ! For CTRL/U compatibility. local erase_length, ! How much of current line to erase end_of_range, ! Marker for end of range erase_line_range; ! Range to be erased on_error [OTHERWISE]: endon_error; if not eve$declare_intention (eve$k_action_erase_to_bol) then return (FALSE); endif; if mark (NONE) = end_of (current_buffer) then eve$learn_abort; return (FALSE); endif; erase_length := current_offset; if erase_length <= 0 then eve$learn_abort; return (FALSE); endif; move_horizontal (-1); end_of_range := mark (NONE); move_horizontal (1 - erase_length); erase_line_range := create_range (mark (NONE), end_of_range, NONE); eve$x_erased_line_forward := 0; eve$x_restore_line := eve$erase_text (erase_line_range, eve$x_line_buffer, FALSE); return (TRUE); endprocedure; ! eve_erase_start_of_line ! EVE$EDIT.TPU Page 32 procedure eve$delete_start_line ! EDT-like delete to beginning of line !+ ! EDT -- Delete to the beginning of the line !- local end_mark, line_range, delete_eol; on_error [OTHERWISE]: endon_error; if not eve$declare_intention (eve$k_action_erase_to_left) then return (FALSE); endif; if mark (NONE) = beginning_of (current_buffer) then move_vertical (-1); ! on_error will output message and return 0 endif; move_horizontal (-1); end_mark := mark (NONE); move_horizontal (1); delete_eol := (current_offset = 0); if delete_eol then if get_info (current_buffer, "record_count") <> 0 then move_vertical (-1); endif; endif; position (LINE_BEGIN); line_range := create_range (mark (NONE), end_mark, NONE); eve$x_erased_line_forward := FALSE; eve$x_restore_line := eve$erase_text (line_range, eve$x_line_buffer, delete_eol); return (1); endprocedure; ! eve$delete_start_line ! EVE$EDIT.TPU Page 33 procedure eve_end_of_line ! Move to end of the current line ! Go to the end of the current line. ! Display a message if already at the end of this line, but not if beyond_eol. local cursor_is_free; on_error [OTHERWISE]: endon_error; if not eve$declare_intention (eve$k_action_down_right) then return (FALSE); endif; cursor_is_free := not (get_info (current_buffer, "bound")); position (TEXT); ! snap cursor to text if mark (NONE) = end_of (current_buffer) then if not cursor_is_free then eve$message (EVE$_ATEOL); ! no learn_abort here endif; else if current_character = "" then if not cursor_is_free then eve$message (EVE$_ATEOL); ! no learn_abort here endif; else position (LINE_END); endif; endif; return (TRUE); endprocedure; ! eve_end_of_line ! EVE$EDIT.TPU Page 34 procedure eve_start_of_line ! Move to start of line ! Go to the start of the current line. ! Display a message if already at the start of this line. local cursor_is_free; on_error [OTHERWISE]: endon_error; if not eve$declare_intention (eve$k_action_up_left) then return (FALSE); endif; cursor_is_free := not (get_info (current_buffer, "bound")); position (TEXT); ! snap cursor to text if cursor_is_free then position (LINE_BEGIN); else if current_offset = 0 then eve$message (EVE$_ATSOL); ! no learn abort here else position (LINE_BEGIN); endif; endif; return (TRUE); endprocedure; ! eve_start_of_line ! EVE$EDIT.TPU Page 35 procedure eve$append_line ! Append line ! Append line, deleting whitespace in left margin local this_position, ! Marker for current cursor position all_spaces; ! True if all spaces in the line on_error [OTHERWISE]: endon_error; this_position := mark (NONE); if (current_offset > 0) or (this_position = beginning_of (current_buffer)) then return (FALSE); endif; if this_position = end_of (current_buffer) then move_horizontal (-1); if (current_offset = 0) then move_horizontal (1); append_line; endif; return (TRUE); endif; all_spaces := (current_character <> ""); position (search_quietly (notany (eve$x_whitespace) | LINE_END, FORWARD, EXACT)); if current_character <> "" then ! not at eol, must be non-whitespace all_spaces := 0; position (LINE_BEGIN); endif; if all_spaces then erase_line; move_horizontal (-1); else append_line; return (TRUE); endif; return (TRUE); endprocedure; ! eve$append_line ! EVE$EDIT.TPU Page 36 procedure eve$split_line ! Hook for user procedures ! Provides a hook for user-written procedures such as auto-indent. on_error [OTHERWISE]: endon_error; split_line; endprocedure; ! eve$split_line ! EVE$EDIT.TPU Page 37 procedure eve$to_column ! Insert spaces to reach a column (which_column) ! If current offset greater than column, do nothing. ! ! Parameters: ! which_column Column to go to - input local this_buffer, ! Current buffer saved_mode, ! Keyword for current mode distance; ! Number of spaces needed on_error [TPU$_CONTROLC]: if saved_mode = OVERSTRIKE then set (saved_mode, this_buffer); endif; eve$learn_abort; abort; [OTHERWISE]: if saved_mode = OVERSTRIKE then set (saved_mode, this_buffer); endif; endon_error; this_buffer := current_buffer; saved_mode := get_info (this_buffer, "mode"); set (INSERT, this_buffer); loop distance := which_column - get_info (this_buffer, "offset_column"); exitif distance <= 0; if distance > length (eve$kt_spaces) then copy_text (eve$kt_spaces); else copy_text (substr (eve$kt_spaces, 1, distance)); endif; endloop; set (saved_mode, this_buffer); endprocedure; ! eve$to_column ! EVE$EDIT.TPU Page 38 procedure eve$trim_line ! Trim a line of trailing whitespace ! Trim this line of extra spaces at end local eol_position, ! end of current line minimum_offset, ! minimum allowed offset spaces_to_trim; ! number of spaces on_error [TPU$_STRNOTFOUND]: return (FALSE); [OTHERWISE]: endon_error; if current_window = eve$command_window then minimum_offset := eve$x_command_prompt_length; endif; eol_position := search (LINE_END, FORWARD, EXACT); position (eol_position); spaces_to_trim := current_offset; position (search_quietly (notany (eve$x_whitespace) | LINE_BEGIN, REVERSE, EXACT)); if current_offset < minimum_offset then ! went too far, - 1 adjusts so count erases space at minimum_offset move_horizontal (minimum_offset - current_offset - 1); endif; spaces_to_trim := spaces_to_trim - current_offset - 1; position (eol_position); erase_character (-spaces_to_trim); return (TRUE); endprocedure; ! eve$trim_line ! EVE$EDIT.TPU Page 39 procedure eve$erase_text ! Erase text into the restore buffer (the_range, the_buffer, include_line_break) ! Procedure to erase text (a range) from the current buffer, move it ! to the restore buffer, and copy it into the entity specific buffer. ! ! Parameters: ! the_range Range to be deleted ! the_buffer Buffer to copy it into as well as RESTORE ! include_line_break Boolean indicating whether the line break ! is to be included in the erased text. ! Implicit Inputs: ! eve$$x_prompt_range if current_buffer = eve$command_buffer ! eve$$x_the_prompt_range if current_buffer = eve$prompt_buffer ! eve$x_help_prompt_range if current_buffer = eve$help_prompt_buffer ! Side Effect: ! The last position in eve$restore_buffer must be at the end of ! eve$x_restore_range. Likewise, the last position in the_buffer ! must be at the end of the range returned as the value of this procedure. ! Returned result: ! a range containing the contents of the specified buffer ! false if an error occurs local saved_window, saved_mark, new_range, start_is_within, end_is_within, prompt_range, test_range, dispatch; on_error [TPU$_CONTROLC]: eve$$restore_position (saved_window, saved_mark); eve$learn_abort; abort; [OTHERWISE]: if (error = TPU$_MOVETOCOPY) or ! these are user errors (error = TPU$_MOVETOCOPYTEXT) ! (the message is output) then if (not include_line_break) and (mark (NONE) <> beginning_of (current_buffer)) then move_horizontal (-1); endif; eve$x_restore_range := create_range ( beginning_of (eve$restore_buffer), mark (NONE), NONE); eve$$restore_position (saved_window, saved_mark); return; ! Insure correct value is returned by assignment into endif; ! eve$erase_text below. eve$$restore_position (saved_window, saved_mark); endon_error; saved_window := current_window; saved_mark := mark (FREE_CURSOR); if the_buffer = eve$x_char_buffer then if get_info (eve$x_char_buffer, "type") <> BUFFER then if eve$x_buf_str_restore_char = tpu$k_unspecified then eve$x_buf_str_restore_char := "$RESTORE$CHAR$"; endif; eve$x_char_buffer := eve$init_buffer (eve$x_buf_str_restore_char, ""); endif; endif; if the_buffer = eve$x_word_buffer then if get_info (eve$x_word_buffer, "type") <> BUFFER then if eve$x_buf_str_restore_word = tpu$k_unspecified then eve$x_buf_str_restore_word := "$RESTORE$WORD$"; endif; eve$x_word_buffer := eve$init_buffer (eve$x_buf_str_restore_word, ""); endif; endif; if the_buffer = eve$x_line_buffer then if get_info (eve$x_line_buffer, "type") <> BUFFER then if eve$x_buf_str_restore_line = tpu$k_unspecified then eve$x_buf_str_restore_line := "$RESTORE$LINE$"; endif; eve$x_line_buffer := eve$init_buffer (eve$x_buf_str_restore_line, ""); endif; endif; if the_buffer = eve$x_sentence_buffer then if get_info (eve$x_sentence_buffer, "type") <> BUFFER then if eve$x_buf_str_restore_sent = tpu$k_unspecified then eve$x_buf_str_restore_sent := "$RESTORE$SENT$"; endif; eve$x_sentence_buffer := eve$init_buffer (eve$x_buf_str_restore_sent, ""); endif; endif; ! Prevent modifying the prompt in command/prompt/help_prompt buffers if eve$in_prompting_window then if (current_buffer = eve$command_buffer) then if (current_offset = eve$x_command_prompt_length) and (length (current_line) = eve$x_command_prompt_length) then dispatch := 1; ! prevent the erase else if get_info (the_range, "type") = RANGE then prompt_range := eve$$x_prompt_range; test_range := TRUE; endif; endif; else if (current_buffer = eve$prompt_buffer) or (current_buffer = eve$help_prompt_buffer) then if (current_offset = eve$x_prompt_length) and (length (current_line) = eve$x_prompt_length) then dispatch := 1; else if (current_buffer = eve$prompt_buffer) then prompt_range := eve$$x_the_prompt_range; else prompt_range := eve$x_help_prompt_range; endif; test_range := TRUE; endif; endif; endif; endif; if test_range then if get_info (beginning_of (the_range), "within_range", prompt_range) then start_is_within := TRUE; endif; if get_info (end_of (the_range), "within_range", prompt_range) then end_is_within := TRUE; endif; if (start_is_within and end_is_within) then dispatch := 1; ! prevent erase else if start_is_within and (not end_is_within) then ! don't erase first part of dispatch := 2; ! range - it's in prompt else if (not start_is_within) and end_is_within then ! don't erase last part of dispatch := 3; ! range - it's in prompt !else if user went to all the trouble to put prompt_range entirely ! within the_range, let him shoot off his foot. endif; endif; endif; endif; case dispatch [0]: new_range := the_range; [1]: ! empty prompt line or the_range entirely within prompt_range position (the_buffer); ! get last range from the_buffer so assigning ! eve$x_restore_xxx to this procedure won't ! change its value. eve$erase_text := create_range (beginning_of (the_buffer), mark (NONE), NONE); position (saved_window); return; [2]: ! start of the_range is in the prompt position (end_of (prompt_range)); move_horizontal (1); new_range := create_range (mark (NONE), end_of (the_range), NONE); [3]: ! end of the_range is in the prompt position (beginning_of (prompt_range)); move_horizontal (-1); new_range := create_range (beginning_of (the_range), mark (NONE), NONE); endcase; position (the_buffer); set (RECORD_ATTRIBUTE, create_range (beginning_of (the_buffer), end_of (the_buffer), NONE), MODIFIABLE, ON); erase (the_buffer); if new_range <> 0 then copy_text (new_range); else split_line; endif; if not include_line_break then if current_offset = 0 then move_horizontal (-1); endif; if (current_character = "") and (mark (NONE) <> beginning_of (the_buffer)) then move_horizontal (-1); endif; endif; eve$erase_text := create_range (beginning_of (the_buffer), mark (NONE), NONE); if the_buffer = eve$x_char_buffer then if new_range <> 0 then if get_info (new_range, "type") = RANGE then if get_info (get_info (new_range, "buffer"), "mode") = OVERSTRIKE then position (end_of (new_range)); move_horizontal (1); endif; erase (new_range); ! Warning issued in unmodifiable buffer endif; endif; position (saved_window); return; ! Don't put characters into eve$restore_buffer endif; if get_info (eve$restore_buffer, "type") <> BUFFER then if eve$x_buf_str_restore = tpu$k_unspecified then eve$x_buf_str_restore := "$RESTORE$"; endif; eve$restore_buffer := eve$init_buffer (eve$x_buf_str_restore, ""); endif; position (eve$restore_buffer); set (RECORD_ATTRIBUTE, create_range (beginning_of (eve$restore_buffer), end_of (eve$restore_buffer), NONE), MODIFIABLE, ON); erase (eve$restore_buffer); if new_range <> 0 then ! Abort if the_buffer is unmodifiable. move_text (new_range); ! Warning issued in unmodifiable buffer else ! (move changed to copy). split_line; endif; if (not include_line_break) and (mark (NONE) <> beginning_of (current_buffer)) then move_horizontal (-1); endif; eve$x_restore_range := create_range (beginning_of (eve$restore_buffer), mark (NONE), NONE); position (saved_window); endprocedure; ! eve$erase_text ! EVE$EDIT.TPU Page 40 procedure eve_delete ! Delete character to left of cursor ! Delete previous character ! ! If eve$x_fast_delete is true, then use the fast erase_character builtin ! which does not preserve font information; otherwise, preserve ! fonts by using proc eve$erase_text (which uses ranges for deletes). ! Note: deletes in column 1 will be slower even with eve$x_fast_delete = 1 ! because ranges must be used to preserve the end-of-line information ! for the undelete. local here, this_buffer, the_range, ok, cursor_is_free, char_range, ! Range containing the character to delete saved_mark; on_error [TPU$_CONTROLC]: eve$$restore_position (saved_mark); eve$learn_abort; abort; [TPU$_BEGOFBUF]: if not eve$x_bound_cursor then return (TRUE); ! silently return endif; eve$message (error_text, error); eve$learn_abort; return (FALSE); [OTHERWISE]: eve$$restore_position (saved_mark); endon_error; ! if pending delete is active, put select range into $RESTORE$SELECTION$ buffer if (eve$x_select_position <> 0) or (eve$x_box_array <> 0) then if eve$$x_state_array {eve$$k_pending_delete_active} then if eve$$pending_delete (0) then return (TRUE); endif; endif; endif; if not eve$declare_intention (eve$k_action_erase_to_left) then return (FALSE); endif; saved_mark := mark (FREE_CURSOR); ! to restore buffer after errors this_buffer := current_buffer; eve$x_erased_char_forward := FALSE; cursor_is_free := not (get_info (current_buffer, "bound")); if (current_offset = 0) and eve$x_fast_delete then ! this will force an error if before_bol in buffer's 1st line move_horizontal (-1); ! the following code is a simple version of eve$erase_text here := mark (NONE); char_range := create_range (mark (NONE), mark (NONE), NONE); position (eve$x_char_buffer); erase (eve$x_char_buffer); copy_text (char_range); move_horizontal (-1); eve$x_restore_char := create_range (beginning_of (eve$x_char_buffer), mark (NONE), NONE); position (here); move_horizontal (1); if mark (NONE) = end_of (this_buffer) then move_horizontal (-1); if current_offset = 0 then move_horizontal (1); append_line; ! Warning issued in unmodifiable buffer endif; else append_line; ! Warning issued in unmodifiable buffer endif; return (TRUE); else if eve$x_fast_delete then ! prevent erase_character when in a prompt & not at offset = 0 if not eve$in_prompting_window then ! make this as fast as possible ok := TRUE; else if not eve$in_prompt then ok := TRUE; endif; endif; if ok then eve$x_restore_char := erase_character (-1); ! Warning issued in ! unmodifiable buffer if get_info (current_buffer, "mode") = OVERSTRIKE then if current_character <> "" ! no space at eol then eve$insert_text (" "); move_horizontal (-1); endif; endif; endif; return (TRUE); endif; endif; ! eve$x_fast_delete = 0 if cursor_is_free then if current_offset = 0 then ! this will error if before_bol in 1st line & bound cursor mode move_horizontal (-1); char_range := create_range (mark (NONE), mark (NONE), NONE); move_horizontal (1); else if not eve_move_left then return (FALSE); endif; char_range := " "; endif; else ! get_info (current_buffer, "bound") move_horizontal (-1); char_range := create_range (mark (NONE), mark (NONE), NONE); move_horizontal (1); endif; eve$x_restore_char := eve$erase_text (char_range, eve$x_char_buffer, FALSE); return (TRUE); endprocedure; ! eve_delete ! EVE$EDIT.TPU Page 41 procedure eve_change_direction ! Change direction ! Toggle direction between forward and reverse if current_direction = FORWARD then set (REVERSE, current_buffer); else set (FORWARD, current_buffer); endif; eve$x_old_find_direction := current_direction; ! FNDNXT should use cur_dir eve$update_status_lines; return (TRUE); endprocedure; ! eve_change_direction ! EVE$EDIT.TPU Page 42 procedure eve_move_by_line ! Move to start of line ! Move to start of line if current direction is reverse; ! else move to end of line. If this would be a no-op, go ! to the start of the previous line or the end of the next line. ! ! Note that at the end of the command prompt in reverse, the cursor moves ! to the end of the previous line, not to the end of the prompt in the ! previous line - because the post command filter always leaves the cursor at ! the end of a command line if you've moved up or down in the command buffer. local cursor_is_free, ! True if cursor beyond end of current line saved_mark; on_error [TPU$_CONTROLC]: eve$$restore_position (saved_mark); eve$learn_abort; abort; [TPU$_BEGOFBUF, TPU$_ENDOFBUF]: eve$$restore_position (saved_mark); [OTHERWISE]: eve$$restore_position (saved_mark); endon_error; if not eve$declare_intention (eve$k_action_short_move) then return (FALSE); endif; cursor_is_free := not (get_info (current_buffer, "bound")); saved_mark := mark (FREE_CURSOR); position (TEXT); ! snap cursor to text if current_direction = REVERSE then ! In prompting window, go to previous line if within prompt if eve$in_prompting_window then if eve$in_prompt then move_vertical (-1); endif; ! NOTE: the command post filter always moves to the end of a new line ! in the command window. position (LINE_BEGIN); else ! not command if not cursor_is_free then if current_offset = 0 then move_vertical (-1); endif; endif; position (LINE_BEGIN); endif; else if cursor_is_free then position (saved_mark); if get_info (current_window, "beyond_eol") then position (LINE_END); ! Prevent padding. move_horizontal (1); ! Faster than move_vertical, & move_vert endif; ! doesn't always go to eol if else ! EDT-style column_move_vertical is ON if mark (NONE) <> end_of (current_buffer) then if current_character = "" ! on eol then move_horizontal (1); ! Faster than move_vertical + move_vert endif; ! doesn't always to to eol endif; endif; position (LINE_END); ! gotta do this for all cases endif; return (TRUE); endprocedure; ! eve_move_by_line ! EVE$EDIT.TPU Page 43 procedure eve_move_down ! Move down one row (free and bound cursor) ! Move down one row, staying in the same column. Scroll if necessary. on_error [OTHERWISE]: endon_error; ! scroll the VT100 choice window if it's mapped if eve$$x_state_array {eve$$k_ambiguous_parse} then if (current_window = eve$command_window) and eve$on_a_pre_lk201 then eve$move_by_screen (1); return (TRUE); endif; endif; if not eve$declare_intention (eve$k_action_down_right) then return (FALSE); endif; if eve$x_bound_cursor then move_vertical (1); ! command post filter cleans up after this move_vertical else case cursor_vertical (1) from - 1 to 0 [-1]: cursor_vertical (-1); if scroll (current_window, 1) = 0 then eve$learn_abort; return FALSE; endif; [0]: if scroll (current_window, 1) = 0 then eve$learn_abort; return FALSE; endif; endcase; endif; return (TRUE); endprocedure; ! eve_move_down ! EVE$EDIT.TPU Page 44 procedure eve_move_left ! Move left one column (free and bound cursor) ! Move left one column. Do not wrap at edge of the screen. on_error [OTHERWISE]: endon_error; if not eve$declare_intention (eve$k_action_up_left) then return (FALSE); endif; if eve$x_bound_cursor then move_horizontal (-1); else if cursor_horizontal (-1) = 0 then eve$learn_abort; return FALSE; endif; endif; return (TRUE); endprocedure; ! eve_move_left ! EVE$EDIT.TPU Page 45 procedure eve_move_right ! Move right one column (free and bound cursor) ! Move right one column. Do not wrap at edge of the screen. on_error [OTHERWISE]: endon_error; if eve$in_prompting_window then if current_character = "" then return (TRUE); endif; endif; if not eve$declare_intention (eve$k_action_down_right) then return (FALSE); endif; if eve$x_bound_cursor then move_horizontal (1); else if cursor_horizontal (1) = 0 then eve$learn_abort; return (FALSE); endif; endif; return (TRUE); endprocedure; ! eve_move_right ! EVE$EDIT.TPU Page 46 procedure eve_move_up ! Move up one row (free and bound cursor) ! Move up one row, staying in the same column. Scroll if necessary. on_error [OTHERWISE]: endon_error; ! scroll the VT100 choice window if it's mapped if eve$$x_state_array {eve$$k_ambiguous_parse} then if (current_window = eve$command_window) and eve$on_a_pre_lk201 then eve$move_by_screen (-1); return (TRUE); endif; endif; if not eve$declare_intention (eve$k_action_up_left) then return (FALSE); endif; if eve$x_bound_cursor then move_vertical (-1); else case cursor_vertical (-1) [-1]: cursor_vertical (1); if scroll (current_window, -1) = 0 then eve$learn_abort; return FALSE; endif; [0]: if scroll (current_window, -1) = 0 then eve$learn_abort; return FALSE; endif; endcase; endif; return (TRUE); endprocedure; ! eve_move_up ! EVE$EDIT.TPU Page 47 procedure eve_next_screen ! Scroll forward one screen if not eve$declare_intention (eve$k_action_move_by_screen) then return (FALSE); endif; ! Scroll forward one screen if eve$move_by_screen (1) then return (TRUE); else eve$learn_abort; return (FALSE); endif; endprocedure; ! eve_next_screen procedure eve_previous_screen ! Scroll backwards one screen if not eve$declare_intention (eve$k_action_move_by_screen) then return (FALSE); endif; ! Scroll back one screen if eve$move_by_screen (-1) then return (TRUE); else eve$learn_abort; return (FALSE); endif; endprocedure; ! eve_previous_screen ! EVE$EDIT.TPU Page 48 procedure eve_bottom ! BOTTOM ! Go to end of the current buffer on_error [OTHERWISE]: endon_error; if not eve$declare_intention (eve$k_action_down_right) then return (FALSE); endif; position (TEXT); ! snap cursor to text if mark (NONE) = end_of (current_buffer) then eve$message (EVE$_ATBOTTOM); ! no learn_abort here else position (end_of (current_buffer)); endif; return (TRUE); endprocedure; ! eve_bottom procedure eve_top ! TOP ! Go to beginning of the current buffer on_error [OTHERWISE]: endon_error; if not eve$declare_intention (eve$k_action_up_left) then return (FALSE); endif; position (TEXT); ! snap cursor to text if mark (NONE) = beginning_of (current_buffer) then eve$message (EVE$_ATTOP); ! no learn_abort here else position (beginning_of (current_buffer)); endif; return (TRUE); endprocedure; ! eve_top ! EVE$EDIT.TPU Page 49 procedure eve$delete_start_word ! EDT-like delete word (reverse) local end_mark, word_range, number_chars; on_error [OTHERWISE]: endon_error; if mark (NONE) = beginning_of (current_buffer) then move_vertical (-1); ! force an error message endif; if not eve$declare_intention (eve$k_action_erase_to_left) then return (FALSE); endif; move_horizontal (-1); end_mark := mark (NONE); move_horizontal (1); number_chars := eve$start_of_word; if number_chars = 0 then move_horizontal (-1); ! erase line break endif; word_range := create_range (mark (NONE), end_mark, NONE); eve$x_erased_word_forward := FALSE; eve$x_restore_word := eve$erase_text (word_range, eve$x_word_buffer, FALSE); ! If space before eol, remove the space; then, if not beyond the ! screen edge then free cursor back to eol (so FILL won't add a 2nd space) if current_character = "" then ! Don't remove trailing space in command buffer if (not eve$in_prompt) and (current_window <> eve$command_window) then if mark (NONE) <> beginning_of (current_buffer) then move_horizontal (-1); if current_character = " " then erase_character (1); if (get_info (mark (FREE_CURSOR), "offset_column") + get_info (current_window, "shift_amount")) <= (get_info (current_window, "width")) then cursor_horizontal (1); endif; else move_horizontal (1); endif; endif; endif; endif; return (TRUE); endprocedure; ! eve$delete_start_word ! EVE$EDIT.TPU Page 50 procedure eve$delete_word ! EDT-like Delete word local text_mark, word_range, saved_mark; on_error [TPU$_CONTROLC]: eve$$restore_position (saved_mark); ! restore free cursor position eve$learn_abort; abort; [OTHERWISE]: eve$$restore_position (saved_mark); endon_error; if not eve$declare_intention (eve$k_action_erase_to_right) then return (FALSE); endif; saved_mark := mark (FREE_CURSOR); if eve$eol_nopad_delete then return (TRUE); endif; if not get_info (current_window, "beyond_eob") then if not (get_info (current_window, "before_bol") or get_info (current_window, "middle_of_tab")) then position (TEXT); ! snap to text endif; else position (TEXT); ! snap to text saved_mark := mark (FREE_CURSOR); endif; text_mark := mark (NONE); if text_mark = end_of (current_buffer) then move_vertical (1); ! force an error message endif; if current_character <> "" then eve$end_of_word; move_horizontal (-1); else if eve$in_prompting_window then eve$x_restore_word := 0; return (TRUE); endif; endif; word_range := create_range (text_mark, mark (NONE), NONE); eve$x_erased_word_forward := TRUE; eve$x_restore_word := eve$erase_text (word_range, eve$x_word_buffer, FALSE); if eve$x_restore_word = 0 then eve$learn_abort; return (FALSE); endif; if length (eve$x_restore_word) = 0 then position (saved_mark); endif; return (TRUE); endprocedure; ! eve$delete_word ! EVE$EDIT.TPU Page 51 ! If beyond_eol and next line is blank, just append line with no padding ! Return false if: ! 1. not beyond_eol ! 2. beyond_eol and: on eob, on last line, or next line is not blank. ! If beyond_eol and next line is blank, then padlessly delete the blank line, ! position back to the original beyond_eol position, and return true. ! Used by several EDT keypad keys. procedure eve$eol_nopad_delete ! Padless delete from beyond_eol local text_mark, saved_mark; on_error [TPU$_CONTROLC]: eve$$restore_position (saved_mark); ! restore free cursor position eve$learn_abort; abort; [TPU$_ENDOFBUF]: eve$$restore_position (saved_mark); return (FALSE); [OTHERWISE]: eve$$restore_position (saved_mark); return (FALSE); endon_error; saved_mark := mark (FREE_CURSOR); if not get_info (current_window, "beyond_eob") then if get_info (current_window, "beyond_eol") then position (LINE_BEGIN); move_vertical (1); ! force error return if at eob position (LINE_BEGIN); if mark (NONE) = end_of (current_buffer) then move_vertical (1); ! force error return if on last line else if current_character = "" then ! append line erase (create_range (mark (NONE), mark (NONE), NONE)); position (saved_mark); ! no padding return (TRUE); else position (saved_mark); ! let caller delete after we pad at text_mark := mark (NONE); ! the beyond_eol position endif; endif; endif; endif; return (FALSE); endprocedure; ! eve$eol_nopad_delete ! EVE$EDIT.TPU Page 52 procedure eve$set_action_facility ! Enable a facility's edit handlers (the_facility) ! Description: ! Called by user command or layered product module init procedure. ! Sets the "current" action facility, that is, switches to the pre ! and post-action declarations, if any, declared for the ! specified facility. This allows the user to change the behavior ! of the editor with respect to pre and post actions ! Parameters: ! the_facility = A facility code (integer/string) for the new set of pre and ! post-action edit handlers to enable; or integer 0 to disable ! all pre and post-action edit handlers. Input. on_error [OTHERWISE]: endon_error; if get_info (eve$$x_post_facility_array, "type") <> ARRAY then eve$$x_post_facility_array := create_array; eve$$x_pre_facility_array := create_array; endif; if the_facility = 0 then eve$$x_current_post_array := 0; eve$$x_current_pre_array := 0; else if eve$$x_post_facility_array {the_facility} = tpu$k_unspecified then eve$$x_post_facility_array {the_facility} := create_array; eve$$x_pre_facility_array {the_facility} := create_array; endif; eve$$x_current_post_array := eve$$x_post_facility_array {the_facility}; eve$$x_current_pre_array := eve$$x_pre_facility_array {the_facility}; endif; return (TRUE); endprocedure; ! eve$set_action_facility ! EVE$EDIT.TPU Page 53 procedure eve$declare_edit_handler ! Create a pre/post edit handler (action_type, the_facility, pre_processing, code_source) ! Description: ! Called by layered products during initialization to set a pre or post edit ! handler for the specified type of editing action (action_type). ! These declarations are buffer-independent. ! Can be called before or after a call to EVE$SET_ACTION_FACILITY. ! Parameters: ! action_type = Type of edit action requiring a pre or post action handler. ! Usually an integer constant, most often a pre-declared EVE constant ! of the form EVE$K_ACTION_some_edit_operation, but can also be a ! string of the form "FACILITY_CODE$some_edit_operation". Input ! the_facility = Facility that owns this edit handler. EVE will ! only invoke handlers for the facility last set by a call to ! EVE$SET_ACTION_FACILITY. Input. ! pre_processing = ! TRUE: pre edit handler should be invoked BEFORE a procedure is about ! to perform an edit operation by calling EVE$DECLARE_INTENTION ! with an "action_type" that matches the first parameter above. ! FALSE: post edit handler will be called by TPU AFTER operations ! that leave the current position on an invisible line. Input. ! code_source = Program source for handler: a string, range, buffer, ! program, learn sequence, or integer zero (= remove the edit handler). ! Input. local the_array, action_array; on_error [OTHERWISE]: endon_error; ! pre or post action? if get_info (eve$$x_post_facility_array, "type") <> ARRAY then eve$$x_post_facility_array := create_array; eve$$x_pre_facility_array := create_array; endif; if pre_processing then the_array := eve$$x_pre_facility_array else the_array := eve$$x_post_facility_array endif; ! create this facility's array if it hasn't been created yet action_array := the_array {the_facility}; if action_array = tpu$k_unspecified then eve$$x_post_facility_array {the_facility} := create_array; eve$$x_pre_facility_array {the_facility} := create_array; action_array := the_array {the_facility}; endif; ! declare the handler action or delete it if code_source = 0 then action_array {action_type} := tpu$k_unspecified; else action_array {action_type} := code_source; endif; return (TRUE); endprocedure; ! eve$declare_edit_handler ! EVE$EDIT.TPU Page 54 procedure eve$declare_intention ! Intend to perform an editing operation (action_type) ! Description: ! Called by EVE procedures that are about to perform the specified action ! type. Executes any pre-action edit handler defined for the specified ! action type, if one exists, for the facility specified in the last call ! to EVE$SET_ACTION_FACILITY. Regardless of the existence of an ! edit handler, this procedure will set EVE$$X_CURRENT_ACTION_TYPE ! to the specified action_type. Any post-action routine declared for ! that action type will be executed after the current edit action completes ! and the editing point is on an invisible line. ! Parameter: ! action_type = Type of edit action about to execute. ! Returns boolean: ! True: continue execution. No facility has been set, no pre-action was ! declared for the facility, the current_buffer is a system buffer, ! or the pre-action edit handler succeeded. ! False: stop execution. The edit handler defined for this action type ! wants the calling procedure to stop executing regardless of the handler ! succeeding or failing. local status, the_code; on_error [OTHERWISE]: endon_error; ! remember the current editing action type eve$$x_current_action_type := action_type; if eve$$x_current_pre_array = 0 then return (TRUE); ! no facility set by eve$set_action_facility yet endif; ! execute the pre action if it exists for the specified action_type the_code := eve$$x_current_pre_array {eve$$x_current_action_type}; if the_code <> tpu$k_unspecified then case get_info (the_code, "type") [STRING, BUFFER, RANGE]: ! compile the code only once eve$$x_current_pre_array {eve$$x_current_action_type} := compile (eve$$x_current_pre_array {eve$$x_current_action_type}); endcase; ! Execute the pre-action handler. We have to swap the status values ! because they're like those returned by exit/quit/parser handlers: ! false = ok to continue (we should return true) ! true = stop execution, no error (we should return false) ! eve$k_informational = stop execution, error (we should return false) status := execute (eve$$x_current_pre_array {eve$$x_current_action_type}); if status then return (FALSE); else return (TRUE); endif; endif; return (TRUE); ! no pre-action declared for this facility endprocedure; ! eve$declare_intention ! EVE$EDIT.TPU Page 55 procedure eve$$detached_cursor_action ! detached cursor post-action routine ! Description: ! Called after the program bound to a key has been executed (as well as ! the post-key procedure), and cursor is detached from the editing point. ! For invisible lines or off to the left/right, this procedure tests for ! and executes a post-action edit handler declared by the current facility ! for the editor function that executed last; if no handler exists, then ! move downward to the next visible line (EOB is always visible). local the_code, detachment, the_buffer, new_window, window_count, action_array; on_error [OTHERWISE]: endon_error; detachment := get_info (SCREEN, "detached_reason"); ! tpu$k_unmapped = no current window --> put up EVE windows if in control if (detachment and tpu$k_unmapped) = tpu$k_unmapped then if not eve$eve_in_control then return; else ! get a user buffer !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!! SYNC THIS CODE WITH EVE$CHECK_BAD_WINDOW !!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! the_buffer := get_info (BUFFERS, "first"); loop exitif the_buffer = 0; exitif not get_info (the_buffer, "system"); the_buffer := get_info (BUFFERS, "next"); endloop; if the_buffer = 0 then if eve$x_buf_str_main = tpu$k_unspecified then eve$x_buf_str_main := "MAIN"; endif; the_buffer := get_info (BUFFERS, "find_buffer", eve$x_buf_str_main); endif; if the_buffer = 0 then ! No Main buffer, create it. if get_info (eve$default_buffer, "type") <> BUFFER then ! i.e., no default buffer during startup eve$x_main_buffer := create_buffer (eve$x_buf_str_main); set (EOB_TEXT, eve$x_main_buffer, message_text (EVE$_EOBTEXT, 1)); set (LEFT_MARGIN, eve$x_main_buffer, eve$x_default_left_margin); set (RIGHT_MARGIN, eve$x_main_buffer, (get_info (eve$main_window, "width") - eve$x_default_right_margin)); set (RIGHT_MARGIN_ACTION, eve$x_main_buffer, eve$kt_word_wrap_routine); else eve$x_main_buffer := create_buffer (eve$x_buf_str_main, "", eve$default_buffer); set (MODIFIABLE, eve$x_main_buffer, ON);! override default buf set (NO_WRITE, eve$x_main_buffer, OFF); ! override default buf if eve$$x_word_wrap_indent {eve$default_buffer} <> tpu$k_unspecified then eve$$x_word_wrap_indent {eve$x_main_buffer} := eve$$x_word_wrap_indent {eve$default_buffer}; endif; if eve$$x_paragraph_indent {eve$default_buffer} <> tpu$k_unspecified then eve$$x_paragraph_indent {eve$x_main_buffer} := eve$$x_paragraph_indent {eve$default_buffer}; endif; endif; if (eve$$x_buffer_change_journaling) and (not get_info (eve$x_main_buffer, "journaling")) then set (JOURNALING, eve$x_main_buffer, ON); endif; endif; !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!! END OF SYNC !!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! eve$setup_windows (the_buffer); eve$message (EVE$_NOWINDOWS); return; endif; endif; ! tpu$k_no_update = current_window can't be updated. Find a user window ! which can be updated and position there. Check for other funny detachment ! states in the new window. if (detachment and tpu$k_no_update) = tpu$k_no_update then if not eve$eve_in_control then return; endif; window_count := 1; loop new_window := eve$$x_windows {window_count}; exitif get_info (new_window, "type") = UNSPECIFIED; if get_info (new_window, "type") = WINDOW then if get_info (new_window, "screen_update") then position (new_window); ! Fixes any disjoint state if get_info (mark (free_cursor), "display_value") < get_info (new_window, "display_value") then eve$move_to_visible; ! Fixes invisible state endif; return; endif; endif; window_count := window_count + 1; endloop; ! No window that can be updated! (Sure hope user knows what's going on!) ! Just drop through and handle other cases... endif; ! tpu$k_disjoint = cursor (current_window) is disjoint with the ! editing position (current_buffer) --> resync them if (detachment and tpu$k_disjoint) = tpu$k_disjoint then ! don't resync if other application took focus and change position if not eve$$x_position_lost then eve$message (EVE$_SYNCDETACHED); position (current_window); if get_info (mark (free_cursor), "display_value") < get_info (current_window, "display_value") then eve$move_to_visible; ! Fixes invisible state endif; endif; return; endif; ! invisible, or off screen to left or right if ((detachment and tpu$k_invisible) = tpu$k_invisible) or ((detachment and tpu$k_off_left) = tpu$k_off_left) or ((detachment and tpu$k_off_right) = tpu$k_off_right) then ! pre/post-actions are for user and system buffers if (eve$$x_current_post_array = 0) ! no eve$set_action_facility yet then if (detachment and tpu$k_invisible) = tpu$k_invisible then ! move if invisible, ignore off l/r eve$move_to_visible; endif; return; endif; ! eve$$x_current_action_type set by last call to eve$declare_intention ! (hopefully it won't be stale, i.e., a pre-action execution causes no ! corresponding post-action, then a user procedure doesn't declare an ! intention but does cause a post-action) the_code := eve$$x_current_post_array {eve$$x_current_action_type}; if the_code <> tpu$k_unspecified then case get_info (the_code, "type") [STRING, BUFFER, RANGE]: ! compile the code only once eve$$x_current_post_array {eve$$x_current_action_type} := compile (eve$$x_current_post_array {eve$$x_current_action_type}); endcase; ! execute the invisible/off left,right post handler execute (eve$$x_current_post_array {eve$$x_current_action_type}); else if (detachment and tpu$k_invisible) = tpu$k_invisible then ! no post-action edit handler, move if invisible, ignore off l/r eve$move_to_visible; endif; endif; return; endif; endprocedure; ! eve$$detached_cursor_action ! EVE$EDIT.TPU Page 56 procedure eve$move_to_visible ! Move down to next visible line ! it's assumed the current line is invisible on_error [OTHERWISE]: endon_error; eve$message (EVE$_MOVETOVISIBLE); cursor_vertical (0); ! Snap to visible text endprocedure; ! eve$move_to_visible ! EVE$EDIT.TPU Page 57 procedure eve_box_select ! Start a box select ! Start a box selection. Cancels an active normal select or active ! box select. Starts pending delete. local status, saved_box_flag; on_error [TPU$_CONTROLC]: eve$clear_select_position; eve$x_box_select_flag := saved_box_flag; eve$learn_abort; abort; [OTHERWISE]: eve$clear_select_position; eve$x_box_select_flag := saved_box_flag; endon_error; saved_box_flag := eve$x_box_select_flag; eve$x_box_select_flag := TRUE; status := eve_select; ! inherit all standard select behavior eve$x_box_select_flag := saved_box_flag; return (status); endprocedure; ! eve_box_select ! EVE$EDIT.TPU Page 58 procedure eve$$box_select ! Box select subprocedure ! Creates box selection array: ! {0} = select mark at start of selection ! {1} = range for 1st line segment in the box ... ! {N} = range for Nth line segment in the box eve$x_box_array := create_array; eve$x_box_array {0} := select (eve$x_box_highlighting); return (TRUE); endprocedure; ! eve$$box_select ! EVE$EDIT.TPU Page 59 procedure eve$$box_selection ! Returns box selection array of ranges (do_messages; ! Display error messages? null_range_arg, ! Extend null ranges? (D=TRUE) cancel_arg) ! Cancel selection? (D=TRUE) ! Modeled after EVE$SELECTION. Returns the current box selection: ! array array of ranges for the box selection ! false error (select in other buffer, etc) ! NONE there was a null range ( with no movement between) if mark (NONE) <> end_of (current_buffer) then ! extend_null_range = true (default) makes select range of char under ! cursor; otherwise, returns NONE (if called by REMOVE, this ! clears paste buffer without removing anything for EDT-like ! SELECT/REMOVE, see variable EVE$X_SELECT_REMOVE_FLAG) if extend_null_range then ! make range in array for single character if current_character = "" then copy_text (" "); move_horizontal (-1); endif; eve$x_box_array {1} := create_range (mark (NONE), mark (NONE), NONE); temp := eve$x_box_array; if cancel_range then eve$clear_select_position; endif; return (temp); ! single character under cursor = box select else if cancel_range then eve$clear_select_position; endif; return (NONE); ! indicate <...> ending on same column if not extend_null_range then if cancel_range ! can't extend the null selection, kick out then ! after cancelling eve$clear_select_position; endif; return (NONE); endif; endif; ! insure proper move_vertical motion for left margin handling restore_column_mode := not get_info (SYSTEM, "column_move_vertical"); set (COLUMN_MOVE_VERTICAL, ON); ! Tab elimination should be limited to just the box of text if doing ! overstrike-style cut, or out to the end of each line contained in the box ! if doing insert-style cut (to maintain column alignment as the text slips ! to the left). if (not eve$x_box_pad_flag) and (get_info (current_buffer, "mode") = INSERT) then convert_tabs_to_eol := TRUE; endif; position (start_mark); ! EVE$EDIT.TPU Page 60 saved_mode := get_info (current_buffer, "mode"); set (INSERT, current_buffer); the_index := 1; loop ! Eliminate Tabs in this line. Since any part of this line may be ! off screen, create the range after moving the_width using ! MOVE_HORIZONTAL. To do this, we have to first replace all ! Tabs with spaces for the_width columns. if (current_character = ascii (9)) and (mark (NONE) = original_start_mark) then adjust_original := 1; endif; if convert_tabs_to_eol then eve$convert_tabs (create_range (mark (NONE), LINE_END, NONE), TRUE); else ! insure tabs in single column selections (the_width < 0) are converted eve$convert_tabs (create_range (mark (NONE), LINE_END, NONE), TRUE, end_col - (the_width >= 0)); endif; ! Since Tab conversion will move start_mark if it's on a Tab, position ! to the start mark again (after checking if it moved) if adjust_original then ! original start mark just moved original_start_mark := mark (NONE, current_buffer, start_col); adjust_original := 0; endif; position (original_start_mark); move_vertical (the_index - 1); start_mark := mark (NONE); if the_width >= 0 then ! box is >= 1 col wide if left_of_start then ! empty lines in box get filled with spaces (it's already ! been padded out to left side of box if needed) copy_text (" " * (the_width )); move_horizontal (-1); temp := mark (NONE); move_horizontal (- (the_width )); eve$x_box_array {the_index} := create_range (mark (NONE), temp, NONE); else move_horizontal (the_width); ! move to right side of box if get_info (mark (NONE), "record_number") > get_info (start_mark, "record_number") then ! short line doesn't reach right side of box, pad out position (start_mark); position (LINE_END); at_eol := FALSE; if mark (NONE) = start_mark then at_eol := TRUE; endif; ! if at eol, this will move start_mark temp := (end_col - get_info (mark (NONE), "offset_column") - 1); copy_text (" " * (temp)); if at_eol then ! redo start_mark move_horizontal (- temp); start_mark := mark (NONE); if the_index = 1 then ! and original_start_mark too original_start_mark := start_mark; endif; position (LINE_END); endif; endif; temp := mark (NONE); if temp <> end_of (current_buffer) then if current_character = "" then ! don't include eol in range copy_text (" "); move_horizontal (-1); temp := mark (NONE); if the_index = 1 then ! redo start_mark and original_start_mark move_horizontal (- the_width); start_mark := mark (NONE); original_start_mark := start_mark; endif; endif; endif; eve$x_box_array {the_index} := create_range (start_mark, temp, NONE); endif; else ! a null selection (