! EVE$CORE.TPU 20-JAN-1993 06:39 Page 1 module eve$core ident "V03-037" ! EVE - Extensible Versatile Editor ! !************************************************************************* ! * ! © 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: ! Text Processing Utility (DECTPU) ! ! ABSTRACT: ! This is the core source program for the EVE interface, created ! from the old evesecini.tpu. ! ! ENVIRONMENT: ! OpenVMS VAX, OpenVMS AXP, RISC/ULTRIX ! ! CREATION DATE: 10-Oct-1986 ! ! MODIFIED BY: ! EDS 15-Jan-2002 fix TPU_XBUGS 329 ! RAM 20-Oct-1994 fix v3.1 change of eve$pattern_end_of_word. !-- ! EVE$CORE.TPU Page 2 !++ ! Table of Contents ! ! EVE$CORE.TPU ! 20-JAN-1993 06:39 ! ! Procedure name Page Description ! -------------- ---- ------------ ! ! eve$version 4 returns string version ! eve$$init_variables 5 Init all EVE core variables ! eve$init_repeat 6 Initialize the REPEAT variables ! eve$restore_word_separators 7 Use default word separators ! eve$add_word_separators 7 Add new word separators ! eve$replace_word_separators 8 Use new set of word separators ! eve$read_word_separators 8 Get current separators ! eve$$assign_word_separators 9 Assign new word separators ! eve$assign_whitespace 10 Define whitespace ! eve$$found_post_filter 11 Remove the found range if moved ! eve_change_mode 12 Change insert/overstrike mode ! eve_set_find_whitespace 13 Turn on space -> WS ! eve_set_find_nowhitespace 13 Turn off space -> WS ! eve_find 14 Find ! eve$find 15 Backwards compatible eve$find ! eve$$build_pattern 16 Build a pattern for find ! eve$$build_space_pattern 17 Build a pattern for whitespace ! eve$search 18 Search (including leading w/s) ! eve$remember_found 19 Remember the search string ! eve$$remove_found_range 20 Cancel found range (& remove filter) ! eve$$remove_post_filter 21 Remove a post-key filter ! eve$get_find_target 22 Find subprocedure ! eve$set_find_target_case 23 Set target's case exactness ! eve$find_target 24 Find subprocedure ! eve_find_next 25 FIND NEXT command ! eve$find_next 25 Find next occurrence ! eve_find_selected 26 Find current selection ! eve_set_find_case_exact 27 make searches case exact ! eve_set_find_case_noexact 27 make searches not case exact ! eve$set_find_case_sensitivity 28 Set FIND case sensitivity ! eve$get_find_case_sensitivity 28 Return FIND's sensitivity setting ! eve$set_diacritical_sensitivity 29 Set FIND diacritical sens. ! eve$get_diacritical_sensitivity 29 Get FIND diacritical sens. ! eve$$test_find_terminator 30 Test if must change direction ! eve$on_end_of_line 31 Test if at eol ! eve_return 32 The RETURN key procedure ! eve$$bufed_select 33 Dummy BufEd routine ! eve$$bufed_remove 33 Dummy BufEd routine ! eve_select 34 SELECT ! eve$$select_choice 35 Select logic for choices window ! eve$select_a_range 36 make range become the selection ! eve$selection 37 Get the select range or implied SR ! eve_select_all 38 SELECT ALL ! eve_set_pending_delete 39 Enable pending delete behavior ! eve_set_nopending_delete 39 set pending delete off ! eve$start_pending_delete 40 Arm pending delete ! eve$stop_pending_delete 40 disarm pending delete ! eve$clear_select_position 41 DESELECT (& remove filter) ! eve$$pending_delete 42 Actually zap the selection ! eve_restore_selection 43 pending delete "undo" ! eve_restore_box_selection 44 box pending delete "undo" ! eve_remove 45 REMOVE ! eve_cut 45 Synonym for REMOVE ! eve_copy 45 Synonym for STORE TEXT ! eve_store_text 46 STORE TEXT ! eve$$store_remove 47 Store/remove text ! eve_insert_here 48 INSERT HERE ! eve$$insert_here 49 Insert text here ! eve_paste 49 Synonym for INSERT HERE ! eve_tab 50 TAB ! eve$spaces_to_tab 51 Number of spaces to current TAB ! eve_insert_page_break 52 Insert a page break ! eve_insert_mode 53 Change to insert mode ! eve_overstrike_mode 53 Change to overstrike mode ! eve_quote 54 Insert special characters ! eve_restore 55 Restore erased line or word ! eve_restore_line 56 Restore erased line ! eve_restore_word 57 Restore erased word ! eve_restore_character 58 Restore erased char ! eve$test_if_modifiable 59 Test if buffer is modifiable ! tpu$local_init 60 User's init procedure ! tpu$local_pre_init 60 User's pre-init procedure ! eve$insert_text 61 Copy_text in insert mode ! eve$overstrike_text 62 Copy_text in overstrike mode ! eve$$init_modules 63 Init facilities after EVE init ! eve$$pre_init_modules 63 Init facilities during EVE init ! eve$$restore_settings 64 Restore section file settings ! eve_reset 65 RESET command ! tpu$init_procedure 66 INIT ! eve$$init_settings 67 Init specific settings ! eve$init_procedure 68 EVE's init procedure ! tpu$init_postprocedure 69 Last procedure during startup ! eve$init_postprocedure 69 EVE's init postprocedure ! eve$set_function_keys_eve 70 Restore EVE's null function key_map !-- ! EVE$CORE.TPU Page 3 ! ! As documented in the User's Guide to EVE, procedures with names beginning ! with eve_ are EVE commands. The procedures with names beginning with eve$$ ! may be useful in extending EVE. However, these procedures are subject to ! change. In the future, Digital may supply new procedures beginning with ! eve$$, remove some of the eve$$ procedures, or change existing eve$$ ! procedures. The same is true for global variables with names beginning ! with eve$$. User-written procedures should not begin with eve$$. ! There are several mechanisms in EVE for tracking various types of ! version and configuration information. These are: ! ! Identifier Versions using ! ! EVE$X_VERSION All released versions ! EVE$KT_VERSION V1.1 (VMS V4.4) and later ! EVE$VERSION V2.0 (VMS V5.0) and later ! module_MODULE_IDENT V2.0 (VMS V5.0) and later ! ! Their uses are as follows: ! ! module_MODULE_IDENT Per module "idents" ! ! Each source file built into the EVE product contains a procedure ! that identifies the precise version and edit of the module. These ! procedures all have names ending with "_MODULE_IDENT" followed by ! the module name. Thus this file (EVE$CORE) contains the procedure ! EVE$CORE_MODULE_IDENT defined just below. The module name and the ! "ident" (the returned value) are reported by EVE's SHOW SUMMARY ! command and by EVE$BUILD's .LIST file. ! ! EVE$VERSION Version including build time. ! ! Every time EVE$BUILD is run it creates a procedure named EVE$VERSION ! which contains the product name (gotten from the EVE$BUILD command ! line), the product version (gotten from the product_VERSION.DAT file), ! and the the build date and time. This version can thus be used to ! trace the product back to the specific build and its .LIST and .INIT ! files. EVE$VERSION is reported by the SHOW and SHOW SUMMARY commands ! and is listed in the .LIST file. ! ! EVE$KT_VERSION String constant EVE version ! ! This constant, which (like all constants) is unchangeable once it ! is defined, is defined in EVE$CORE and identifies the overall EVE ! version that is being used. Since EVE can be built with or without ! various modules and various options (via conditional compilation), ! knowing the overall version does not guarantee which capabilities ! are built in. It does provide useful information to layered packages ! however. ! ! EVE$X_VERSION String variable for compatibility ! ! The original release of EVE did not distinguish string constants ! (which didn't exist in TPU) from string variables in its naming ! conventions. Thus in that version the version information was ! stored in EVE$X_VERSION rather than EVE$KT_VERSION. In order to ! allow for compatibility with programs developed for V1.0 of EVE ! EVE maintains the variable EVE$X_VERSION and sets its value to ! EVE$KT_VERSION at start-up time. Newly developed programs should ! not use EVE$X_VERSION. ! ! EVE$CORE.TPU Page 4 constant eve$kt_version := "V3.1"; ! Should be synched with EVE_VERSION.DAT constant eve$$x_command_prefix := "EVE_"; ! For the parser ! See the NOTE in procedure eve$$init_variables (just before global pattern ! variable assignments) concerning pattern variables and the variables ! they reference, for example eve$$x_word_separators. constant eve$$kt_word_separators := " " + ascii (9) + ascii (12) + ascii (13) + ascii (11) + ascii (10); ! Word separators: space, HT, FF, CR, VT, LF procedure eve$version ! returns string version return "EVE " + eve$kt_version; endprocedure; ! eve$version ! EVE$CORE.TPU Page 5 procedure eve$$init_variables ! Init all EVE core variables ! Initialize Eve variables ! Global variables should be initialized to eliminate the possible ! confusion of global variables with procedure names ! Assign whitespace characters and all pattern variables that use them. ! Constant eve$kt_whitespace is the default whitespace (space + tab). ! Variable eve$x_whitespace is the current whitespace. eve$assign_whitespace (eve$kt_whitespace); ! Global keyword variables eve$x_highlighting := REVERSE; ! Highlighting used by select/replace eve$x_found_highlighting := BOLD; ! Highlighting used by find range eve$x_prompt_highlighting := NONE; ! For command prompt eve$x_units := get_info (SYSTEM, "coordinates"); ! Use CHARACTERS ! or COORDINATES? ! Global string variables eve$x_nodocmsg := message_text (2524176, 1); ! 2524176 = LBR$_NODOC ! The following three are provided only for compatability reasons ! The corresponding eve$kt_... string constants should be used instead eve$x_version := eve$kt_version;! Eve version number eve$x_null := ""; ! Null string eve$x_spaces := eve$kt_spaces; ! Used for padding eve$x_fill_separators := eve$x_whitespace; ! Fill separators eve$$x_token_separators := eve$x_whitespace; ! Token separators eve$x_symbol_characters := ! Symbol characters are alphanumerics plus ! "$" and "_", including multinational ! character set "abcdefghijklmnopqrstuvwxyz" + "ABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890$_" %if eve$x_option_2byte %then %else +"àáâãäåæçèéêëìíîïñòóôõö÷øùúûüý" + "ÀÁÂÃÄÅÆÇÈÉÊËÌÍÎÏÑÒÓÔÕÖ×ØÙÚÛÜÝß" %endif ; eve$x_alphanumeric_characters := ! symbols minus "_" and "$" for parser "abcdefghijklmnopqrstuvwxyz" + "ABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890" %if eve$x_option_2byte %then %else +"àáâãäåæçèéêëìíîïñòóôõö÷øùúûüý" + "ÀÁÂÃÄÅÆÇÈÉÊËÌÍÎÏÑÒÓÔÕÖ×ØÙÚÛÜÝß" %endif ; eve$x_digit_characters := ! Digits - allow lowercase l for numeral 1 "0123456789l"; eve$x_not_alphabetic := ! Non-alphabetic graphic characters ! (Also not digits, so that "2-bit" ! is capitalized as "2-bit" not "2-Bit") ! "!@#$%^&*()[]{}-_+=~`|\:;""'<,>.?/" %if eve$x_option_2byte %then %else +"¡¢£¥§¨©ª«°±²³µ¶·¹º»¼½¿" %endif ; eve$x_eve_command_prompt := ! Command prompt used in eve_define_key message_text (EVE$_EVECMDPROMPT, 1); eve$$x_saved_command_line := "";! Used to restore the edited command eve$$x_current_init_cmd := ""; ! current line in initialization file ! The following variables hold words obtained from the message file and used ! in prompts, commands and displays. ! eve$x_insert := message_text (EVE$_INSERT, 1); eve$x_overstrike := message_text (EVE$_OVERSTRIKE, 1); eve$x_forward := message_text (EVE$_FORWARD, 1); eve$x_reverse := message_text (EVE$_REVERSE, 1); eve$x_all := message_text (EVE$_ALL, 1); eve$x_last := message_text (EVE$_LAST, 1); eve$x_quit := message_text (EVE$_QUIT, 1); eve$x_commands := message_text (EVE$_COMMANDS, 1); eve$kt_topic_eve_list_of_topics := eve$x_commands; ! For the parser eve$x_keypad := message_text (EVE$_KEYPAD, 1); eve$x_keys := message_text (EVE$_KEYS, 1); eve$$x_uppercase_token := ""; ! The obsolete variable EVE$X_HELP_STATUS_NEXT is no longer initialized ! The status line for the help window should now be set using the ! standard EVE$SET_STATUS_LINE or EVE$SET_FIXED_STATUS_LINE routines. ! Global pattern variables ! -- NOTE -- ! TPU V2 evaluates patterns at assignment time (V1 did at search time). ! This means a pattern variable must be reassigned if any variables it uses ! have been reassigned. ! ! For example, if you want to change eve$$x_word_separators, you must also ! reassign eve$pattern_end_of_word for the ERASE WORD command to work correctly. ! ! If you reassign any of the following variables then you must also ! reassign the pattern variables that use them. ! eve$$x_word_separators ! eve$x_runoff_characters ! eve$x_symbol_characters ! eve$x_wps_sentence_delimiters ! ! If you want to reassign eve$$x_word_separators, you can use ! EVE procedures provided for that purpose. These procedures reassign ! eve$$x_word_separators and also pattern variable eve$pattern_end_of_word: ! ! Procedure Use ! --------- --- ! eve$restore_word_separators Use EVE's default word separators ! (uses eve$$kt_word_separators) ! eve$add_word_separators Add user's separators ! eve$replace_word_separators Use only user's separators ! eve$read_word_separators Get current separators ! ! You may call these procedures from your /COMMAND file. ! ! Constant eve$kt_whitespace contains EVE's default whitespace. ! Variable eve$x_whitespace contains EVE's current whitespace. ! If you want to use different whitespace, for example, to remove the tab ! character from whitespace so that MOVE BY WORD moves by tabs, ! you must call procedure eve$assign_whitespace. ! eve$restore_word_separators; ! Make initial assignment to ! eve$$x_word_separators and ! eve$pattern_end_of_word. eve$pattern_procname := ! DECTPU procedure name ANCHOR + (span (eve$x_symbol_characters) | REMAIN); eve$x_target_pattern := 0; ! Pattern as a string, e.g., "line_begin+ 'abc'" eve$x_printable_target := ""; ! Pattern in wildcard syntax, e.g., "\ removes char ! under cursor. Set false for EDT ! behavior: don't remove, just clear ! paste buffer. eve$$x_found_filter_active := FALSE; ! Prevent nested calls to pre/post eve$$x_pre_dispatch_active := FALSE; ! filters. eve$$x_post_dispatch_active := FALSE; ! Buffer variables if get_info (eve$x_bufed_buffer, "type") = UNSPECIFIED then eve$x_bufed_buffer := 0; endif; ! ! Create global arrays ! eve$$x_word_wrap_indent := create_array; eve$$x_paragraph_indent := create_array; ! Variables used in the User Attribute set/save service - eve$$x_accumulate_attrs := FALSE; ! User settings changes eve$$x_attrs_modified := FALSE; ! User settings have not changed eve$$x_attr_exit_check := TRUE; ! check/save changed attributes on exit eve$$x_attr_save_check := TRUE; ! check/save changed attrs on save eve$$x_section_save_ok := TRUE; ! User can save section files eve$$x_prompt_for_section := TRUE; ! Ask user for a section file name eve$$x_section_default := ""; ! Default file specification for section file eve$$x_command_default := ""; ! Default file specification for command file eve$$x_attrs_array := create_array; ! Holds code to re-create attr. values eve$$x_display_array := create_array; ! Holds plain lanuage desc. of attr eve$$x_attrs_modified := FALSE; endprocedure; ! eve$$init_variables ! EVE$CORE.TPU Page 6 procedure eve$init_repeat ! Initialize the REPEAT variables ! To use the current repeat count, get the "last" index in the array ! eve$x_repeat_count. If the index is not tpu$k_unspecified, a valid ! repeat count exists at that index. Once finished with a repeat count, ! set that element to tpu$k_unspecified to stop any repetitions. ! Note: eve$x_repeat_count is EVE's special_error_symbol. If an error ! occurs that doesn't call eve$learn_abort, then TPU zeros the variable. ! This procedure must be called before doing another repeat operation ! or using the variable as an array. eve$x_repeat_count := create_array; ! Array of all repeat counts eve$x_repeat_types := create_array; ! Array of type of repeat (DO, LEARN, eve$x_repeat_types {0} := 0; ! KEYWORD for keys, 0 if none) eve$x_repeat_do := create_array; ! Array of indexes in ! eve$x_repeat_count for DO keys. endprocedure; ! eve$init_repeat ! EVE$CORE.TPU Page 7 procedure eve$restore_word_separators ! Use default word separators ! Use EVE's default word separators (assigned to eve$$kt_word_separators) ! Pass your separators enclosed in quotes. For example: ("()[]{}#$") ! You may call this procedure from your /COMMAND file, or from your ! /INITIALIZATION file. eve$$assign_word_separators (eve$$kt_word_separators) endprocedure; ! eve$restore_word_separators procedure eve$add_word_separators ! Add new word separators (new_separators) ! Pass your separators enclosed in quotes. For example: ("()[]{}#$") ! You may call this procedure from your /COMMAND file, or from your ! /INITIALIZATION file. eve$$assign_word_separators (eve$$x_word_separators + new_separators) endprocedure; ! eve$add_word_separators ! EVE$CORE.TPU Page 8 procedure eve$replace_word_separators ! Use new set of word separators (new_separators) ! Pass your separators enclosed in quotes. For example: ("()[]{}#$") ! You may call this procedure from your /COMMAND file, or from your ! /INITIALIZATION file. eve$$assign_word_separators (new_separators) endprocedure; ! eve$replace_word_separators procedure eve$read_word_separators ! Get current separators return (eve$$x_word_separators); endprocedure; ! eve$read_word_separators ! EVE$CORE.TPU Page 9 procedure eve$$assign_word_separators ! Assign new word separators (the_separators) ! new separators to use ! Description: ! Use new word separators by reassigning eve$$x_word_separators ! to the passed parameter, and reassigning eve$pattern_end_of_word. ! This procedure is necessary because TPU now evaluates pattern ! variables at assignment time, not search time (as in V1). ! Inputs: ! eve$$kt_word_separators = default separators (a constant) ! Outputs: ! eve$$x_word_separators = current separators ! eve$pattern_end_of_word = uses new separators ! assign the new separators eve$$x_word_separators := the_separators; ! assign the pattern variables that use the separators !eve$pattern_end_of_word := ! End of word ! The change for v3.1 caused poor performance for move by word ! (ANCHOR ! ! | (span (eve$x_whitespace) ! The following line was removed for V3.1 to treat non-whitespace word ! separators the same as whitespace separators. ! + (any (eve$$x_word_separators) | "")) ! ) ! + (LINE_END | span (eve$x_whitespace)) ! | any (eve$$x_word_separators) ! | scan (eve$$x_word_separators) ! | REMAIN) ! + (LINE_BEGIN | span (eve$x_whitespace) | ""); ! Replace with the following which fixes non-whitespace word separators ! being treated the same as whitespace separators: eve$pattern_end_of_word := ( ANCHOR + (LINE_END | ( SPAN (EVE$KT_WHITESPACE) ) ) | ANY (EVE$$X_WORD_SEPARATORS) | SCAN (EVE$$X_WORD_SEPARATORS) | REMAIN ) + (LINE_BEGIN | SPAN (EVE$KT_WHITESPACE) | ""); ! At the cursor position match: ! EOL or whitespace ! Or just a word separator ! Or a word without its separator ! Or rest of line ! Followed by optional (new line or white-space) endprocedure; ! eve$$assign_word_separators ! EVE$CORE.TPU Page 10 procedure eve$assign_whitespace ! Define whitespace (the_whitespace) ! Call this routine whenever you want to reassign EVE whitespace. ! It reassigns all pattern variables that have whitespace in their definition. eve$x_whitespace := the_whitespace; ! it is no longer a constant eve$pattern_empty_line := LINE_END + LINE_BEGIN + (LINE_END | (ascii (12) + LINE_END) | (ascii (12) + ascii (0) + LINE_END) | (span (eve$x_whitespace) + LINE_END)); eve$pattern_startprocedure := ! Start of a DECTPU procedure LINE_BEGIN + "procedure" + span (eve$x_whitespace); eve$pattern_endprocedure := ! End of a DECTPU procedure (LINE_BEGIN + "endprocedure") + (LINE_END | any (eve$x_whitespace) | any (";!")); eve$pattern_whitespace := ANCHOR + (span (eve$x_whitespace)); ! assign word separators to current values if get_info (eve$$x_word_separators, "type") = UNSPECIFIED then eve$$x_word_separators := eve$$kt_word_separators; endif; eve$$assign_word_separators (eve$$x_word_separators); eve$$x_ws_pat := "" + (span (eve$x_whitespace) | ((span (eve$x_whitespace) | "") + LINE_END + (span (eve$x_whitespace) | ""))); eve$x_wps_sentence_delimiters := ".!?"; eve$x_wps_pattern_sentence := any (eve$x_wps_sentence_delimiters) + (any (eve$x_whitespace) | LINE_END); endprocedure; ! eve$assign_whitespace ! EVE$CORE.TPU Page 11 procedure eve$$found_post_filter ! Remove the found range if moved ! If we've move off the found_range or the static (mouse) select_range, ! then remove it as well as the post-key procedure for the range's ! associated key_map_list. ! ! If neither range exists, then this procedure shouldn't have ! been called; in this case, remove all key_map_lists' post-key procedures ! equal to eve$$found_post_filter. local saved_mark, the_key_map_list, keep_filter; on_error if get_info (saved_mark, "type") = MARKER then position (saved_mark); endif; eve$$x_found_filter_active := FALSE; endon_error; ! insure someone else's post key filter is not calling us (no infinite loop) if eve$$x_found_filter_active ! paranoia check then return; endif; eve$$x_found_filter_active := TRUE; if (eve$x_found_range = 0) and (eve$x_select_position = 0) then ! Delete all key_map_list found post-key filters eve$$remove_post_filter (eve$$k_found_post_filter_id); else if get_info (eve$x_select_position, "type") = RANGE then if (current_buffer = get_info (eve$x_select_position, "buffer")) then saved_mark := mark (FREE_CURSOR); position (TEXT); ! allow for middle_of_tab ! see if cursor is outside the select range, and not on the ! char just outside the range where cursor was put if (not get_info (mark (NONE), "within_range", eve$x_select_position)) and (mark (NONE) <> eve$$x_adjusted_select_mark) then eve$clear_select_position; endif; position (saved_mark); ! need to be fast here endif; endif; if get_info (eve$x_found_range, "type") = RANGE then if (current_buffer = get_info (eve$x_found_range, "buffer")) then if not get_info (mark (FREE_CURSOR), "within_range", eve$x_found_range) then eve$$remove_found_range; endif; endif; endif; endif; eve$$x_found_filter_active := FALSE; endprocedure; ! eve$$found_post_filter ! EVE$CORE.TPU Page 12 procedure eve_change_mode ! Change insert/overstrike mode ! Toggle mode between insert and overstrike if get_info (current_buffer, "mode") = OVERSTRIKE then set (INSERT, current_buffer); else set (OVERSTRIKE, current_buffer); endif; eve$update_status_lines; return (TRUE); endprocedure; ! eve_change_mode ! EVE$CORE.TPU Page 13 procedure eve_set_find_whitespace ! Turn on space -> WS eve$$x_state_array {eve$$k_find_whitespace} := TRUE; eve$message (EVE$_FINDWHITE); return (TRUE); endprocedure; ! eve_set_find_whitespace procedure eve_set_find_nowhitespace ! Turn off space -> WS eve$$x_state_array {eve$$k_find_whitespace} := FALSE; eve$message (EVE$_FINDNOWHITE); return (TRUE); endprocedure; ! eve_set_find_nowhitespace ! EVE$CORE.TPU Page 14 procedure eve_find ! Find (target) ! String to find - input ! Top-level find command. ! Doesn't change direction after the find, but saves the found direction ! in eve$x_old_find_direction for a subsequent or FNDNXT. local status, how_exact, saved_direction, found_range; on_error [TPU$_CONTROLC]: if (saved_direction <> current_direction) and (get_info (saved_direction, "type") = KEYWORD) then set (saved_direction, current_buffer); endif; eve$learn_abort; abort; [OTHERWISE]: if (saved_direction <> current_direction) and (get_info (saved_direction, "type") = KEYWORD) then set (saved_direction, current_buffer); endif; endon_error; if current_window = eve$prompt_window then eve$learn_abort; return (FALSE); ! already a find(?) going on endif; if not eve$declare_intention (eve$k_action_reposition) then return (FALSE); endif; saved_direction := current_direction; status := eve$get_find_target (target, how_exact, 0); if status = eve$k_success then found_range := eve$find_target (how_exact, 0, 1); if found_range = eve$k_async_prompting then return (TRUE); ! wait for dialog box ok before changing direction else status := eve$remember_found (found_range); endif; else if status = eve$k_async_prompting then return (TRUE); ! wait for dialog box to supply target endif; endif; eve$x_old_find_direction := current_direction; set (saved_direction, current_buffer); if not status then eve$learn_abort; endif; return (status); endprocedure; ! eve_find ! EVE$CORE.TPU Page 15 procedure eve$find ! Backwards compatible eve$find (target, ! String to find - input replacing) ! 1 = called by eve_replace: allow a ! match at current cursor position and ! return if no string found ! 2 = called by wildcard_find ! 0 = called by eve_find ! EVE$FIND provided for compatibility with old EVE versions. Will change ! the current buffer's direction if the string was found in other direction. local found_string, status, how_exact, found_range; on_error [TPU$_CONTROLC]: eve$learn_abort; abort; [OTHERWISE]: endon_error; if current_window = eve$prompt_window then return (FALSE); ! already a find(?) going on endif; status := eve$get_find_target (target, how_exact, replacing, 1); if status = eve$k_async_prompting then return (TRUE); ! wait for dialog box to supply target else if not status then eve$learn_abort; return (status); endif; endif; found_range := eve$find_target (how_exact, replacing, 1, 1); if found_range = eve$k_async_prompting then return (found_range); ! wait for dialog box ok to change direction else if found_range = FALSE then return (found_range); ! eve$find_target did its own learn_abort endif; endif; return (found_range); endprocedure; ! eve$find ! EVE$CORE.TPU Page 16 procedure eve$$build_pattern ! Build a pattern for find (input_string, result_string, leading_whitespace) on_error [OTHERWISE]: endon_error; result_string := input_string; leading_whitespace := 0; return 0; endprocedure; ! eve$$build_pattern ! EVE$CORE.TPU Page 17 procedure eve$$build_space_pattern ! Build a pattern for whitespace (input_string, result_string, leading_whitespace) local the_char, the_string, ptr, saw_one; on_error [OTHERWISE]: endon_error; saw_one := FALSE; result_string := "'"; the_string := input_string; edit (the_string, COMPRESS, OFF); ptr := 1; if substr (the_string, ptr, 1) = " " then leading_whitespace := TRUE; saw_one := TRUE; ptr := ptr + 1; else leading_whitespace := FALSE; endif; loop exitif ptr > length (the_string); the_char := substr (the_string, ptr, 1); if the_char = "'" then the_char := "''"; else if the_char = " " then the_char := "'+eve$$x_ws_pat+'"; saw_one := TRUE; endif; endif; result_string := result_string + the_char; ptr := ptr + 1; endloop; if result_string = "'" then result_string := "eve$$x_ws_pat"; saw_one := TRUE; else result_string := result_string + "'"; endif; if not saw_one then result_string := the_string; endif; return saw_one; endprocedure; ! eve$$build_space_pattern ! EVE$CORE.TPU Page 18 procedure eve$search ! Search (including leading w/s) (the_target, ! \ the_direction, ! >-all as per the SEARCH built-in exactness, ! / leading_whitespace,! if true include all leading w/s replacing) ! if true allow a match at the current location ! 0 - FIND Skip current location ! 1 - REPLACE Allow a match here ! 2 - WILDCARD FIND Skip current location local the_range, on_range, saved_mark; on_error [TPU$_CONTROLC]: eve$$restore_position (saved_mark); eve$learn_abort; abort; [OTHERWISE]: eve$$restore_position (saved_mark); endon_error; saved_mark := mark (FREE_CURSOR); position (TEXT); ! snap cursor to text if get_info (eve$x_found_range, "type") = RANGE then if get_info (eve$x_found_range, "buffer") = current_buffer then on_range := TRUE; endif; endif; if on_range then if get_info (saved_mark, "within_range", eve$x_found_range) then if the_direction = FORWARD then position (end_of (eve$x_found_range)); move_horizontal (1); else position (beginning_of (eve$x_found_range)); if mark (NONE) <> beginning_of (current_buffer) then move_horizontal (-1); endif; endif; endif; else if the_direction = FORWARD then if mark (FREE_CURSOR) <> end_of (current_buffer) then if not replacing then move_horizontal (1); endif; endif; else if mark (FREE_CURSOR) <> beginning_of (current_buffer) then move_horizontal (-1); endif; endif; endif; loop the_range := search_quietly (the_target, the_direction, exactness); exitif the_range = 0; if leading_whitespace then position (the_range); exitif current_offset = 0; move_horizontal (-1); 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 (1); ! move back, not a whitespace char endif; the_range := create_range (mark (NONE), end_of (the_range), NONE); exitif; else move_horizontal (1); ! move back exitif; ! not whitespace char endif; else exitif 1; endif; endloop; if the_range <> 0 then eve$$x_saved_found_range := the_range; endif; position (saved_mark); return (the_range); endprocedure; ! eve$search ! EVE$CORE.TPU Page 19 procedure eve$remember_found ! Remember the search string (the_range) ! If a find succeeded, hilight the found range and associate a ! found_post_key "filter" procedure with the buffer's key_map_list. local the_key_map_list, same_buffer, old_filter; on_error [OTHERWISE]: endon_error; if (get_info (the_range, "type") = RANGE) then if get_info (eve$$x_found_post_filter, "type") <> PROGRAM then eve$$x_found_post_filter := compile ("eve$$found_post_filter"); endif; ! Remove the found_range and associated filter if the found_range ! is in a buffer with a key_map_list different from the current_buffer's ! (filters are tied to key_map_lists which are tied to buffers) if get_info (eve$x_found_range, "type") = RANGE then if get_info (current_buffer, "key_map_list") <> get_info (get_info (eve$x_found_range, "buffer"), "key_map_list") then eve$$remove_found_range; else same_buffer := TRUE; endif; endif; eve$x_found_range := create_range (beginning_of (the_range), end_of (the_range), eve$x_found_highlighting); ! Add the found filter to the command/mouse/user k_m_l's post-key procedure if not same_buffer ! insure filters aren't already set then the_key_map_list := get_info (get_info (eve$x_found_range, "buffer"), "key_map_list"); if current_window = eve$command_window then eve$set_key_procedure (FALSE, eve$x_command_key_map_list, eve$$x_found_post_filter, eve$$k_found_post_filter_id); else eve$set_key_procedure (FALSE, the_key_map_list, eve$$x_found_post_filter, eve$$k_found_post_filter_id); endif; eve$set_key_procedure (FALSE, eve$x_mouse_list, eve$$x_found_post_filter, eve$$k_found_post_filter_id); endif; return TRUE; else eve$$remove_found_range; return FALSE; endif; endprocedure; ! eve$remember_found ! EVE$CORE.TPU Page 20 procedure eve$$remove_found_range ! Cancel found range (& remove filter) ! The cursor has moved out of the found_range. Appropriately remove the ! found_post_key "filter" procedure from the key_map_lists ! associated with eve$x_found_range, command buffer, and mouse windows. local old_filter, the_key_map_list; on_error [OTHERWISE]: endon_error; if get_info (eve$x_found_range, "type") = RANGE then the_key_map_list := get_info (get_info (eve$x_found_range, "buffer"), "key_map_list"); endif; eve$x_found_range := 0; ! No other procedures should make this assignment ! (except initialization) if (eve$x_select_position = 0) and (the_key_map_list <> 0) then ! delete the found post filter if current_window = eve$command_window then eve$set_key_procedure (FALSE, eve$x_command_key_map_list, 0, eve$$k_found_post_filter_id); else eve$set_key_procedure (FALSE, the_key_map_list, 0, eve$$k_found_post_filter_id); endif; eve$set_key_procedure (FALSE, eve$x_mouse_list, 0, eve$$k_found_post_filter_id); endif; return TRUE; endprocedure; ! eve$$remove_found_range ! EVE$CORE.TPU Page 21 procedure eve$$remove_post_filter ! Remove a post-key filter (filter_id) ! the post-key filter identifier (usually of type integer) ! Delete the specified post-key "filter" procedure from all key_map_lists. ! Called by eve$$found_post_filter when eve$x_found_range is not a range. local the_key_map_list; on_error [OTHERWISE]: endon_error; the_key_map_list := get_info (KEY_MAP_LIST, "first"); loop exitif the_key_map_list = 0; eve$set_key_procedure (FALSE, the_key_map_list, 0, filter_id); the_key_map_list := get_info (KEY_MAP_LIST, "next"); endloop; return (TRUE); endprocedure; ! eve$$remove_post_filter ! EVE$CORE.TPU Page 22 procedure eve$get_find_target ! Find subprocedure (target, how_exact, replacing; ! Set up for a find. ! If , use the direction in eve$x_old_find_direction; ! otherwise, use the buffer's current direction (OR the direction specified ! by a direction-changing terminator that terminates the find prompt). ! Parameters: ! target String to find - input + output ! how_exact eve$x_find_exact or eve$x_find_no_exact - output ! replacing 1 = called by eve_replace: allow a ! match at current cursor position and ! return if no string found ! 2 = called by wildcard_find ! 0 = called by a find procedure - input ! old_find 1 = called by eve$find - optional input old_find) local new_target, ! Local copy of target return_value, ! Value returned by eve$$build_pattern start_find_key, ! String describing key used to invoke find stop_find_key, ! String describing key used after prompt leading_whitespace, ! Boolean for including leading whitespace status, ! Status from set (widget) result, ! Result returned from eve$$test_find_terminator the_prompt, ! Prompt string execute_it, ! Boolean to execute eve$x_target_pattern prefix, ! Execute arg postfix, ! Execute arg key_is_defined, ! Boolean for key press = "FIND xxx" saved_direction; ! Direction upon entry on_error [TPU$_CONTROLC]: if (saved_direction <> current_direction) and (get_info (saved_direction, "type") = KEYWORD) then set (saved_direction, current_buffer); endif; eve$learn_abort; abort; [OTHERWISE]: if (saved_direction <> current_direction) and (get_info (saved_direction, "type") = KEYWORD) then set (saved_direction, current_buffer); endif; endon_error; saved_direction := current_direction; start_find_key := last_key; if start_find_key <> 0 then if eve$test_synonym ("return", eve$$lookup_comment (start_find_key, "")) then start_find_key := DO; endif; endif; if replacing = 1 then eve$$remove_found_range; endif; eve$clear_message; if target <> "" then new_target := target; if start_find_key <> 0 then eve$$test_find_terminator (last_key); ! possibly change direction endif; else loop if current_direction = FORWARD then if replacing <> 2 ! <> wildcard find then if current_direction = eve$x_old_find_direction then the_prompt := message_text (EVE$_FINDPROMPT, 1); else 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 the_prompt := message_text (EVE$_FINDPROMPT, 1); else the_prompt := message_text (EVE$_FINDPROMPT2, 1); endif; endif; else if current_direction = eve$x_old_find_direction then the_prompt := message_text (EVE$_WILDFINDPROMPT, 1); else 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 the_prompt := message_text (EVE$_WILDFINDPROMPT, 1); else the_prompt := message_text (EVE$_WILDFINDPROMPT2, 1); endif; endif; endif; else if replacing <> 2 ! <> wildcard find then if current_direction = eve$x_old_find_direction then the_prompt := message_text (EVE$_REVPROMPT, 1); else 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 the_prompt := message_text (EVE$_REVPROMPT, 1); else the_prompt := message_text (EVE$_REVPROMPT2, 1); endif; endif; else if current_direction = eve$x_old_find_direction then the_prompt := message_text (EVE$_WILDREVPROMPT, 1); else 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 the_prompt := message_text (EVE$_WILDREVPROMPT, 1); else the_prompt := message_text (EVE$_WILDREVPROMPT2, 1); endif; 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}) then ! supersede the program bound to the find_ok button ! (cant call eve$get_find_target cause data expected from widget) %if eve$x_option_decwindows %then if eve$x_decwindows_active then if replacing = 2 ! = wildcard find then if get_info (eve$x_wildcard_find_dialog, "type") <> WIDGET then eve$x_wildcard_find_dialog := eve$create_widget ("WILDCARD_FIND_DIALOG"); endif; if old_find = tpu$k_unspecified then eve$$set_responder (eve$$k_wildcard_find_ok, fao ("eve$$widget_find_ok (!UL)", replacing)); else eve$$set_responder (eve$$k_wildcard_find_ok, fao ("eve$$widget_find_ok (!UL, !UL)", replacing, old_find)); endif; status := set (WIDGET, get_info (WIDGET, "widget_id", eve$x_wildcard_find_dialog, "WILDCARD_FIND_DIALOG.WILDCARD_FIND_LABEL" ), eve$x_resource_array {eve$k_nlabel}, the_prompt); status := set (WIDGET, get_info (WIDGET, "widget_id", eve$x_wildcard_find_dialog, "WILDCARD_FIND_DIALOG.WILDCARD_FIND_LABEL1" ), eve$x_resource_array {eve$k_nlabel}, message_text (EVE$_CURRENTWILD, 1, eve$$x_wild_patterns)); if get_info (eve$x_target, "type") = STRING then status := set (TEXT, get_info (WIDGET, "widget_id", eve$x_wildcard_find_dialog, "WILDCARD_FIND_DIALOG.WILDCARD_FIND_TEXT" ), eve$x_target); else status := set (TEXT, get_info (WIDGET, "widget_id", eve$x_wildcard_find_dialog, "WILDCARD_FIND_DIALOG.WILDCARD_FIND_TEXT" ), eve$x_printable_target); endif; eve$manage_widget (eve$x_wildcard_find_dialog); else if get_info (eve$x_find_dialog, "type") <> WIDGET then eve$x_find_dialog := eve$create_widget ("FIND_DIALOG"); endif; if old_find = tpu$k_unspecified then eve$$set_responder (eve$$k_find_ok, fao ("eve$$widget_find_ok (!UL)", replacing)); else eve$$set_responder (eve$$k_find_ok, fao ("eve$$widget_find_ok (!UL, !UL)", replacing, old_find)); endif; status := set (WIDGET, get_info (WIDGET, "widget_id", eve$x_find_dialog, "FIND_DIALOG.FIND_LABEL"), eve$x_resource_array {eve$k_nlabel}, the_prompt); if get_info (eve$x_target, "type") = STRING then status := set (TEXT, get_info (WIDGET, "widget_id", eve$x_find_dialog, "FIND_DIALOG.FIND_TEXT"), eve$x_target); else status := set (TEXT, get_info (WIDGET, "widget_id", eve$x_find_dialog, "FIND_DIALOG.FIND_TEXT"), eve$x_printable_target); endif; eve$manage_widget (eve$x_find_dialog); endif; endif; %endif return (eve$k_async_prompting); else new_target := eve$prompt_line (the_prompt, eve$$x_find_terminators); if new_target = 0 then return (FALSE); endif; ! Test the terminator, and change direction if it's ! a direction-setting terminator. if start_find_key <> 0 then result := eve$$test_find_terminator (last_key); else result := 0; endif; ! stay in loop if just a direction-setting key were pressed exitif not ((new_target = "") and (result)); endif; endloop; endif; if start_find_key <> 0 then stop_find_key := last_key; endif; if new_target = "" then ! allow both and ! (as well as wildcard versions) if start_find_key <> 0 then if (start_find_key = stop_find_key) or (eve$test_synonym ("find", eve$$lookup_comment (stop_find_key, ""))) then if eve$x_target = "" then eve$message (EVE$_NOPREVTARG); return (0); else ! use the direction for the prior set (eve$x_old_find_direction, current_buffer); if get_info (eve$x_target, "type") = STRING then eve$message (EVE$_FINDPREV, 0, eve$x_target); else eve$message (EVE$_FINDPREVWILD, 0, eve$x_printable_target); endif; endif; else eve$message (EVE$_NOFIND); return (0); ! let caller set direction back if needed endif; else eve$message (EVE$_NOFIND); return (0); ! let caller set direction back if needed endif; else ! restore eve$$k_find_ok widget to invalid_event program %if eve$x_option_decwindows %then if eve$x_decwindows_active then if replacing = 2 ! = wildcard find then eve$$set_responder (eve$$k_wildcard_find_ok, "eve$invalid_event(" + str (eve$$k_wildcard_find_ok) + ")"); else eve$$set_responder (eve$$k_find_ok, "eve$invalid_event(" + str (eve$$k_find_ok) + ")"); endif; endif; %endif ! insure a key = "FIND xxx" will always do a find next if start_find_key <> 0 then if (eve$$x_state_array {eve$$k_command_line_flag} = eve$k_invoked_by_key) and (start_find_key = stop_find_key) and (target <> "") then if (((get_info (eve$x_target, "type") = STRING) and (eve$x_target = target)) or ((get_info (eve$x_target, "type") = PATTERN) and (eve$x_printable_target = target))) then set (eve$x_old_find_direction, current_buffer); key_is_defined := TRUE; endif; endif; endif; if not key_is_defined then if replacing = 2 then return_value := eve$$build_pattern (new_target, eve$x_target_pattern, leading_whitespace); if get_info (return_value, "type") = KEYWORD then ! (keyword means an error occurred) return (0); ! let caller set direction back if needed else if return_value ! eve$x_target_pattern is pattern string, e.g., then ! "\" = bol + abcd + eol execute_it := TRUE; else ! eve$x_target_pattern is a search string eve$x_target := eve$x_target_pattern; endif; endif; else if get_info (new_target, "type") = STRING then if eve$$x_state_array {eve$$k_find_whitespace} then if eve$$build_space_pattern (new_target, eve$x_target_pattern, leading_whitespace) then ! spaces in new_target execute_it := TRUE; else ! no spaces in new_target eve$x_target := eve$x_target_pattern; endif; else eve$x_target := new_target; endif; else execute_it := TRUE; endif; endif; if execute_it ! create a pattern variable for wildcard/whitespace then prefix := "return("; postfix := ")"; if length (eve$x_target_pattern) > (256 - length (prefix) - length (postfix)) then eve$message (EVE$_TARGETTOOBIG); return (FALSE); endif; eve$x_target := execute (prefix + eve$x_target_pattern + postfix); endif; if get_info (new_target, "type") = STRING then eve$x_printable_target := new_target; endif; eve$$x_state_array {eve$$k_leading_whitespace} := leading_whitespace; endif; endif; eve$set_find_target_case (how_exact); return (TRUE); ! let caller set direction back if needed endprocedure; ! eve$get_find_target ! EVE$CORE.TPU Page 23 procedure eve$set_find_target_case ! Set target's case exactness (how_exact) ! EVE's FIND is case-sensitive unless (1) sensitivity has been ! set to noexact, and (2) the target is all lowercase, in which ! case the search is case-insensitive. local lowercase_target, ! Lowercase version of eve$x_target the_target; if get_info (eve$x_target, "type") = STRING then lowercase_target := eve$x_target; else lowercase_target := eve$x_target_pattern; endif; the_target := lowercase_target; change_case (lowercase_target, LOWER); how_exact := eve$x_find_exact; if not eve$get_find_case_sensitivity then if lowercase_target = the_target then how_exact := eve$x_find_no_exact; endif; endif; return (TRUE); endprocedure; ! eve$set_find_target_case ! EVE$CORE.TPU Page 24 procedure eve$find_target ! Find subprocedure (how_exact, replacing, move_flag; old_find) ! Search for eve$x_target in the current direction. If not found in the ! current direction look in the opposite direction, but do not go ! there without prompting the user. ! Returns range if eve$x_target found, otherwise returns false. ! ! Parameters: ! how_exact eve$x_find_exact or eve$x_find_no_exact - input ! replacing 1 = called by eve_replace: allow a ! match at current cursor position and ! return if no string found ! 2 = called by wildcard_find ! 0 = called by eve_find - input ! move_flag 1 = position to found string ! 0 = don't position to found string - input ! old_find 1 = called by eve$find - optional input local saved_mark, ! Marker for current cursor position text_mark, ! Marker for current text position other_direction, ! Keyword for opposite direction find_range, ! Range returned by search status, ! Result of set (widget) leading_whitespace, ! Boolean for including leading whitespace the_prompt, ! Prompt for going in other direction find_reply, ! Reply to inquiry about changing direction change_direction_key, ! Keyword for key used to end find_reply saved_direction; ! Direction upon entry on_error [TPU$_CONTROLC]: if (saved_direction <> current_direction) and (get_info (saved_direction, "type") = KEYWORD) then set (saved_direction, current_buffer); endif; eve$$restore_position (saved_mark); eve$learn_abort; abort; [OTHERWISE]: if (saved_direction <> current_direction) and (get_info (saved_direction, "type") = KEYWORD) then set (saved_direction, current_buffer); endif; eve$$restore_position (saved_mark); endon_error; saved_direction := current_direction; saved_mark := mark (FREE_CURSOR); ! mark original position position (TEXT); ! snap cursor to text text_mark := mark (NONE); if current_direction = FORWARD then if saved_mark <> end_of (current_buffer) then find_range := eve$search (eve$x_target, FORWARD, how_exact, eve$$x_state_array {eve$$k_leading_whitespace}, replacing); else find_range := 0; endif; else if saved_mark <> beginning_of (current_buffer) then find_range := eve$search (eve$x_target, REVERSE, how_exact, eve$$x_state_array {eve$$k_leading_whitespace}, replacing); else find_range := 0; endif; endif; if find_range = 0 ! didn't find in original direction then if replacing = 1 then position (saved_mark); return (FALSE); else if learn_abort ! Don't look in opposite dir if in LEARN SEQ then eve$message (EVE$_FINDFAIL); eve$message (EVE$_LEARNABORTBIG); position (saved_mark); return (FALSE); endif; if current_direction = FORWARD then other_direction := REVERSE; else other_direction := FORWARD; endif; position (text_mark); ! go back to original text if other_direction = FORWARD ! and look in other direction then if saved_mark <> end_of (current_buffer) then find_range := eve$search (eve$x_target, FORWARD, how_exact, eve$$x_state_array {eve$$k_leading_whitespace}, replacing); else find_range := 0; endif; else if saved_mark <> beginning_of (current_buffer) then find_range := eve$search (eve$x_target, REVERSE, how_exact, eve$$x_state_array {eve$$k_leading_whitespace}, replacing); else find_range := 0; endif; endif; if find_range = 0 then ! couldn't find in other direction either - give up if get_info (eve$x_target, "type") = STRING then eve$message (EVE$_STRNOTFOUND, 0, eve$x_target); else eve$message (EVE$_STRNOTFOUND, 0, eve$x_printable_target); endif; position (saved_mark); return (0); else if other_direction = FORWARD then ! found in other direction, go there? the_prompt := message_text (EVE$_FOUNDFORWARD, 1); else the_prompt := message_text (EVE$_FOUNDREVERSE, 1); 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 ! supersede the program bound to the find_occurrence_yes button ! (cant call eve$find_target, because many procedures call ! eve$find_target) %if eve$x_option_decwindows %then if eve$x_decwindows_active then if old_find = tpu$k_unspecified then eve$$set_responder (eve$$k_find_each_yes, fao ("eve$$widget_find_each_yes (!UL, !UL, !UL)", replacing, move_flag, (other_direction = FORWARD))); else eve$$set_responder (eve$$k_find_each_yes, fao ("eve$$widget_find_each_yes " + "(!UL, !UL, !UL, !UL)", replacing, move_flag, (other_direction = FORWARD), old_find)); endif; if get_info (eve$x_find_each_dialog, "type") <> WIDGET then eve$x_find_each_dialog := eve$create_widget ("FIND_EACH_DIALOG"); endif; status := set (WIDGET, get_info (WIDGET, "widget_id", eve$x_find_each_dialog, "FIND_EACH_DIALOG.FIND_EACH_LABEL") , eve$x_resource_array {eve$k_nlabel}, the_prompt); eve$manage_widget (eve$x_find_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 position (saved_mark); return (FALSE); 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 ("return", change_direction_key)) or (eve$test_synonym ("do", change_direction_key)) then find_reply := eve$x_yes; else find_reply := eve$x_no; endif; else edit (find_reply, TRIM, LOWER, OFF); endif; if substr (eve$x_yes, 1, length (find_reply)) = find_reply then set (other_direction, current_buffer); if move_flag then eve$position_in_middle (beginning_of (find_range)); endif; return (find_range); else position (saved_mark); return (0); endif; endif; endif; endif; else %if eve$x_option_decwindows %then if eve$x_decwindows_active then eve$$set_responder (eve$$k_find_each_yes, "eve$invalid_event(" + str (eve$$k_find_each_yes) + ")"); endif; %endif if move_flag then eve$position_in_middle (beginning_of (find_range)); endif; return (find_range); endif; endprocedure; ! eve$find_target ! EVE$CORE.TPU Page 25 procedure eve_find_next ! FIND NEXT command local status, no_find_yet; ! Set if no find has completed yet ! Require Command: find "next" to find string = "next" status := eve$find_next (no_find_yet); if no_find_yet then eve$message (EVE$_NOPREVTARG); endif; return (status); endprocedure; ! eve_find_next procedure eve$find_next ! Find next occurrence (; no_find_yet) ! set true if no FIND has completed, and ! return false - optional output arg ! Find the next occurrence of the find string using the ! direction saved in eve$x_old_find_direction instead of the buffer's ! current direction. local status, saved_direction; on_error [TPU$_CONTROLC]: if (saved_direction <> current_direction) and (get_info (saved_direction, "type") = KEYWORD) then set (saved_direction, current_buffer); endif; eve$learn_abort; abort; [OTHERWISE]: if (saved_direction <> current_direction) and (get_info (saved_direction, "type") = KEYWORD) then set (saved_direction, current_buffer); endif; endon_error; if not eve$declare_intention (eve$k_action_reposition) then return (FALSE); endif; saved_direction := current_direction; if eve$x_target = "" ! Has a FIND been completed? then no_find_yet := TRUE; return (FALSE); endif; set (eve$x_old_find_direction, current_buffer); status := eve_find (eve$x_target); set (saved_direction, current_buffer); return (status); endprocedure; ! eve$find_next ! EVE$CORE.TPU Page 26 procedure eve_find_selected ! Find current selection ! Find the current selection. local the_range, ! the selection the_buffer, ! buffer containing the selection saved_mark, ! current position saved_box_flag, select_string; ! the string value of the selection on_error [OTHERWISE]: eve$x_box_select_flag := saved_box_flag; eve$$restore_position (saved_mark); endon_error; saved_box_flag := eve$x_box_select_flag; saved_mark := mark (FREE_CURSOR); ! position to the buffer containing the selection/found range if eve$x_select_position <> 0 then the_buffer := get_info (eve$x_select_position, "buffer"); if the_buffer <> current_buffer then position (the_buffer); endif; else if eve$x_box_array <> 0 then eve$x_box_select_flag := TRUE; ! force box to be chosen the_buffer := get_info (eve$x_box_array {0}, "buffer"); if the_buffer <> current_buffer then position (the_buffer); endif; else if get_info (eve$x_found_range, "type") = RANGE then the_buffer := get_info (eve$x_found_range, "buffer"); if the_buffer <> current_buffer then position (the_buffer); endif; endif; endif; endif; the_range := eve$selection (TRUE, ! allow messages TRUE, ! use found range TRUE, ! use global select TRUE, ! extend null ranges TRUE, ! cancel EVE's selection TRUE); ! will take a box selection eve$x_box_select_flag := saved_box_flag; position (saved_mark); if the_range = 0 then eve$learn_abort; return (FALSE); else ! Reject multi-line select ranges. Multi-line global selections (strings) ! contain LF's for linebreaks, which will not likely be found. select_string := the_range; if get_info (the_range, "type") = RANGE then if get_info (beginning_of (the_range), "record_number") <> get_info (end_of (the_range), "record_number") then eve$message (EVE$_FINDMULTILINE); eve$learn_abort; return (FALSE); endif; select_string := str (the_range); else if get_info (the_range, "type") = ARRAY then ! box selection if get_info (the_range, "last") > 1 then ! {0}=marker, {1}=range of box selection eve$message (EVE$_FINDMULTILINE); eve$learn_abort; return (FALSE); endif; select_string := str (the_range {1}); eve$clear_select_position; endif; endif; return (eve_find (select_string)); ! cancels found range but not selection endif; endprocedure; ! eve_find_selected ! EVE$CORE.TPU Page 27 procedure eve_set_find_case_exact ! make searches case exact eve$set_find_case_sensitivity (TRUE); eve$message (EVE$_FINDEXACT); return (TRUE); endprocedure; ! eve_set_find_case_exact procedure eve_set_find_case_noexact ! make searches not case exact eve$set_find_case_sensitivity (FALSE); eve$message (EVE$_FINDNOEXACT); return (TRUE); endprocedure; ! eve_set_find_case_noexact ! EVE$CORE.TPU Page 28 procedure eve$set_find_case_sensitivity ! Set FIND case sensitivity (switch) if switch = TRUE then eve$$x_state_array {eve$$k_find_case_exact} := TRUE; return (eve$define_attr ("eve$set_find_case_sensitivity", "eve$set_find_case_sensitivity (true);", message_text (EVE$_FINDEXACT))); else if switch = FALSE then eve$$x_state_array {eve$$k_find_case_exact} := FALSE; return (eve$define_attr ("eve$set_find_case_sensitivity", "eve$set_find_case_sensitivity (false);", message_text (EVE$_FINDNOEXACT))); endif; endif; endprocedure; ! eve$set_find_case_sensitivity procedure eve$get_find_case_sensitivity ! Return FIND's sensitivity setting return (eve$$x_state_array {eve$$k_find_case_exact}); endprocedure; ! eve$get_find_case_sensitivity ! EVE$CORE.TPU Page 29 procedure eve$set_diacritical_sensitivity ! Set FIND diacritical sens. (switch) ! Set flag for FIND's diacritical sensitivity, and modify global variables ! accordingly (for exact/no_exact case settings and diacritical setting). if switch = TRUE then eve$$x_state_array {eve$$k_find_diacritical} := TRUE; eve$x_find_diacritical := tpu$k_search_diacritical; else if switch = FALSE then eve$$x_state_array {eve$$k_find_diacritical} := FALSE; eve$x_find_diacritical := 0; endif; endif; eve$x_find_exact := tpu$k_search_case or eve$x_find_diacritical; eve$x_find_no_exact := eve$x_find_diacritical; endprocedure; ! eve$set_diacritical_sensitivity procedure eve$get_diacritical_sensitivity ! Get FIND diacritical sens. ! Return FIND's diacritical sensitivity setting return (eve$$x_state_array {eve$$k_find_diacritical}); endprocedure; ! eve$get_diacritical_sensitivity ! EVE$CORE.TPU Page 30 procedure eve$$test_find_terminator ! Test if must change direction (the_key) ! key for test !+ ! Description ! See if the_key is one of the keys whose definition comment is contained in ! eve$kt_find_/direction/_keys ! E.G., eve$x_find_forward_keys := " advance forward " ! E.G., eve$x_find_reverse_keys := " backup reverse " ! Returned value ! false = the_key is not one of the find terminators ! true = the_key is one of the find terminators, and the direction ! is now set per that terminator (it may not have changed) !- local facility, legend, topic; on_error [OTHERWISE]: endon_error; if (eve$$x_state_array {eve$$k_command_line_flag} = eve$k_invoked_by_menu) then return (FALSE); endif; eve$$parse_comment (the_key, "", facility, legend, topic); if topic = "" then return FALSE; endif; edit (topic, LOWER, OFF); if eve$test_terminator (eve$$x_find_toggle_keys, topic) then ! It's a change-the-direction terminator (F11) if current_direction = FORWARD then set (REVERSE, current_buffer); else set (FORWARD, current_buffer); endif; return (TRUE); endif; if current_direction = REVERSE then if eve$test_terminator (eve$$x_find_reverse_keys, topic) then return (TRUE); ! already in reverse, just return true else ! do we need to change to forward? if not eve$test_terminator (eve$$x_find_forward_keys, topic) then return (FALSE); else set (FORWARD, current_buffer); return (TRUE); endif; endif; else if eve$test_terminator (eve$$x_find_forward_keys, topic) then return (TRUE); ! already in forward, just return true else ! do we need to change to reverse? if not eve$test_terminator (eve$$x_find_reverse_keys, topic) then return (FALSE); else set (REVERSE, current_buffer); return (TRUE); endif; endif; endif; endprocedure; ! eve$$test_find_terminator ! EVE$CORE.TPU Page 31 procedure eve$on_end_of_line ! Test if at eol if mark (NONE) <> end_of (current_buffer) then if current_character <> "" ! eol = "" then return (FALSE); endif; endif; return (TRUE); endprocedure; ! eve$on_end_of_line ! EVE$CORE.TPU Page 32 procedure eve_return ! The RETURN key procedure ! Procedure invoked by the Return key. Split the current line. ! Does NOT fill the line that it terminates. local temp, use_paragraph_indent, saved_left_margin; on_error [TPU$_CONTROLC]: if saved_left_margin <> 0 then set (LEFT_MARGIN, current_buffer, saved_left_margin); endif; eve$learn_abort; abort; [OTHERWISE]: if saved_left_margin <> 0 then set (LEFT_MARGIN, current_buffer, saved_left_margin); endif; endon_error; if not eve$declare_intention (eve$k_action_split_line) then return (FALSE); endif; position (TEXT); ! snap cursor to text if current_window = eve$command_window then eve$$exit_command_window; else if current_buffer = eve$x_bufed_buffer then return (eve_select); endif; if (eve$$x_paragraph_indent {current_buffer} <> tpu$k_unspecified) then if (mark (NONE) <> end_of (current_buffer)) then temp := current_line; edit (temp, TRIM, OFF); use_paragraph_indent := (length (temp) = 0); else use_paragraph_indent := FALSE; endif; else use_paragraph_indent := FALSE; endif; if use_paragraph_indent then saved_left_margin := get_info (current_buffer, "left_margin"); set (LEFT_MARGIN, current_buffer, eve$$x_paragraph_indent {current_buffer}); eve$split_line; eve$show_first_line; set (LEFT_MARGIN, current_buffer, saved_left_margin); else eve$split_line; eve$show_first_line; endif; endif; return (TRUE); endprocedure; ! eve_return ! EVE$CORE.TPU Page 33 ! Hooks for BufEd procedure eve$$bufed_select ! Dummy BufEd routine return (TRUE); endprocedure; ! eve$$bufed_select procedure eve$$bufed_remove ! Dummy BufEd routine return (TRUE); endprocedure; ! eve$$bufed_remove ! EVE$CORE.TPU Page 34 procedure eve_select ! SELECT on_error [OTHERWISE]: ! user may have done own SELECT endon_error; if current_buffer = eve$x_bufed_buffer then if eve$$bufed_select then return (TRUE); else eve$learn_abort; return (FALSE); endif; else if current_window = eve$choice_window then return (eve$$select_choice); else if not eve$declare_intention (eve$k_action_selection) then return (FALSE); endif; ! Cancel active selection (normal or box) if (eve$x_select_position <> 0) or (eve$x_box_array <> 0) then eve$clear_select_position; eve$message (EVE$_SELCAN); return (TRUE); endif; if eve$x_box_select_flag then ! start a box selection if not eve$$box_select then return (FALSE); endif; eve$message (EVE$_BOXSELSTART); else ! start a normal selection eve$x_select_position := select (eve$x_highlighting); eve$message (EVE$_SELSTART); endif; %if eve$x_option_decwindows %then ! grab the primary selection if eve$x_decwindows_active then set (GLOBAL_SELECT, SCREEN, PRIMARY); endif; %endif endif; endif; eve$start_pending_delete; ! arm pending delete return (TRUE); endprocedure; ! eve_select ! EVE$CORE.TPU Page 35 procedure eve$$select_choice ! Select logic for choices window local choice_string, choice_column, start_mark; if mark (FREE_CURSOR) = end_of (current_buffer) then eve$$x_chosen_range := 0; eve$message (EVE$_NOITEMSELECTED); return (FALSE); endif; choice_column := (((current_column - 2) / eve$$x_choices_column_width) * eve$$x_choices_column_width) + 2; choice_string := substr (current_line, choice_column, eve$$x_choices_column_width - 1); edit (choice_string, TRIM); if choice_string = "" then eve$$x_chosen_range := 0; eve$message (EVE$_NOITEMSELECTED); return (FALSE); else position (LINE_BEGIN); move_horizontal (choice_column - 1); start_mark := mark (NONE); move_horizontal (length (choice_string) - 1); eve$$x_chosen_range := create_range (start_mark, mark (NONE), eve$x_choice_highlighting); position (eve$$x_choice_range); set (RECORD_ATTRIBUTE, mark (NONE), MODIFIABLE, ON); erase (eve$$x_choice_range); eve$$x_choice_range := copy_text (eve$$x_chosen_range); position (eve$choice_window); return (TRUE); endif; endprocedure; ! eve$$select_choice ! EVE$CORE.TPU Page 36 procedure eve$select_a_range ! make range become the selection (arg_1; arg_2) local saved_mark, start_mark, end_mark, the_highlighting, old_filter; on_error [TPU$_CONTROLC]: eve$$restore_position (saved_mark); eve$learn_abort; abort; [OTHERWISE]: eve$$restore_position (saved_mark); eve$learn_abort; endon_error; saved_mark := mark (FREE_CURSOR); if eve$x_box_select_flag then the_highlighting := eve$x_box_highlighting; else the_highlighting := eve$x_highlighting; endif; case get_info (arg_1, "type") [INTEGER]: eve$clear_select_position; return (FALSE); [RANGE]: start_mark := beginning_of (arg_1); end_mark := end_of (arg_1); ! grab the primary selection and start/modify the select range if eve$x_decwindows_active then set (GLOBAL_SELECT, SCREEN, PRIMARY); endif; eve$x_select_position := create_range (start_mark, end_mark, the_highlighting); [MARKER]: if get_info (arg_2, "type") <> MARKER then eve$message (TPU$_INVPARAM, 0, 2, "", str (get_info (arg_2, "type")), "", "MARKER"); eve$learn_abort; return (FALSE); else if not get_info (arg_1, "bound") then position (arg_1); start_mark := mark (NONE); else start_mark := arg_1; endif; if not get_info (arg_2, "bound") then position (arg_2); end_mark := mark (NONE); else end_mark := arg_2; endif; ! grab the primary selection and start/modify the select range if eve$x_decwindows_active then set (GLOBAL_SELECT, SCREEN, PRIMARY); endif; if get_info (eve$x_select_position, "type") = RANGE then modify_range (eve$x_select_position, start_mark, end_mark); else eve$x_select_position := create_range (start_mark, end_mark, the_highlighting); endif; endif; [OTHERWISE]: eve$clear_select_position; return (FALSE); endcase; ! eve$x_select_position must be a range and start_mark/end_mark its start/end ! Move cursor 1 char past the last character in forward ! direction, and include that last character in the select ! range (this differs from if mark (NONE) <> end_of (current_buffer) then ! extend_null_range = true (default) makes 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 possible_selection := create_range (mark (NONE), mark (NONE), NONE); else return (NONE); ! indicate ) ! eve$x_box_select_flag: true asks for box select range (array of ranges) if the_range = tpu$k_unspecified then remove_range := eve$selection (TRUE,,, eve$x_select_remove_flag,, TRUE); ! will take a box selection else remove_range := the_range; endif; if remove_range <> 0 then ! make the_paste_buffer modifiable in case it contains unmodifiable ! records from the last paste operation. set (RECORD_ATTRIBUTE, create_range (beginning_of (the_paste_buffer), end_of (the_paste_buffer), NONE), MODIFIABLE, ON); erase (the_paste_buffer); if remove_range <> NONE then if get_info (remove_range, "type") = ARRAY then return (eve$$box_cut (remove_range, the_paste_buffer, delete_range, output_messages)); endif; saved_mark := mark (NONE); ! OK to pad now position (the_paste_buffer); if delete_range then move_text (remove_range); the_message := EVE$_REMCOMPL; else copy_text (remove_range); the_message := EVE$_COPYCOMPL; endif; if output_messages then eve$message (the_message); endif; if mark (NONE) = end_of (the_paste_buffer) then split_line; endif; position (saved_mark); else eve$clear_message; ! cancel the eve$_selstart message endif; remove_range := 0; return (TRUE); endif; eve$learn_abort; return (FALSE); endprocedure; ! eve$$store_remove ! EVE$CORE.TPU Page 48 procedure eve_insert_here ! INSERT HERE ! Copy contents of insert here buffer before current cursor position if not eve$declare_intention (eve$k_action_paste) then return (FALSE); endif; ! If DECwindows is active then INSERT_HERE/PASTE comes from the clipboard %if eve$x_option_decwindows %then if eve$$x_state_array {eve$$k_clipboard} then return (eve$$insert_clipboard); endif; %endif return (eve$$insert_here (paste_buffer)); endprocedure; ! eve_insert_here ! EVE$CORE.TPU Page 49 procedure eve$$insert_here ! Insert text here (the_paste_buffer) local line_left_margin; on_error [OTHERWISE]: eve$learn_abort; endon_error; if eve$test_if_modifiable (current_buffer) then if beginning_of (the_paste_buffer) <> end_of (the_paste_buffer) then if current_offset = 0 then if mark (FREE_CURSOR) <> end_of (current_buffer) then ! remember to honor this line's left margin line_left_margin := get_info (mark (FREE_CURSOR), "left_margin"); else line_left_margin := get_info (current_buffer, "left_margin"); endif; endif; if eve$x_box_select_flag then if not eve$$box_paste (the_paste_buffer) then eve$learn_abort; return (FALSE); else if (get_info (the_paste_buffer, "record_count") = 1) and (line_left_margin <> 0) then ! no line-break was pasted, restore line's left margin set (RECORD_ATTRIBUTE, mark (FREE_CURSOR), LEFT_MARGIN, line_left_margin); endif; return (TRUE); endif; endif; if eve$insert_text (the_paste_buffer) = 0 then eve$learn_abort; return (FALSE); else move_horizontal (-1); ! prevent erasing the line break if the paste buffer last line ! is unmodifiable if get_info (mark (NONE), "modifiable") then erase (create_range (mark (NONE), mark (NONE), NONE)); if (get_info (the_paste_buffer, "record_count") = 1) and (line_left_margin <> 0) then ! no line-break was pasted, restore line's left margin set (RECORD_ATTRIBUTE, mark (FREE_CURSOR), LEFT_MARGIN, line_left_margin); endif; else move_horizontal (1); endif; eve$show_first_line; return (TRUE); endif; endif; if eve$x_select_position <> 0 then eve$message (EVE$_NOINSUSEREM); else eve$message (EVE$_NOINSUSESEL); endif; endif; eve$learn_abort; return (FALSE); endprocedure; ! eve$$insert_here procedure eve_paste ! Synonym for INSERT HERE return (eve_insert_here); endprocedure; ! eve_paste ! EVE$CORE.TPU Page 50 procedure eve_tab ! TAB ! Tab key procedure. Modes 0 (insert a TAB) and 1 (insert spaces) always ! insert, even if current mode is overstrike. Mode 2 moves to the next ! tab position in the FORWARD direction. local the_column; on_error [OTHERWISE]: endon_error; case eve$x_tab_mode from 0 to 2 [0]: ! Insert if not eve$declare_intention (eve$k_action_add_text) then return (FALSE); endif; if get_info (current_buffer, "offset_column") >= get_info (current_buffer, "right_margin") then if get_info (eve$$x_right_action_program, "type") <> PROGRAM then eve$$x_right_action_program := compile (eve$kt_word_wrap_routine); endif; if get_info (current_buffer, "right_margin_action") = eve$$x_right_action_program then ! word wrap only if EVE's right margin action is active eve$$word_wrap_insert (ascii (9)); else copy_text (ascii (9)); endif; else eve$insert_text (ascii (9)); endif; [1]: ! Spaces if not eve$declare_intention (eve$k_action_add_text) then return (FALSE); endif; the_column := get_info (current_buffer, "offset_column") - 1; eve$insert_text (substr (eve$kt_spaces, 1, (eve$spaces_to_tab (the_column)))); [2]: ! Movement if not eve$declare_intention (eve$k_action_short_move) then return (FALSE); endif; the_column := get_info (current_buffer, "offset_column") - 1; cursor_horizontal (eve$spaces_to_tab (the_column)); endcase; return (TRUE); endprocedure; ! eve_tab ! EVE$CORE.TPU Page 51 procedure eve$spaces_to_tab ! Number of spaces to current TAB (offset) ! Returns number of spaces to the current tab character local tabs, ! copy of current buffer's tab positins tab_mode, ! current buffer's tab mode tab_spaces, ! appropriate spaces for current tab sp_index, ! ret. val. from index (str, " ") sub_str, ! substring of tabs word_wrap_spaces; ! no of spaces to W on_error [OTHERWISE]: endon_error; tabs := get_info (current_buffer, "tab_stops"); tab_mode := get_info (tabs, "type"); if tab_mode = INTEGER then tab_spaces := tabs * (1 + offset / tabs) - offset; else loop if tabs = "" then return (1); endif; sp_index := index (tabs, " "); if sp_index <> 0 then sub_str := substr (tabs, 1, sp_index - 1); tabs := substr (tabs, sp_index + 1, length (tabs)); else sub_str := tabs; tabs := ""; endif; tab_spaces := int (sub_str); exitif tab_spaces > offset + 1; endloop; tab_spaces := tab_spaces - offset - 1; endif; !check for the existance of a W in the marker if it's there make it act as !a tab. if eve$$x_word_wrap_indent {current_buffer} <> tpu$k_unspecified then word_wrap_spaces := eve$$x_word_wrap_indent {current_buffer} - offset - 1; if word_wrap_spaces > 0 then if word_wrap_spaces < tab_spaces then tab_spaces := word_wrap_spaces; endif; endif; endif; return (tab_spaces); endprocedure; ! eve$spaces_to_tab ! EVE$CORE.TPU Page 52 procedure eve_insert_page_break ! Insert a page break ! CTRL/L key procedure - inserts a page break on a line by itself on_error [TPU$_NOEOBSTR]: ! prevent current_character error at EOB [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_page_break) then return (FALSE); endif; if eve$in_prompting_window then copy_text (ascii (12)); return (TRUE); endif; if current_offset <> 0 then split_line; endif; if current_character = "" then copy_text (ascii (12)); move_horizontal (1); else eve$insert_text (ascii (12)); split_line; endif; return (TRUE); endprocedure; ! eve_insert_page_break ! EVE$CORE.TPU Page 53 procedure eve_insert_mode ! Change to insert mode set (INSERT, current_buffer); eve$update_status_lines; return (TRUE); endprocedure; ! eve_insert_mode procedure eve_overstrike_mode ! Change to overstrike mode set (OVERSTRIKE, current_buffer); eve$update_status_lines; return (TRUE); endprocedure; ! eve_overstrike_mode ! EVE$CORE.TPU Page 54 procedure eve_quote ! Insert special characters ! Don't use the binding of the next key, just type the character. ! Types the entire escape sequence for a given key. Inserts or ! overstrikes depending on current mode. local quoted_char, ! 1-character string returned by read_char saved_window, saved_mark; on_error [TPU$_CONTROLC]: if get_info (eve$prompt_window, "buffer") <> 0 then unmap (eve$prompt_window); endif; if get_info (saved_window, "buffer") <> 0 ! may have just unmapped it then eve$$restore_position (saved_window, saved_mark); endif; eve$learn_abort; abort; [TPU$_READABORTED, ! lost input focus in DECwindows TPU$_NOCHARREAD, ! user pressed KPn,Fn in DECwindows OTHERWISE]: if get_info (eve$prompt_window, "buffer") <> 0 then unmap (eve$prompt_window); endif; if get_info (saved_window, "buffer") <> 0 ! may have just unmapped it then eve$$restore_position (saved_window, saved_mark); endif; if error = TPU$_READABORTED then eve$message (EVE$_READABORTED); endif; endon_error; saved_window := current_window; saved_mark := mark (FREE_CURSOR); if not eve$declare_intention (eve$k_action_add_text) then return (FALSE); endif; if get_info (eve$prompt_window, "buffer") = 0 then map (eve$prompt_window, eve$prompt_buffer); erase (eve$prompt_buffer); position (end_of (eve$prompt_buffer)); copy_text (message_text (EVE$_QUOTEPROMPT, 1)); update (eve$prompt_window); quoted_char := read_char; ! don't parse the escape sequence unmap (eve$prompt_window); copy_text (quoted_char); ! rest of an escape sequence will follow else ! Assume prompt_buffer mapped to prompt_window (e.g., doing a FIND), ! put the char in the prompt buffer eve$message (EVE$_QUOTEPROMPT); quoted_char := read_char; ! don't parse the escape sequence copy_text (quoted_char); ! rest of an escape sequence will follow eve$clear_message; endif; return (TRUE); endprocedure; ! eve_quote ! EVE$CORE.TPU Page 55 procedure eve_restore ! Restore erased line or word ! Restores last erased line, portion of line, or word local the_range, here, line_left_margin; on_error [OTHERWISE]: endon_error; if eve$x_restore_range = 0 then eve$message (EVE$_NOREST); eve$learn_abort; return (FALSE); endif; if not eve$test_if_modifiable (current_buffer) then eve$learn_abort; return (FALSE); endif; if not eve$declare_intention (eve$k_action_add_text) then return (FALSE); endif; if current_offset = 0 then if mark (FREE_CURSOR) <> end_of (current_buffer) then ! remember to honor this line's left margin line_left_margin := get_info (mark (FREE_CURSOR), "left_margin"); else ! or honor buffer's left margin line_left_margin := get_info (current_buffer, "left_margin"); endif; endif; the_range := eve$insert_text (eve$x_restore_range); if the_range = 0 then eve$learn_abort; return (FALSE); endif; if line_left_margin <> 0 then ! restore correct left margin here := mark (NONE); position (the_range); ! restore line's left margin set (RECORD_ATTRIBUTE, mark (FREE_CURSOR), LEFT_MARGIN, line_left_margin); position (here); endif; if current_offset = 0 then eve$show_first_line; endif; return (TRUE); endprocedure; ! eve_restore ! EVE$CORE.TPU Page 56 procedure eve_restore_line ! Restore erased line local the_range, here, line_left_margin; on_error [OTHERWISE]: endon_error; if eve$x_restore_line = 0 then eve$message (EVE$_NOREST); eve$learn_abort; return (FALSE); endif; if not eve$test_if_modifiable (current_buffer) then eve$learn_abort; return (FALSE); endif; if not eve$declare_intention (eve$k_action_add_text) then return (FALSE); endif; if current_offset = 0 then if mark (FREE_CURSOR) <> end_of (current_buffer) then ! remember to honor this line's left margin line_left_margin := get_info (mark (FREE_CURSOR), "left_margin"); else line_left_margin := get_info (current_buffer, "left_margin"); endif; endif; the_range := eve$insert_text (eve$x_restore_line); if the_range = 0 then eve$learn_abort; return (FALSE); endif; if line_left_margin <> 0 then ! restore line's left margin here := mark (NONE); position (the_range); set (RECORD_ATTRIBUTE, mark (FREE_CURSOR), LEFT_MARGIN, line_left_margin); position (here); endif; if eve$x_erased_line_forward then position (the_range); else if current_offset = 0 then eve$show_first_line; endif; endif; return (TRUE); endprocedure; ! eve_restore_line ! EVE$CORE.TPU Page 57 procedure eve_restore_word ! Restore erased word local the_range, here, line_left_margin; on_error [OTHERWISE]: endon_error; if eve$x_restore_word = 0 then eve$message (EVE$_NOREST); eve$learn_abort; return (FALSE); endif; if not eve$test_if_modifiable (current_buffer) then eve$learn_abort; return (FALSE); endif; if not eve$declare_intention (eve$k_action_add_text) then return (FALSE); endif; if current_offset = 0 then if mark (FREE_CURSOR) <> end_of (current_buffer) then ! remember to honor this line's left margin line_left_margin := get_info (mark (FREE_CURSOR), "left_margin"); else line_left_margin := get_info (current_buffer, "left_margin"); endif; endif; the_range := eve$insert_text (eve$x_restore_word); if the_range = 0 then eve$learn_abort; return (FALSE); endif; if line_left_margin <> 0 then ! restore line's left margin here := mark (NONE); position (the_range); set (RECORD_ATTRIBUTE, mark (FREE_CURSOR), LEFT_MARGIN, line_left_margin); position (here); endif; if eve$x_erased_word_forward then position (the_range); ! can accept integer 0 else if current_offset = 0 then eve$show_first_line; endif; endif; return (TRUE); endprocedure; ! eve_restore_word ! EVE$CORE.TPU Page 58 procedure eve_restore_character ! Restore erased char local the_range, here, line_left_margin; on_error [OTHERWISE]: endon_error; if eve$x_restore_char = 0 then eve$message (EVE$_NOREST); eve$learn_abort; return (FALSE); endif; if not eve$test_if_modifiable (current_buffer) then eve$learn_abort; return (FALSE); endif; if not eve$declare_intention (eve$k_action_add_text) then return (FALSE); endif; if current_offset = 0 then if mark (FREE_CURSOR) <> end_of (current_buffer) then ! remember to honor this line's left margin line_left_margin := get_info (mark (FREE_CURSOR), "left_margin"); else line_left_margin := get_info (current_buffer, "left_margin"); endif; endif; if eve$x_erased_char_forward then if get_info (current_buffer, "mode") = OVERSTRIKE then move_horizontal (-length (eve$x_restore_char)); endif; endif; the_range := copy_text (eve$x_restore_char); if line_left_margin <> 0 then ! restore line's left margin here := mark (NONE); position (the_range); set (RECORD_ATTRIBUTE, mark (FREE_CURSOR), LEFT_MARGIN, line_left_margin); position (here); endif; if eve$x_erased_char_forward then position (the_range); else if current_offset = 0 then eve$show_first_line; endif; endif; return (TRUE); endprocedure; ! eve_restore_character ! EVE$CORE.TPU Page 59 procedure eve$test_if_modifiable ! Test if buffer is modifiable (the_buffer) on_error [OTHERWISE]: endon_error; if not get_info (the_buffer, "modifiable") then eve$message (EVE$_NOTMODIFIABLE, 0, get_info (the_buffer, "name")); return (FALSE); endif; return (TRUE); endprocedure; ! eve$test_if_modifiable ! EVE$CORE.TPU Page 60 ! Initialization procedures procedure tpu$local_init ! User's init procedure ! Initialization for user's own variables endprocedure; ! tpu$local_init ! Pre-Initialization procedures procedure tpu$local_pre_init ! User's pre-init procedure ! Initialization for user's own variables endprocedure; ! tpu$local_pre_init ! EVE$CORE.TPU Page 61 ! Routines to do copy_texts in INSERT or OVERSTRIKE mode without perterbing ! the current mode ! procedure eve$insert_text ! Copy_text in insert mode (the_text) ! String to be inserted ! Routine to insert text local saved_mode; ! Used to hold the current mode on_error [TPU$_CONTROLC]: if saved_mode = OVERSTRIKE then set (saved_mode, current_buffer); endif; eve$learn_abort; abort; [TPU$_OVERLAPRANGE, TPU$_NOCOPYBUF]: eve$message (EVE$_NOCOPYSELF); if saved_mode = OVERSTRIKE then set (saved_mode, current_buffer); endif; [OTHERWISE]: if saved_mode = OVERSTRIKE then set (saved_mode, current_buffer); endif; endon_error; saved_mode := get_info (current_buffer, "mode"); set (INSERT, current_buffer); eve$insert_text := copy_text (the_text); set (saved_mode, current_buffer); endprocedure; ! eve$insert_text ! EVE$CORE.TPU Page 62 procedure eve$overstrike_text ! Copy_text in overstrike mode (the_text) ! Text string to overstrike with ! Routine to overstrike text local saved_mode; ! Used to hold the current mode on_error [TPU$_CONTROLC]: if saved_mode = INSERT then set (saved_mode, current_buffer); endif; eve$learn_abort; abort; [OTHERWISE]: if saved_mode = INSERT then set (saved_mode, current_buffer); endif; endon_error; saved_mode := get_info (current_buffer, "mode"); set (OVERSTRIKE, current_buffer); eve$overstrike_text := copy_text (the_text); set (saved_mode, current_buffer); endprocedure; ! eve$overstrike_text ! EVE$CORE.TPU Page 63 procedure eve$$init_modules ! Init facilities after EVE init ! Procedure to call the initialization procedures for the various packages endprocedure; ! eve$$init_modules procedure eve$$pre_init_modules ! Init facilities during EVE init ! Procedure to call the pre-initialization procedures for the various packages endprocedure; ! eve$$pre_init_modules ! EVE$CORE.TPU Page 64 procedure eve$$restore_settings ! Restore section file settings ! Null procedure overwritten by the SAVE EXTENDED TPU command endprocedure; ! eve$$restore_settings ! EVE$CORE.TPU Page 65 procedure eve_reset ! RESET command on_error [OTHERWISE]: endon_error; if current_window = eve$prompt_window then return (FALSE); ! no learn_abort here endif; eve$unmap_if_mapped (eve$choice_window); if (eve$x_select_position <> 0) or ! Cancel SELECT (eve$x_box_array <> 0) then eve$clear_select_position; eve$message (EVE$_SELCAN); endif; eve$$remove_found_range; ! Cancel the found range eve$x_old_find_direction := FORWARD; ! Set FIND NEXT direction if current_window <> eve$command_window then set (FORWARD, current_buffer); ! Set direction FORWARD eve$update_status_lines; else eve$delete_start_line; ! cancel any incomplete command line eve$$exit_command_window; endif; eve$check_bad_window; eve$$release_scratch_buffer; ! unconditional release ! Clear the secondary select range in case there was an error between ! us and another DECwindows application. eve$clear_secondary_select; return (TRUE); endprocedure; ! eve_reset ! EVE$CORE.TPU Page 66 procedure tpu$init_procedure ! INIT ! INITIALIZATION PROCEDURE ! ! Invoked to initialize the editing session. This routine is kept to a minimum ! to enable EVE to be layered on top of other packages. The eve$init_procedure ! routine calls all of the routines that do the real work. on_error [TPU$_CONTROLC]: ! ! if ctrl/c was pressed during this routine, quit (this is during ! startup) ! QUIT (OFF,1); [OTHERWISE]: endon_error; eve$init_procedure; tpu$local_init; ! Indicate that (pre /COMMAND /INIT) initialization is complete. ! GET FILE uses this variable to exit if no file exists and /NOCREATE. eve$x_starting_up := FALSE; ! Set startup flag that lasts from end of eve$init_procedure until ! end of eve$init_postprocedure (spans /COMMAND and /INIT files) eve$x_post_starting_up := TRUE; endprocedure; ! tpu$init_procedure ! EVE$CORE.TPU Page 67 procedure eve$$init_settings ! Init specific settings local the_map; ! get_info's next map ! Turn off message headers (facility, severity, id) set (MESSAGE_FLAGS, 1); ! Turn off ability to cross window boundaries set (CROSS_WINDOW_BOUNDS, OFF); ! Turn on bell for broadcast messages set (BELL, BROADCAST, ON); ! Handle overstruck tabs correctly set (PAD_OVERSTRUCK_TABS, ON); ! Use EDT-style move-verticals in BOUND cursor mode set (COLUMN_MOVE_VERTICAL, ON); ! Make sure repeat-count is zeroed by error handlers set (SPECIAL_ERROR_SYMBOL, "eve$x_repeat_count"); endprocedure; ! eve$$init_settings ! EVE$CORE.TPU Page 68 procedure eve$init_procedure ! EVE's init procedure ! Initialize our variables, windows, buffers, files etc. eve$$init_variables; ! sets eve$x_starting_up eve$$init_settings; ! Call the initialization routines for any layered products and for user eve$$pre_init_modules; tpu$local_pre_init; eve$$init_modules; ! Initialize the GOLD and DO key structures ! (/COMMAND and /INITIALIZATAION will override) eve$$restore_settings; ! Restore section file GOLD/DO keys eve$set_section_attributes; ! Restore user attributes from section eve$$x_attrs_modified := FALSE; ! Reset in case /COMMAND calls EVE_EXIT endprocedure; ! eve$init_procedure ! EVE$CORE.TPU Page 69 procedure tpu$init_postprocedure ! Last procedure during startup eve$init_postprocedure; endprocedure; ! tpu$init_postprocedure procedure eve$init_postprocedure !EVE's init postprocedure local saved_mark, null_file, initial_position; on_error [OTHERWISE]: eve$$restore_position (saved_mark); endon_error; eve$$x_attrs_modified := FALSE; ! Reset in case /COMMAND modified attributes ! Execute logic for initialization files, user-supplied if any exists. if get_info (eve$$x_dcl_init_file_pgm, "type") = UNSPECIFIED then eve$dcl_init_file_logic; ! EVE default logic eve$$x_attrs_modified := FALSE; ! Reset in case /INIT defined attrs else if execute (eve$$x_dcl_init_file_pgm) ! User specified logic then eve$dcl_init_file_logic; ! EVE default logic eve$$x_attrs_modified := FALSE; ! Reset in case /INIT defined attrs endif; endif; ! If EVE is in control of the interface, e.g., the windows haven't been ! torn down by a call to EVE$TEARDOWN_WINDOWS: ! - Create the default buffer, copying the attributes from the ! eve$x_source_for_default_buffer as set by tpu$local_init, /COMMAND, ! and /INITIALIZATION. ! - Ensure that the initial editing position is not no the borders ! of the screen (as might happen from a /START_POSITION). ! If EVE is not in control of the interface: ! - Create the default buffer using TPU's default attributes. ! ! NOTE: eve$display_choices uses the fact that the default buffer is not ! created until this time during initialization in order to know if ! a command is from the /COMMAND file. if eve$x_buf_str_defaults = tpu$k_unspecified then eve$x_buf_str_defaults := "$DEFAULTS$"; endif; if eve$x_ultrix_active ! get os-specific null-device then null_file := "/dev/null"; ! ultrix else null_file := "NL:"; ! vms endif; if eve$eve_in_control then if get_info (eve$x_source_for_default_buffer, "journaling") then eve$default_buffer := create_buffer (eve$x_buf_str_defaults, "", eve$x_source_for_default_buffer, null_file); ! no journal file else eve$default_buffer := create_buffer (eve$x_buf_str_defaults, "", eve$x_source_for_default_buffer); endif; initial_position := mark (FREE_CURSOR); if initial_position <> beginning_of (current_buffer) then eve$position_in_middle (initial_position); endif; ! Remember if a paragraph_indent was set on the default buffer: if eve$$x_paragraph_indent {eve$x_source_for_default_buffer} <> tpu$k_unspecified then eve$$x_paragraph_indent {eve$default_buffer} := eve$$x_paragraph_indent { eve$x_source_for_default_buffer }; endif; %if eve$x_option_decwindows %then ! layered applications can delay menu creation by assigning to this ! variable in a module pre_init if eve$x_delay_menu_creation = tpu$k_unspecified then eve$manage_menu_bar; ! put up the menu_bar endif; %endif else ! EVE$SETUP_WINDOWS will manage the menu_bar if not already managed eve$default_buffer := create_buffer (eve$x_buf_str_defaults); endif; set (MODIFIABLE, eve$default_buffer, OFF); ! GET FILE, BUFFER will override set (NO_WRITE, eve$default_buffer); ! GET FILE, BUFFER will override set (SYSTEM, eve$default_buffer); set (PERMANENT, eve$default_buffer); ! Start buffer journaling on default buffer so journaling will be ! inherited by user buffers. if eve$$x_buffer_change_journaling then if not get_info (eve$default_buffer, "journaling") then set (JOURNALING, eve$default_buffer, ON, null_file); endif; endif; ! Tell user if neither keystroke or buffer change journaling if (not eve$$x_buffer_change_journaling) and (get_info (SYSTEM, "journal_file") = "") then ! ! Only output this message if EVE's windows are up ! if eve$eve_in_control then eve$message (TPU$_NOJOURNAL); endif; endif; ! for ungrab/grab of input focus eve$$x_saved_window := current_window; eve$$x_saved_buffer := current_buffer; ! If user specified ambiguous input file name, then do a GET FILE and ! complete startup (after displaying the choices buffer). if eve$$x_ambiguous_input_file <> 0 then if (current_buffer <> eve$x_main_buffer) and (not get_info (current_buffer, "system")) then ! user created buffer in /command or /init, delete buffer Main and ! make eve$x_main_buffer point to the current buffer if (get_info (eve$x_main_buffer, "name") = eve$x_buf_str_main) then delete (eve$x_main_buffer); endif; eve$x_main_buffer := current_buffer; endif; ! this will leave us in the command window with choices displayed eve_get_file (eve$$x_ambiguous_input_file); endif; ! Don't enter TPU's main loop without /DISPLAY if not get_info (COMMAND_LINE, "display") then exit; endif; ! Clear startup flag that lasts from end of eve$init_procedure until ! end of eve$init_postprocedure eve$x_post_starting_up := FALSE; endprocedure; ! eve$init_postprocedure ! EVE$CORE.TPU Page 70 procedure eve$set_function_keys_eve ! Restore EVE's null function key_map return (eve$set_function_keys (eve$x_standard_function_keys)); endprocedure; ! eve$set_function_keys_eve ! EVE$CORE.TPU Page 71 ! Module initialization code ! Define standard Ultrix keys if eve$x_ultrix_active then ! Don't define ctrl/d if it's already defined in EVE's keymap if lookup_key (CTRL_D_KEY, PROGRAM, eve$x_standard_keys) = 0 then define_key (eve$$kt_return + "eve_exit", CTRL_D_KEY, " exit", eve$x_standard_keys); endif; endif; ! Set default user attributes eve$define_attr ("eve_set_pending_delete", "eve_set_nopending_delete;", message_text (EVE$_PENDINGDELOFF, 0)); eve$define_attr ("eve$set_find_case_sensitivity", "eve$set_find_case_sensitivity (false);", message_text (EVE$_FINDNOEXACT)); endmodule; ! EVE$CORE.TPU Page 72 ! ! Global Constant and Variable Declarations ! variable eve$$x_wild_patterns; variable eve$x_choice_highlighting; ! Global string constants ! ! Declaring constants with the following syntax allows EVE help to parse ! multiple token topics, e.g., command_file. This lets the user ask for ! help on "command file" instead of "command_file". The syntax is: ! eve$kt_topic__xxx := 0; ! no real value need be assigned ! You should define constants for all info topics, even those with no "_", ! so that all can appear in choices displays for ambiguous help topics. ! ! EVE topics constant eve$kt_topic_eve_abbreviating := 0; constant eve$kt_topic_eve_about := 0; constant eve$kt_topic_eve_attributes := 0; constant eve$kt_topic_eve_canceling_commands := 0; constant eve$kt_topic_eve_choices_buffer := 0; constant eve$kt_topic_eve_command_files := 0; constant eve$kt_topic_eve_control_keys := 0; constant eve$kt_topic_eve_decwindows_differences := 0; constant eve$kt_topic_eve_defaults := 0; constant eve$kt_topic_eve_dialog_boxes := 0; constant eve$kt_topic_eve_editing_command_lines := 0; constant eve$kt_topic_eve_edt_conversion := 0; constant eve$kt_topic_eve_edt_differences := 0; constant eve$kt_topic_eve_gold_keys := 0; constant eve$kt_topic_eve_context_sensitive_help := 0; constant eve$kt_topic_eve_initialization_files := 0; constant eve$kt_topic_eve_journal_files := 0; constant eve$kt_topic_eve_mail_editing := 0; constant eve$kt_topic_eve_menus := 0; constant eve$kt_topic_eve_message_buffer := 0; constant eve$kt_topic_eve_mouse := 0; constant eve$kt_topic_eve_names_for_keys := 0; constant eve$kt_topic_eve_new_features := 0; constant eve$kt_topic_eve_new_user := 0; constant eve$kt_topic_eve_pending_delete := 0; constant eve$kt_topic_eve_position_cursor := 0; constant eve$kt_topic_eve_prompts_and_responses := 0; constant eve$kt_topic_eve_quick_copy := 0; constant eve$kt_topic_eve_ranges_and_boxes := 0; constant eve$kt_topic_eve_ruler_keys := 0; constant eve$kt_topic_eve_scroll_bars := 0; constant eve$kt_topic_eve_section_files := 0; constant eve$kt_topic_eve_status_line := 0; constant eve$kt_topic_eve_typing_keys := 0; constant eve$kt_topic_eve_ultrix_differences := 0; constant eve$kt_topic_eve_vms_differences := 0; constant eve$kt_topic_eve_windows := 0; constant eve$kt_topic_eve_wps_differences := 0; ! The following is not in the list of EVE topics, but is invoked when ! user presses keypad gold key that has been superseded by SET GOLD. constant eve$kt_topic_eve_old_gold_key := 0; ! Load this constant with all illegal commands that have procedures defined - ! lowercase & separate each with a space (e.g., "eve_set_height "), constant eve$$kt_illegal_commands := ""; ! none at the moment ! The following is output when help parses an illegal command constant eve$kt_topic_eve_not_implemented := 0; ! illegal cmds ! TPU info topics constant eve$kt_topic_tpu_boolean_expressions := 0; constant eve$kt_topic_tpu_debugger := 0; constant eve$kt_topic_tpu_error_handlers := 0; constant eve$kt_topic_tpu_keymaps_and_keymap_lists := 0; constant eve$kt_topic_tpu_keynames_table := 0; constant eve$kt_topic_tpu_nondefinable_keys := 0; constant eve$kt_topic_tpu_recovery := 0; ! TPU keywords needing help topics constant eve$kt_topic_tpu_anchor := 0; constant eve$kt_topic_tpu_line_begin := 0; constant eve$kt_topic_tpu_line_end := 0; constant eve$kt_topic_tpu_remain := 0; constant eve$kt_topic_tpu_unanchor := 0; ! TPU keywords for GET_INFO needing help topics constant eve$kt_topic_get_info_any_keyname := 0; constant eve$kt_topic_get_info_any_keyword := 0; constant eve$kt_topic_get_info_any_variable := 0; constant eve$kt_topic_get_info_array := 0; constant eve$kt_topic_get_info_array_variable := 0; constant eve$kt_topic_get_info_buffer := 0; constant eve$kt_topic_get_info_buffer_variable := 0; constant eve$kt_topic_get_info_command_line := 0; constant eve$kt_topic_get_info_debug := 0; constant eve$kt_topic_get_info_defined_key := 0; constant eve$kt_topic_get_info_integer_variable := 0; constant eve$kt_topic_get_info_key_map := 0; constant eve$kt_topic_get_info_key_map_list := 0; constant eve$kt_topic_get_info_marker_variable := 0; constant eve$kt_topic_get_info_mouse_event_keyword := 0; constant eve$kt_topic_get_info_procedures := 0; constant eve$kt_topic_get_info_process := 0; constant eve$kt_topic_get_info_process_variable := 0; constant eve$kt_topic_get_info_range_variable := 0; constant eve$kt_topic_get_info_screen := 0; constant eve$kt_topic_get_info_string_variable := 0; constant eve$kt_topic_get_info_system := 0; constant eve$kt_topic_get_info_widget := 0; constant eve$kt_topic_get_info_widget_variable := 0; constant eve$kt_topic_get_info_window := 0; constant eve$kt_topic_get_info_window_variable := 0; ! TPU keywords for SET needing help topics constant eve$kt_topic_set_active_area := 0; constant eve$kt_topic_set_auto_repeat := 0; constant eve$kt_topic_set_bell := 0; constant eve$kt_topic_set_client_message := 0; constant eve$kt_topic_set_column_move_vertical := 0; constant eve$kt_topic_set_cross_window_bounds := 0; constant eve$kt_topic_set_debug := 0; constant eve$kt_topic_set_default_directory := 0; constant eve$kt_topic_set_default_file := 0; constant eve$kt_topic_set_detached_action := 0; constant eve$kt_topic_set_display_value := 0; constant eve$kt_topic_set_drm_hierarchy := 0; constant eve$kt_topic_set_enable_resize := 0; constant eve$kt_topic_set_eob_text := 0; constant eve$kt_topic_set_erase_unmodifiable := 0; constant eve$kt_topic_set_facility_name := 0; constant eve$kt_topic_set_first_input_action := 0; constant eve$kt_topic_set_forward := 0; constant eve$kt_topic_set_global_select := 0; constant eve$kt_topic_set_global_select_grab := 0; constant eve$kt_topic_set_global_select_read := 0; constant eve$kt_topic_set_global_select_time := 0; constant eve$kt_topic_set_global_select_ungrab := 0; constant eve$kt_topic_set_height := 0; constant eve$kt_topic_set_icon_name := 0; constant eve$kt_topic_set_icon_pixmap := 0; constant eve$kt_topic_set_iconify_pixmap := 0; constant eve$kt_topic_set_informational := 0; constant eve$kt_topic_set_input_focus := 0; constant eve$kt_topic_set_input_focus_grab := 0; constant eve$kt_topic_set_input_focus_ungrab := 0; constant eve$kt_topic_set_insert := 0; constant eve$kt_topic_set_journaling := 0; constant eve$kt_topic_set_key_map_list := 0; constant eve$kt_topic_set_keystroke_recovery := 0; constant eve$kt_topic_set_left_margin := 0; constant eve$kt_topic_set_left_margin_action := 0; constant eve$kt_topic_set_line_number := 0; constant eve$kt_topic_set_mapped_when_managed := 0; constant eve$kt_topic_set_margins := 0; constant eve$kt_topic_set_max_lines := 0; constant eve$kt_topic_set_menu_position := 0; constant eve$kt_topic_set_message_action_level := 0; constant eve$kt_topic_set_message_action_type := 0; constant eve$kt_topic_set_message_flags := 0; constant eve$kt_topic_set_modifiable := 0; constant eve$kt_topic_set_modified := 0; constant eve$kt_topic_set_mouse := 0; constant eve$kt_topic_set_move_vertical_context := 0; constant eve$kt_topic_set_no_write := 0; constant eve$kt_topic_set_output_file := 0; constant eve$kt_topic_set_overstrike := 0; constant eve$kt_topic_set_pad := 0; constant eve$kt_topic_set_pad_overstruck_tabs := 0; constant eve$kt_topic_set_permanent := 0; constant eve$kt_topic_set_post_key_procedure := 0; constant eve$kt_topic_set_pre_key_procedure := 0; constant eve$kt_topic_set_prompt_area := 0; constant eve$kt_topic_set_record_attribute := 0; constant eve$kt_topic_set_record_mode := 0; constant eve$kt_topic_set_resize_action := 0; constant eve$kt_topic_set_reverse := 0; constant eve$kt_topic_set_right_margin := 0; constant eve$kt_topic_set_right_margin_action := 0; constant eve$kt_topic_set_screen_limits := 0; constant eve$kt_topic_set_screen_update := 0; constant eve$kt_topic_set_scrolling := 0; constant eve$kt_topic_set_scroll_bar := 0; constant eve$kt_topic_set_scroll_bar_auto_thumb := 0; constant eve$kt_topic_set_self_insert := 0; constant eve$kt_topic_set_shift_key := 0; constant eve$kt_topic_set_special_error_symbol := 0; constant eve$kt_topic_set_status_line := 0; constant eve$kt_topic_set_success := 0; constant eve$kt_topic_set_system := 0; constant eve$kt_topic_set_tab_stops := 0; constant eve$kt_topic_set_text := 0; constant eve$kt_topic_set_timer := 0; constant eve$kt_topic_set_traceback := 0; constant eve$kt_topic_set_uid := 0; constant eve$kt_topic_set_undefined_key := 0; constant eve$kt_topic_set_video := 0; constant eve$kt_topic_set_widget := 0; constant eve$kt_topic_set_widget_callback := 0; constant eve$kt_topic_set_widget_call_data := 0; constant eve$kt_topic_set_widget_context_help := 0; constant eve$kt_topic_set_widget_resource_types := 0; constant eve$kt_topic_set_width := 0; ! TPU lexical language elements needing help topics constant eve$kt_topic_tpu_abort := 0; constant eve$kt_topic_tpu_error := 0; constant eve$kt_topic_tpu_error_line := 0; constant eve$kt_topic_tpu_error_text := 0; constant eve$kt_topic_tpu_return := 0; ! The procedures EVE$INIT_KEY and EVE$CLEAR_KEY are no longer needed ! in order to guarantee that user keys are not superseded by EVE key ! definitions. Key maps are used for that purpose now. The following ! key maps are used by EVE: ! ! TPU$KEY_MAP_LIST Only key map list used ! Contains the following maps: ! 0. EVE$MOUSE_KEYS Mouse UP and DOWN keys ! (Mouse keys are in the per-window key map lists ! when we're runing on VAXTPU V2.2 or later. ! On VAXTPU V2.0, EVE V2.2 puts the mouse keys ! at the top of the key map list.) ! 1. EVE$USER_KEYS Defined by EVE's DEFINE_KEY ! and LEARN/REMEMBER commands ! 2. One of the following: ! EVE$VT100_KEYS EVE's VT100 numeric pad keys ! EVE$NUMERIC_KEYS EVE's VT200 numeric pad keys ! EVE$EDT_KEYS EDT keypad keys ! EVE$WPS_KEYS WPS keypad keys ! 3. EVE$STANDARD_KEYS EVE's non-pad keys ! ! The EVE$... key maps are reserved for use by EVE. Users and layered ! products should add their own maps to the list. ! EVE always puts its maps at the end of the list, so user keys always ! supersede EVE keys. ! Define standard key definitions - control keys, arrow keys, e- and f- keys. ! This procedure is not available from the Eve after initialization. ! Set up the key maps eve$$init_variables; set (SHIFT_KEY, key_name (PF1, SHIFT_KEY), eve$x_key_map_list); eve$x_user_keys := create_key_map ("EVE$USER_KEYS"); eve$x_vt100_keys := create_key_map ("EVE$VT100_KEYS"); eve$x_numeric_keys := create_key_map ("EVE$NUMERIC_KEYS"); eve$x_standard_keys := create_key_map ("EVE$STANDARD_KEYS"); eve$x_keypad_list := create_key_map_list ("EVE$KEYPAD_LIST", eve$x_vt100_keys, eve$x_numeric_keys); ! No keys will be defined in the EVE$X_STANDARD_FUNCTION_KEYS key_map. ! It will simply be a placeholder in the key_map_lists when no function-keys ! are enabled. eve$x_standard_function_keys := create_key_map ("EVE$STANDARD_FUNCTION_KEYS"); eve$x_function_key_map_list := create_key_map_list ("EVE$FUNCTION_LIST", eve$x_standard_function_keys, eve$x_motif_function_keys); ! all keys defined as DO must be put into eve$$x-do_key_array - call ! eve$$add_do_key in module_init (this case of eve$terminals.tpu) ! First create the vt100 key-pad define_key (eve$$kt_return + "eve_next_screen", KP0, " next_screen", eve$x_vt100_keys); define_key (eve$$kt_return + "eve_previous_screen", PERIOD, " previous_screen", eve$x_vt100_keys); define_key (eve$$kt_return + "eve_change_mode", ENTER, " change_mode", eve$x_vt100_keys); define_key (eve$$kt_return + "eve_move_left", KP1, " move_left", eve$x_vt100_keys); define_key (eve$$kt_return + "eve_move_down", KP2, " move_down", eve$x_vt100_keys); define_key (eve$$kt_return + "eve_move_right", KP3, " move_right", eve$x_vt100_keys); define_key (eve$$kt_return + "eve_move_up", KP5, " move_up", eve$x_vt100_keys); define_key (eve$$kt_return + "eve_erase_word", COMMA, " erase_word", eve$x_vt100_keys); define_key (eve$$kt_return + "eve_select", KP7, " select", eve$x_vt100_keys); define_key (eve$$kt_return + "eve_remove", KP8, " remove", eve$x_vt100_keys); define_key (eve$$kt_return + "eve_insert_here", KP9, " insert_here", eve$x_vt100_keys); define_key (eve$$kt_return + "eve_move_by_line", MINUS, " move_by_line", eve$x_vt100_keys); define_key (eve$$kt_return + "eve_find ('')", PF1, " find", eve$x_vt100_keys); define_key (eve$$kt_return + "eve_help ('" + eve$x_keypad + "')", PF2, " help (help " + eve$x_keypad + ")", eve$x_vt100_keys); define_key (eve$$kt_return + "eve_change_direction", PF3, " change_direction", eve$x_vt100_keys); define_key (eve$$kt_return + "eve_do ('')", PF4, " do", eve$x_vt100_keys); eve$$add_do_key (PF4, eve$x_vt100_keys); ! next create the generic numeric keypad define_key (eve$$kt_return + "copy_text ('0')", KP0, " typing", eve$x_numeric_keys); define_key (eve$$kt_return + "copy_text ('.')", PERIOD, " typing", eve$x_numeric_keys); define_key (eve$$kt_return + "eve_return", ENTER, " return", eve$x_numeric_keys); define_key (eve$$kt_return + "copy_text ('1')", KP1, " typing", eve$x_numeric_keys); define_key (eve$$kt_return + "copy_text ('2')", KP2, " typing", eve$x_numeric_keys); define_key (eve$$kt_return + "copy_text ('3')", KP3, " typing", eve$x_numeric_keys); define_key (eve$$kt_return + "copy_text ('4')", KP4, " typing", eve$x_numeric_keys); define_key (eve$$kt_return + "copy_text ('5')", KP5, " typing", eve$x_numeric_keys); define_key (eve$$kt_return + "copy_text ('6')", KP6, " typing", eve$x_numeric_keys); define_key (eve$$kt_return + "copy_text (',')", COMMA, " typing", eve$x_numeric_keys); define_key (eve$$kt_return + "copy_text ('7')", KP7, " typing", eve$x_numeric_keys); define_key (eve$$kt_return + "copy_text ('8')", KP8, " typing", eve$x_numeric_keys); define_key (eve$$kt_return + "copy_text ('9')", KP9, " typing", eve$x_numeric_keys); define_key (eve$$kt_return + "copy_text ('-')", MINUS, " typing", eve$x_numeric_keys); define_key (eve$$kt_return + "eve_do ('')", PF4, " do", eve$x_numeric_keys); eve$$add_do_key (PF4, eve$x_numeric_keys); ! Create the function keys (common to all keyboards) ! Arrow keys define_key (eve$$kt_return + "eve_move_left", LEFT, " move_left", eve$x_standard_keys); define_key (eve$$kt_return + "eve_move_right", RIGHT, " move_right", eve$x_standard_keys); define_key (eve$$kt_return + "eve_move_down", DOWN, " move_down", eve$x_standard_keys); define_key (eve$$kt_return + "eve_move_up", UP, " move_up", eve$x_standard_keys); define_key (eve$$kt_return + "eve_move_left", key_name (LEFT, SHIFT_MODIFIED), " move_left", eve$x_standard_keys); define_key (eve$$kt_return + "eve_move_right", key_name (RIGHT, SHIFT_MODIFIED), " move_right", eve$x_standard_keys); define_key (eve$$kt_return + "eve_move_down", key_name (DOWN, SHIFT_MODIFIED), " move_down", eve$x_standard_keys); define_key (eve$$kt_return + "eve_move_up", key_name (UP, SHIFT_MODIFIED), " move_up", eve$x_standard_keys); define_key (eve$$kt_return + "eve_move_left", key_name (LEFT, CTRL_MODIFIED), " move_left", eve$x_standard_keys); define_key (eve$$kt_return + "eve_move_right", key_name (RIGHT, CTRL_MODIFIED), " move_right", eve$x_standard_keys); define_key (eve$$kt_return + "eve_move_down", key_name (DOWN, CTRL_MODIFIED), " move_down", eve$x_standard_keys); define_key (eve$$kt_return + "eve_move_up", key_name (UP, CTRL_MODIFIED), " move_up", eve$x_standard_keys); ! lk201 editing keypad keys define_key (eve$$kt_return + "eve_find ('')", E1, " find", eve$x_standard_keys); define_key (eve$$kt_return + "eve_insert_here", E2, " insert_here", eve$x_standard_keys); define_key (eve$$kt_return + "eve_remove", E3, " remove", eve$x_standard_keys); define_key (eve$$kt_return + "eve_select", E4, " select", eve$x_standard_keys); define_key (eve$$kt_return + "eve_previous_screen", E5, " previous_screen", eve$x_standard_keys); define_key (eve$$kt_return + "eve_next_screen", E6, " next_screen", eve$x_standard_keys); ! Top row function keys define_key (eve$$kt_return + "eve_exit", F10, " exit", eve$x_standard_keys); define_key (eve$$kt_return + "eve_change_direction", F11, %if eve$x_option_keyhelp %then " change_direction (Forward Reverse)", %else " change_direction", %endif eve$x_standard_keys); define_key (eve$$kt_return + "eve_move_by_line", F12, " move_by_line", eve$x_standard_keys); define_key (eve$$kt_return + "eve_erase_word", F13, " erase_word", eve$x_standard_keys); define_key (eve$$kt_return + "eve_change_mode", F14, %if eve$x_option_keyhelp %then " change_mode (Insert Overstrike)", %else " change_mode", %endif eve$x_standard_keys); define_key (eve$$kt_return + "eve_help ('keypad')", HELP, " help (help keypad)", eve$x_standard_keys); define_key (eve$$kt_return + "eve_do ('')", DO, " do", eve$x_standard_keys); eve$$add_do_key (DO, eve$x_standard_keys); ! Keys on main typing array define_key (eve$$kt_return + "eve_delete", DEL_KEY, " delete", eve$x_standard_keys); define_key (eve$$kt_return + "eve_tab", TAB_KEY, " tab", eve$x_standard_keys); define_key (eve$$kt_return + "eve_return", RET_KEY, " return", eve$x_standard_keys); define_key (eve$$kt_return + "eve_change_mode", CTRL_A_KEY, %if eve$x_option_keyhelp %then " change_mode (Insert Overstrike)", %else " change_mode", %endif eve$x_standard_keys); define_key (eve$$kt_return + "eve_recall", CTRL_B_KEY, " recall", eve$x_standard_keys); define_key (eve$$kt_return + "eve_end_of_line", CTRL_E_KEY, " end_of_line", eve$x_standard_keys); define_key (eve$$kt_return + "eve_start_of_line", CTRL_H_KEY, " start_of_line", eve$x_standard_keys); define_key (eve$$kt_return + "eve_erase_word", CTRL_J_KEY, " erase_word", eve$x_standard_keys); define_key (eve$$kt_return + "eve_insert_page_break", CTRL_L_KEY, " insert_page_break", eve$x_standard_keys); define_key (eve$$kt_return + "eve_erase_start_of_line", CTRL_U_KEY, " erase_start_of_line", eve$x_standard_keys); define_key (eve$$kt_return + "eve_quote", CTRL_V_KEY, " quote", eve$x_standard_keys); define_key (eve$$kt_return + "eve_refresh", CTRL_W_KEY, " refresh", eve$x_standard_keys); define_key (eve$$kt_return + "eve_exit", CTRL_Z_KEY, " exit", eve$x_standard_keys); define_key (eve$$kt_return + "eve_restore_word", key_name (F13, SHIFT_KEY), " restore_word", eve$x_standard_keys); define_key (eve$$kt_return + "eve_help ('keys')", key_name (HELP, SHIFT_KEY), " help (help keys)", eve$x_standard_keys); define_key (eve$$kt_return + "eve_restore", key_name (E2, SHIFT_KEY), " restore", eve$x_standard_keys); define_key (eve$$kt_return + "eve_store_text", key_name (E3, SHIFT_KEY), " store_text", eve$x_standard_keys); define_key (eve$$kt_return + "eve_reset", key_name (E4, SHIFT_KEY), " reset", eve$x_standard_keys); define_key (eve$$kt_return + "eve_previous_window", key_name (E5, SHIFT_KEY), "previous_window", eve$x_standard_keys); define_key (eve$$kt_return + "eve_next_window", key_name (E6, SHIFT_KEY), "next_window", eve$x_standard_keys); define_key (eve$$kt_return + "eve_top", key_name (UP, SHIFT_KEY), " top", eve$x_standard_keys); define_key (eve$$kt_return + "eve_bottom", key_name (DOWN, SHIFT_KEY), " bottom", eve$x_standard_keys); define_key (eve$$kt_return + "eve_end_of_line", key_name (RIGHT, SHIFT_KEY), " end_of_line", eve$x_standard_keys); define_key (eve$$kt_return + "eve_start_of_line", key_name (LEFT, SHIFT_KEY), " start_of_line", eve$x_standard_keys); set (UNDEFINED_KEY, eve$x_key_map_list, "eve$undefined_key (last_key)"); remove_key_map (eve$x_key_map_list, "tpu$key_map", ALL); add_key_map (eve$x_key_map_list, "last", eve$x_user_keys); add_key_map (eve$x_key_map_list, "last", eve$x_standard_function_keys); add_key_map (eve$x_key_map_list, "last", eve$x_numeric_keys); add_key_map (eve$x_key_map_list, "last", eve$x_standard_keys); eve$x_command_key_map_list := create_key_map_list ("EVE$COMMAND_MAP_LIST", "tpu$key_map"); set (UNDEFINED_KEY, eve$x_command_key_map_list, "eve$undefined_key (last_key)"); remove_key_map (eve$x_command_key_map_list, "tpu$key_map", ALL); add_key_map (eve$x_command_key_map_list, "last", eve$x_user_keys); add_key_map (eve$x_command_key_map_list, "last", eve$x_standard_function_keys); add_key_map (eve$x_command_key_map_list, "last", eve$x_numeric_keys); add_key_map (eve$x_command_key_map_list, "last", eve$x_standard_keys); ! The minimal EVE editor requires EVE$CORE.TPU plus the following modules. eve$$require ("eve$terminals"); eve$$require ("eve$windows"); eve$$require ("eve$file");