! EVE$TERMINALS.TPU 31-DEC-1992 12:16 Page 1 module eve$terminals ident "V03-017" ! ! ! © 1983, 1993 BY ! DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS. ! © 1995 BY ! EDS DEFENCE 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 DIGITAL EQUIPMENT ! CORPORATION OR EDS. ! ! NEITHER DIGITAL NOR EDS ASSUME ANY RESPONSIBILITY FOR THE USE OR ! RELIABILITY OF THIS SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY ! DIGITAL. ! !++ ! FACILITY: ! DECTPU - Text Processing Utility ! EVE - Extensible Versatile Editor ! ! ABSTRACT: ! This is the EVE interface source program that handles terminal ! I/O including prompting, outputting messages, and reading keys. ! ! ENVIRONMENT: ! OpenVMS VAX, OpenVMS AXP, RISC/ULTRIX ! ! MODIFIED BY: ! RAM 01-NOV-1994 Correct listing of key GOLD-SPACE and GOLD-'. !-- ! EVE$TERMINALS.TPU Page 2 !++ ! Table of Contents ! ! EVE$TERMINALS.TPU ! 31-DEC-1992 12:16 ! ! Procedure name Page Description ! -------------- ---- ------------ ! ! eve$set_message_window_size 3 set message window size ! eve$set_command_window_size 4 set command window size ! eve$get_message_window_size 4 as currently displayed ! eve$get_command_window_size 4 as currently displayed ! eve$$restore_position 4 Restore [window and] mark ! eve$learn_abort 5 Stop any REPEATs and any LEARN SEQUENCEs ! eve$severity 6 Get the message severity level ! eve$clear_message 6 Output a null message ! eve$set_message 6 set the default message ! eve$message 7 Output a msg with error/warning flash ! eve$$get_do_keys 8 return longest string of printable DO keys ! eve$current_key_map_list 9 Current <> filter key_map_lists ! eve$lookup_comment 10 Get trimmed L.C. key comment-V1 ! eve$$lookup_comment 11 Get trimmed L.C. key comment ! eve$$parse_comment 12 Get facility legend and topic ! eve$cursor_is_free 13 Is the cursor in "no-man's land"? ! eve$prompt_key 14 Prompt for a single key ! eve$prompt_number 15 Prompt for a number ! eve$prompt_string 16 Prompt for a string ! eve$prompt_line 17 Prompt for a line ! eve$$prompt_post_filter 18 Clean up after a prompt key ! eve$insist_y_n 19 Get a yes/no answer ! eve$in_prompt 20 Test if cursor is in [command|prompt] buffer prompt ! eve$in_prompting_window 21 Test if cursor's in a prompting window ! eve$move_prompt_end 22 Move to end of [command|prompt] buffer prompt ! eve$key_name 23 Make a key-name printable ! eve$unknown_key 24 Names of non-DEC keys ! eve$$engraved_names 24 Special case E1-E6 ! eve$$remove_word 25 remove a word ! eve$undefined_key 26 executed for undefined keys ! eve$$mouse_button_number 27 Which button? ! eve$is_mouse 28 See if the key is a mouse key ! eve$is_mouse_down 29 See if the key is a mouse down key ! eve$is_mouse_up 30 See if the key is a mouse up key ! eve$is_mouse_drag 31 See if the key is a mouse drag key ! eve$is_mouse_click 32 See if the key is a mouse click key ! eve$is_mouse_motion 33 See if mouse button matches the motion ! eve$$strip_modifiers 34 Return modifiers of this key ! eve$$not_mixed_mouse_modifiers 35 Enforce sticky modifiers ! eve$create_terminator 36 New entry in array ! eve$add_terminator 37 Add a terminator to structure ! eve$test_terminator 38 Is string a term key? ! eve$remove_terminator 39 Remove a term. string ! eve$set_keypad_gold 40 Store a keypad's GOLD key ! eve$set_keypad_gold_off 41 Remove a keypad's gold key ! eve$set_user_gold 42 Turn on or shut off a user gold key. ! eve$$create_gold_key_array 43 insure gold key array exists ! eve$$if_user_gold_key 44 Test if SET GOLD KEY is active ! eve$$restore_keypad_gold_key 45 Restore current keypad's gold key ! eve$$redefine_gold_key 46 define a new one ! eve$$undefine_key 46 EVE's version of the builtin ! eve$$not_gold_key 47 User pressed inactive keypad gold key ! eve$on_a_pre_lk201 48 Test if on a pre-LK201 keyboard ! eve$current_keypad 49 Determine the current keypad ! eve$alphabetic 50 Test if a key is a printing character ! eve$cleanse_string 51 Remove whitespace from string ! eve$$add_do_key 52 Add a DO key to the array ! eve$$redefine_do_key 53 Try to redefine a DO key ! eve$$define_key 54 Define a key (with comment) ! eve$$get_next_word 55 strips word off front of sentence ! eve$$parse_keystring 56 key as string => keyword ! eve$set_gold_key 57 Set the gold key ! eve$set_shift_key 57 For V2.0 compatibility ! eve$set_nogold_key 58 Actually remove any GOLD key ! eve$remember_tpu_gold 59 Save set(shift_key,...) gold key ! eve$restore_tpu_gold 59 Restore set(shift_key,...) gold key ! eve$set_noshift_key 60 For V2.0 compatibility ! eve$vt100_keys 61 Define numeric keypad for VT100s ! eve$init_do_key 62 Make sure there is a DO key ! eve$set_keypad 63 Change the keypad layout ! eve$set_function_keys 64 Change the function-keys ! eve$test_synonym 65 Test for an EVE command synonym ! eve$key_map_list_exists 66 Is there one already? ! eve$key_map_exists 66 Is there one already? ! eve$$save_settings 67 Save GOLD and DO keys ! eve$set_key_procedure 68 Set a pre-key or post-key procedure ! eve$$pre_key_dispatcher 69 Execute pre-key procedures ! eve$$post_key_dispatcher 70 Execute post-key procedures ! eve$$parse_key_with_modifier 71 called by eve$$parse_keystring ! eve$$parse_unmodified_key 72 assume no modifiers in input ! eve$$parse_unknown_key 73 names of style "xxx(999)" ! eve$$lookup_modifier 74 called by eve$$parse_keystring ! eve$$lookup_key 75 called by eve$$parse_keystring ! eve$$lookup_string_table 76 lookup into a single long string ! eve$$filter_key 77 Filter user-entered keys !-- ! EVE$TERMINALS.TPU Page 3 procedure eve$set_message_window_size ! set message window size (window_size) local max_size; ! If the old size is unspecified, then just record the new size and leave if eve$$x_message_window_size = tpu$k_unspecified then eve$$x_message_window_size := window_size; return; endif; ! Minimum message window size is 1 line if window_size < 1 then eve$message (EVE$_MESSTOOSMALL, 0); return; endif; ! If the size hasn't changed, then ignore the request if window_size = eve$$x_message_window_size then return; endif; ! Set the four new/old size/width variables so that they can be used in the ! calculations for maximum message window heights. eve$$x_resize_new_length := get_info (SCREEN, "visible_length"); eve$$x_resize_new_width := get_info (SCREEN, "width"); eve$$x_resize_old_length := eve$$x_resize_new_length; eve$$x_resize_old_width := eve$$x_resize_new_width; ! The maximum window size is such that the new message window length plus the ! old command window length plus the cct_overhead plus 2 for decwindows is ! met. See the routine EVE$$RESIZE_HANDLER for the calculation of minimum ! height. max_size := eve$$x_resize_old_length - eve$$k_minimum_cct_height - eve$$x_command_window_size; if eve$x_decwindows_active then max_size := max_size - 2; endif; if window_size > max_size then eve$message (EVE$_MESSTOOBIG, 0); return; endif; eve$$x_message_window_size := window_size; ! Commit the new size if get_info (message_window, "type") = WINDOW then eve$$resize_handler; ! Resize the windows if they already exist endif; endprocedure; ! eve$set_message_window_size ! EVE$TERMINALS.TPU Page 4 procedure eve$set_command_window_size ! set command window size (window_size) local max_size; ! If the old size is unspecified, then just record the new size and leave if eve$$x_command_window_size = tpu$k_unspecified then eve$$x_command_window_size := window_size; return; endif; ! Minimum command window size is 1 line if window_size < 1 then eve$message (EVE$_COMMTOOSMALL, 0); return; endif; ! If the size hasn't changed, then ignore the request if window_size = eve$$x_command_window_size then return; endif; ! Set the four new/old size/width variables so that they can be used in the ! calculations for maximum command window heights. eve$$x_resize_new_length := get_info (SCREEN, "visible_length"); eve$$x_resize_new_width := get_info (SCREEN, "width"); eve$$x_resize_old_length := eve$$x_resize_new_length; eve$$x_resize_old_width := eve$$x_resize_new_width; ! The maximum window size is such that the new command window length plus the ! old message window length plus the cct_overhead plus 2 for decwindows is ! met. See the routine EVE$$RESIZE_HANDLER for the calculation of minimum ! height. max_size := eve$$x_resize_old_length - eve$$k_minimum_cct_height - eve$$x_command_window_size; if eve$x_decwindows_active then max_size := max_size - 2; endif; if window_size > max_size then eve$message (EVE$_COMMTOOBIG, 0); return; endif; eve$$x_command_window_size := window_size; ! Commit the new size if get_info (eve$command_window, "type") = WINDOW then eve$$resize_handler; ! Resize the windows if they already exist endif; endprocedure; ! eve$set_command_window_size procedure eve$get_message_window_size ! as currently displayed if eve$$x_message_window_size = tpu$k_unspecified then eve$$x_message_window_size := 1; ! EVE default size is 1 endif; return (eve$$x_message_window_size); endprocedure; ! eve$get_message_window_size procedure eve$get_command_window_size ! as currently displayed ! get the size of the command window if eve$$x_command_window_size = tpu$k_unspecified then eve$$x_command_window_size := 1; ! EVE default is 1 endif; return (eve$$x_command_window_size); endprocedure; ! eve$get_command_window_size procedure eve$$restore_position ! Restore [window and] mark (the_window; the_marker) ! Parameters can be either marker or window, marker. case get_info (the_window, "type") [WINDOW]: if the_window <> tpu$k_unspecified then if not get_info (the_window, "visible") then if get_info (the_window, "buffer") <> 0 then map (the_window, get_info (the_window, "buffer")); else return; endif; endif; position (the_window); endif; [MARKER]: position (the_window); [OTHERWISE]: endcase; if the_marker <> tpu$k_unspecified then position (the_marker); endif; endprocedure; ! eve$$restore_position ! EVE$TERMINALS.TPU Page 5 procedure eve$learn_abort ! Stop any REPEATs and any LEARN SEQUENCEs eve$init_repeat; ! Init the REPEAT variables if learn_abort then eve$message (EVE$_LEARNABORT); return (TRUE); else return (FALSE); endif; endprocedure; ! eve$learn_abort ! EVE$TERMINALS.TPU Page 6 procedure eve$severity ! Get the message severity level (the_error) ! Procedure to get the severity level from a message id return int (the_error) and 7; endprocedure; ! eve$severity procedure eve$clear_message ! Output a null message local saved_window, saved_mark, quiet_lines, null_message, saved_bell_mode; on_error [TPU$_CONTROLC]: eve$$restore_position (saved_window, saved_mark); eve$learn_abort; abort; [OTHERWISE]: eve$$restore_position (saved_window, saved_mark); endon_error; ! ! Save the current position ! saved_window := current_window; saved_mark := mark (FREE_CURSOR); ! ! Set null_message to 1 if the message is of datatype string and the string is ! the null string. Otherwise, null_message will be set to 0. ! if ((get_info (eve$$x_default_message, "type") = STRING) and (eve$$x_default_message = "")) then null_message := 1; else null_message := 0; endif; ! ! Loop to execute eve$$x_message_window_size - 1 quiet messages. Adjust the ! counter to execute the loop one additional time if the default message is ! a null message. ! quiet_lines := eve$$x_message_window_size + null_message - 1; if quiet_lines <> 0 then saved_bell_mode := get_info (SYSTEM, "bell"); set (BELL, ALL, OFF); loop exitif quiet_lines = 0; message (""); quiet_lines := quiet_lines - 1; endloop; if get_info (saved_bell_mode, "type") = KEYWORD then set (BELL, saved_bell_mode, ON); endif; endif; ! ! Conditionally issue the message if it is not null. ! if (null_message = 0) then eve$message (eve$$x_default_message); ! capitalizes plus converts ! keywords/integers to strings case get_info (eve$$x_default_message, "type") [KEYWORD, INTEGER]: position (end_of (tpu$x_message_buffer)); move_vertical (-1); eve$$x_default_message := current_line; ! make it a string now eve$$restore_position (saved_window, saved_mark); endcase; endif; endprocedure; ! eve$clear_message ! procedure eve$set_message ! set the default message (the_message) on_error [OTHERWISE]: eve$$x_default_message := ""; endon_error; case get_info (the_message, "type") [STRING, KEYWORD, INTEGER]: eve$$x_default_message := the_message; [OTHERWISE]: eve$$x_default_message := ""; endcase; eve$clear_message; return (TRUE); endprocedure; ! eve$set_message ! EVE$TERMINALS.TPU Page 7 procedure eve$message ! Output a msg with error/warning flash (message_arg; severity_or_flag_arg, arg_1, arg_2, arg_3, arg_4, arg_5, arg_6, arg_7, arg_8, arg_9, arg_10) local severity_or_flag; severity_or_flag := severity_or_flag_arg; if severity_or_flag = tpu$k_unspecified then case get_info (message_arg, "type") [INTEGER, KEYWORD]: severity_or_flag := 0; [STRING]: severity_or_flag := eve$k_informational; endcase; endif; if eve$$x_state_array {eve$$k_in_init_file} ! no success/informat. in /INIT then if (severity_or_flag = eve$k_informational) or (severity_or_flag = eve$k_success) then return; endif; if severity_or_flag = 0 then case get_info (message_arg, "type") [INTEGER, KEYWORD]: if (eve$severity (message_arg) = eve$k_success) or (eve$severity (message_arg) = eve$k_informational) then return; endif; [STRING]: return; endcase; endif; endif; message (message_arg, severity_or_flag, arg_1, arg_2, arg_3, arg_4, arg_5, arg_6, arg_7, arg_8, arg_9, arg_10); endprocedure; ! eve$message ! EVE$TERMINALS.TPU Page 8 procedure eve$$get_do_keys ! return longest string of printable DO keys (length_of_space) ! This procedure will return the longest string of printable DO keys separated ! by commas for display with help. The length of the string will be less than or ! equal to the length_of_space available in the help screen. local the_key_map_list, ! the current key map temp_key_map, ! temporary for walking thru the key map list temp_do_key, ! current DO key in array string temp_key, ! keyname temp_index, ! index of space string_length, ! length of string temp_string, ! temp string for holding DO keys string_do_keys; ! string of DO keys returned on_error [OTHERWISE]: endon_error; the_key_map_list := eve$current_key_map_list; temp_key_map := get_info (KEY_MAP, "first", the_key_map_list); temp_string := ""; loop exitif temp_key_map = 0; if eve$$x_do_key_array {temp_key_map} <> tpu$k_unspecified then temp_string := temp_string + eve$$x_do_key_array {temp_key_map}; endif; temp_key_map := get_info (KEY_MAP, "next", the_key_map_list); endloop; string_do_keys := ""; loop exitif temp_string = ""; temp_index := index (temp_string, " "); temp_do_key := substr (temp_string, 1, temp_index - 1); temp_string := substr (temp_string, temp_index + 1, length (temp_string) - temp_index); if (length (temp_do_key) + length (string_do_keys)) <= length_of_space then temp_key := eve$$parse_keystring (temp_do_key); if eve$test_synonym ("do", eve$$lookup_comment (temp_key, the_key_map_list)) then string_do_keys := string_do_keys + temp_do_key + ", "; endif; endif; endloop; return (substr (string_do_keys, 1, length (string_do_keys) - 2)); endprocedure; ! eve$$get_do_keys ! EVE$TERMINALS.TPU Page 9 procedure eve$current_key_map_list ! Current <> filter key_map_lists (; which_buffer) ! Return the passed or current buffer's key_map_list, filtering out the command ! and help buffers' special key_map_lists. local this_key_map_list; on_error [TPU$_NOCURRENTBUF]: return eve$x_key_map_list; [OTHERWISE]: endon_error; if which_buffer <> tpu$k_unspecified then this_key_map_list := get_info (which_buffer, "key_map_list"); else this_key_map_list := get_info (current_buffer, "key_map_list"); endif; if (this_key_map_list = eve$x_command_key_map_list) or ! filter out bad kml's (this_key_map_list = eve$x_help_key_map_list) then this_key_map_list := eve$x_key_map_list; endif; return this_key_map_list; endprocedure; ! eve$current_key_map_list ! ! EVE$TERMINALS.TPU Page 10 procedure eve$lookup_comment ! Get trimmed L.C. key comment-V1 (this_key) ! Provide this procedure for backwards eve$lookup_comment compatibility. ! The old procedure header comment follows: ! ! Lookup a comment for a key, trimming any leading spaces which may be ! used by Eve to differentiate between Eve- and user-defined keys. ! Returns the string with the trimmed comment. ! ! Parameters: ! ! this_key ! Keyword of key to lookup - input return (eve$$lookup_comment (this_key, "")); endprocedure; ! eve$lookup_comment ! EVE$TERMINALS.TPU Page 11 procedure eve$$lookup_comment ! Get trimmed L.C. key comment ! Lookup a comment for a key, trimming and compressing spaces and putting ! it into lower-case. Used to determine the function that is bound to a ! key disregarding minor formatting of the comment. ! ! Returns the string with the trimmed comment. ! ! Parameters: ! ! this_key ! Keyword of key to lookup - input ! which_key_map_list ! Key-map list to look it up in (this_key, which_key_map_list) local key_topic, ! String containing key comment to be returned key_facility, ! The facility code -- ignored key_legend, ! The legend -- ignored this_key_map_list; ! The key-map list to use on_error [OTHERWISE]: ; endon_error; this_key_map_list := which_key_map_list; if this_key_map_list = "" then this_key_map_list := eve$current_key_map_list; endif; eve$$parse_comment (this_key, this_key_map_list, key_facility, key_legend, key_topic); edit (key_topic, COMPRESS, TRIM, LOWER, OFF); if eve$test_synonym ("do", key_topic) ! need legend for DO then edit (key_legend, COMPRESS, TRIM, LOWER, OFF); return (key_legend); else return (key_topic); endif; endprocedure; ! eve$$lookup_comment ! ! EVE$TERMINALS.TPU Page 12 procedure eve$$parse_comment ! Get facility legend and topic (which_key, which_key_map_list, facility, legend, topic) local ptr, ! Index of various separators ptr1, ! Index of ")" the_key, ! local copy of which_key temp, ! String temporary the_text, ! The comment associated with the key shiftkey, ! literal associated with the key this_key_map_list; ! The key-map list to use on_error [OTHERWISE]: endon_error; the_key := which_key; this_key_map_list := which_key_map_list; if this_key_map_list = "" then this_key_map_list := eve$current_key_map_list; endif; case get_info (the_key, "type") [KEYWORD]: if (int (the_key) = 0) and (the_key = last_key) ! if in init file then ! before key press the_key := RET_KEY; endif; the_text := lookup_key (the_key, COMMENT, this_key_map_list); [STRING]: the_text := the_key; [OTHERWISE]: facility := ""; legend := ""; topic := ""; return (FALSE); endcase; edit (the_text, COMPRESS, TRIM, OFF); if (the_text = "") then if (the_key = get_info (this_key_map_list, "shift_key")) then facility := ""; shiftkey := message_text (EVE$_GOLD, 1); legend := shiftkey; topic := shiftkey; else facility := ""; legend := ""; topic := ""; return (FALSE); endif; else ptr := index (the_text, " "); if (ptr <> 0) then facility := substr (the_text, 1, ptr - 1); else facility := ""; endif; edit (facility, LOWER, TRIM, OFF); temp := eve$get_help_item (eve$k_help_facility, facility); if (temp = "") then facility := ""; ptr := 0; ! no facility, everything's the topic else ! reject special help facilities if (temp = eve$get_help_item (eve$k_help_facility, "set")) or (temp = eve$get_help_item (eve$k_help_facility, "get")) then facility := ""; ptr := 0; ! no facility, everything's the topic else facility := temp; endif; endif; ptr1 := index (the_text, ")"); ! ensure nothing after ")" if (ptr1 <> 0) then the_text := substr (the_text, 1, ptr1); endif; topic := substr (the_text, ptr + 1, 9999); ptr := index (topic, "("); if (ptr <> 0) then legend := substr (topic, ptr + 1, 9999); topic := substr (topic, 1, ptr - 1); ptr := index (legend, '")'); if (ptr = 0) ! for menu extension stuff - then ! need to drop last ) for listbox legend := substr (legend, 1, length (legend) - 1); endif; else legend := topic; endif; edit (topic, TRIM, LOWER, OFF); edit (legend, TRIM, OFF); if (facility = "") then facility := eve$get_help_item (eve$k_help_facility, "eve"); endif; return (TRUE); endif; endprocedure; ! eve$$parse_comment ! EVE$TERMINALS.TPU Page 13 procedure eve$cursor_is_free ! Is the cursor in "no-man's land"? return (not (get_info (current_buffer, "bound"))); endprocedure; ! eve$cursor_is_free ! ! EVE$TERMINALS.TPU Page 14 procedure eve$prompt_key ! Prompt for a single key (prompt; allow_flag) ! Prompts for a single key; returns keyword for that key or array depending ! upon optional second argument. ! ! Parameters: ! prompt = Text of prompt - input ! allow_flag = Longword bit map for allowed input keys - optional input ! Bit Value Meaning ! 0 1 Allow mouse keys in user windows, and return an array: ! {0} = eve$k_user_window ! {1} = keyword for mouse key, caller ! must test for valid keys ! 1-31 - Reserved ! Return value: ! keyword = keyword of key pressed (not a mouse key) ! array = allow_flag is valid and user pressed mouse in user window ! false = error, or mouse pressed in non-user window local this_key, ! Keyword of key read after prompt saved_window, saved_mark, temp_array, the_window, the_column, the_row, the_key; on_error [TPU$_CONTROLC]: if get_info (eve$prompt_window, "buffer") <> 0 then unmap (eve$prompt_window); endif; eve$$restore_position (saved_window, saved_mark); eve$learn_abort; abort; [TPU$_READABORTED]: if get_info (eve$prompt_window, "buffer") <> 0 then unmap (eve$prompt_window); endif; eve$$restore_position (saved_window, saved_mark); eve$message (EVE$_READABORTED); return; [OTHERWISE]: if get_info (eve$prompt_window, "buffer") <> 0 then unmap (eve$prompt_window); endif; eve$$restore_position (saved_window, saved_mark); endon_error; saved_window := current_window; saved_mark := mark (FREE_CURSOR); if get_info (eve$prompt_window, "buffer") <> 0 then eve$message (EVE$_ALRPROMPTING); update (message_window); eve$learn_abort; return (FALSE); endif; map (eve$prompt_window, eve$prompt_buffer); erase (eve$prompt_buffer); position (end_of (eve$prompt_buffer)); copy_text (prompt); update (eve$prompt_window); this_key := read_key; unmap (eve$prompt_window); position (saved_window); position (saved_mark); if eve$is_mouse (this_key) then if allow_flag <> tpu$k_unspecified then case allow_flag [1]: if locate_mouse (the_window, the_column, the_row) then temp_array := create_array; if (the_row = 0) or ! any status line (eve$$get_window_number (the_window) = 0) ! EVE system window then temp_array {0} := eve$k_status_line; else temp_array {0} := eve$k_user_window; temp_array {1} := this_key; endif; return (temp_array); else return (FALSE); endif; [OTHERWISE]: eve$message (EVE$_ILLEGAL2NDARG, 0, "EVE$PROMPT_KEY"); return (FALSE); endcase; endif; endif; return (this_key); endprocedure; ! eve$prompt_key ! EVE$TERMINALS.TPU Page 15 procedure eve$prompt_number ! Prompt for a number (old_number, new_number, prompt_string, no_value_message) ! Procedure used by commands which prompt for integers. ! Returns true if prompting worked or was not needed, false otherwise. ! ! Parameters: ! ! old_number Old integer value - input ! new_number New integer value - output ! prompt_string Text of prompt - input ! no_value_message Message printed if user hits Return to ! get out of the command - input local read_line_string; ! String read after prompt new_number := old_number; if get_info (new_number, "type") = STRING then if new_number = "" then new_number := eve$k_no_arg; else translate (new_number, "1", "l"); edit (new_number, TRIM); new_number := int (new_number); endif; endif; if new_number = eve$k_no_arg then read_line_string := eve$prompt_line (prompt_string, eve$$x_prompt_terminators, ""); if read_line_string = 0 then return (FALSE); endif; eve$cleanse_string (read_line_string); if read_line_string = "" then eve$message (no_value_message); eve$prompt_number := FALSE; else translate (read_line_string, "1", "l"); new_number := int (read_line_string); if (new_number = 0) and (read_line_string <> "0") then eve$message (EVE$_DONTUNDER, 0, read_line_string); eve$prompt_number := FALSE; else eve$prompt_number := TRUE; endif; endif; else eve$prompt_number := TRUE; endif; return; endprocedure; ! eve$prompt_number ! EVE$TERMINALS.TPU Page 16 procedure eve$prompt_string ! Prompt for a string (old_string, new_string, prompt_string, no_value_message) ! Procedure used by commands which prompt for strings. ! Returns true if prompting worked or was not needed, false otherwise. ! ! Parameters: ! ! old_string Old string value - input ! new_string New string value - output ! prompt_string Text of prompt - input ! no_value_message Message printed if user hits Return to ! get out of the command - input eve$$x_state_array {eve$$k_prompt_flag} := FALSE; new_string := old_string; if old_string = "" then new_string := eve$prompt_line (prompt_string, eve$$x_prompt_terminators, ""); if new_string = 0 then return (FALSE); endif; if new_string = "" then eve$message (no_value_message); return (0); else eve$$x_state_array {eve$$k_prompt_flag} := TRUE; return (1); endif; else return (1); endif; endprocedure; ! eve$prompt_string ! EVE$TERMINALS.TPU Page 17 procedure eve$prompt_line ! Prompt for a line (prompt, ! Text of prompt - input terminator_mask; ! Integer index into eve$$x_terminator_array, ! or keyword HELP (see above) - input initial_reply) ! Initial reply to put after the prompt ! (for ambiguous cmd help topics) ! Description: ! Prompts for a line of text: ! 1. terminator_mask is of type integer (pointing to an element in ! eve$$x_terminator_array containing key comment strings for this ! group of terminator keys). ! Does multiple read_key's using the specified terminator_mask. ! This allows FIND to change its direction prompt with the ! F11 key (which is not a read_line terminator in VMS). ! 2. terminator_mask = keyword HELP ! Does multiple read_key's with all non-printing keys being ! terminators except for DELETE which is the only line-editing key. ! This allows keypad help to read in a string for passing to ! command help. ! This procedure replaces EVE's use of READ_LINE. ! Returned Value: ! The string entered by the user (user can use last_key to get the ! terminator). local recall_line, ! Recalled string temp_string, ! Returned string saved_window, ! Original window saved_mark, ! Original position this_key, ! Keyword of key read after prompt local_mask, ! Local copy of terminator_mask local_reply, ! Local copy of initial_reply facility, ! Key's facility legend, ! Key's keypad diagram legend topic; ! Key's comment on_error [TPU$_CONTROLC]: if get_info (eve$prompt_window, "buffer") <> 0 then unmap (eve$prompt_window); endif; eve$$restore_position (saved_window, saved_mark); eve$learn_abort; abort; [TPU$_READABORTED]: if get_info (eve$prompt_window, "buffer") <> 0 then unmap (eve$prompt_window); endif; eve$$restore_position (saved_window, saved_mark); eve$message (EVE$_READABORTED); return; [OTHERWISE]: if get_info (eve$prompt_window, "buffer") <> 0 then unmap (eve$prompt_window); endif; eve$$restore_position (saved_window, saved_mark); endon_error; if get_info (eve$prompt_window, "buffer") <> 0 then eve$message (EVE$_ALRPROMPTING); return (FALSE); endif; saved_window := current_window; saved_mark := mark (FREE_CURSOR); position (end_of (eve$recall_line_buffer)); ! Only to set the position map (eve$prompt_window, eve$prompt_buffer); erase (eve$prompt_buffer); position (end_of (eve$prompt_buffer)); copy_text (prompt); eve$x_prompt := prompt; eve$x_prompt_length := length (prompt); move_horizontal (-1); eve$$x_the_prompt_range := create_range (beginning_of (eve$prompt_buffer), mark (NONE), NONE); ! prompt window is reverse position (LINE_END); if initial_reply <> eve$k_no_arg then local_reply := initial_reply; edit (local_reply, TRIM); copy_text (local_reply); endif; update (eve$prompt_window); if terminator_mask = HELP then ! ! Allow printing characters to be inserted into the buffer, ! and let DEL be the only line-editing character. loop this_key := read_key; if eve$is_mouse (this_key) then eve$message (EVE$_NOMOUSEINPROMPT); else temp_string := (substr (current_line, length (prompt) + 1, 999)); ! test for a PRINTING key (not ALT-modified or defined) if (ascii (this_key) <> ascii (0)) and (lookup_key (this_key, PROGRAM) = 0) then if current_offset < eve$x_prompt_length then ! don't let chars be put into the prompt move_horizontal (eve$x_prompt_length - current_offset); endif; execute (this_key, eve$x_key_map_list); ! insert a printable key eve$$prompt_post_filter; else if temp_string = "" then unmap (eve$prompt_window); ! No response = exit help or get help ! on a non-printable key. eve$$restore_position (saved_window, saved_mark); return (""); else eve$$parse_comment (this_key, "", facility, legend, topic); if eve$test_synonym ("delete", topic) then execute (this_key); eve$$prompt_post_filter; else if get_info (eve$prompt_window, "buffer") <> 0 then unmap (eve$prompt_window); ! A terminator, return. endif; eve$$restore_position (saved_window, saved_mark); return (temp_string); endif; endif; endif; endif; update (eve$prompt_window); endloop; else ! test terminator mask for valid index into array of all terminator groups local_mask := eve$$x_terminator_array {terminator_mask}; edit (local_mask, TRIM, COMPRESS, LOWER, OFF); loop this_key := read_key; eve$$parse_comment (this_key, "", facility, legend, topic); temp_string := (substr (current_line, length (prompt) + 1, 999)); ! handle typing keys and DEL first for speed (no post key processing) if ((ascii (this_key) <> ascii (0)) and ! PRINTING (not defined (lookup_key (this_key, PROGRAM) = 0)) or ! or ALT-modified) ((eve$test_synonym ("delete", topic)) and ! DELETE (temp_string <> "") and (current_offset > eve$x_prompt_length)) ! not in the prompt then execute (this_key, eve$x_key_map_list); update (eve$prompt_window); else if topic <> "" then ! don't call eve$test_terminator here for speed !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!! SYNC WITH EVE$TEST_TERMINATOR !!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! exitif index (" " + local_mask + " ", " " + topic + " ") <> 0; ! hit a terminator if index (" " + eve$$x_terminator_array {eve$$x_recall_terminators} + " ", " " + topic + " ") <> 0 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!! END OF SYNC !!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! then position (eve$recall_line_buffer); if index (eve$$x_terminator_array {eve$$x_recall_up_terminators}, topic) <> 0 then if mark (NONE) <> beginning_of (current_buffer) then move_vertical (-1); else if eve$x_recall_round then position (end_of (current_buffer)); endif; endif; else if mark (NONE) <> end_of (current_buffer) then move_vertical (1); else if eve$x_recall_round then position (beginning_of (current_buffer)); endif; endif; endif; if mark (NONE) = end_of (current_buffer) then recall_line := ""; else recall_line := current_line; endif; position (eve$prompt_buffer); ! post-key will clean up prompt erase_line; copy_text (recall_line); else execute (this_key, eve$x_key_map_list); endif; else ! execute printable user-defined key (null comment) if eve$is_mouse (this_key) then eve$message (EVE$_NOMOUSEINPROMPT); else execute (this_key, eve$x_key_map_list); endif; endif; ! Clean up after executing the key: ! 1. exit if it unmapped the prompt_window or positioned to ! another buffer ! 2. put cursor @end of 1st line if > 1 line inserted into prompt buf if get_info (eve$prompt_window, "buffer") = 0 then eve$$restore_position (saved_window, saved_mark); return; endif; if current_buffer <> eve$prompt_buffer then unmap (eve$prompt_window); eve$$restore_position (saved_window, saved_mark); return; endif; if (get_info (eve$prompt_buffer, "record_count") > 1) or (mark (NONE) = end_of (eve$prompt_buffer)) then position (beginning_of (eve$prompt_buffer)); position (LINE_END); endif; eve$$prompt_post_filter; update (eve$prompt_window); endif; endloop; endif; temp_string := substr (current_line, eve$x_prompt_length + 1, length (current_line)); unmap (eve$prompt_window); if temp_string <> "" then position (end_of (eve$recall_line_buffer)); if mark (NONE) <> beginning_of (eve$recall_line_buffer) then move_vertical (-1); if current_line <> temp_string then move_vertical (1); copy_text (temp_string); endif; else copy_text (temp_string); endif; endif; eve$$restore_position (saved_window, saved_mark); return (temp_string); endprocedure; ! eve$prompt_line ! EVE$TERMINALS.TPU Page 18 procedure eve$$prompt_post_filter ! Clean up after a prompt key local here; if str (eve$$x_the_prompt_range) <> eve$x_prompt then here := mark (FREE_CURSOR); erase (eve$$x_the_prompt_range); position (beginning_of (eve$prompt_buffer)); ! add in prompt again - being careful if in overstrike mode eve$insert_text (eve$x_prompt); move_horizontal (-1); eve$$x_the_prompt_range := create_range (beginning_of (eve$prompt_buffer), mark (NONE), NONE); ! prompt window =reverse position (here); if mark (NONE) = end_of (current_buffer) then move_horizontal (-1); endif; else if current_offset < eve$x_prompt_length then move_horizontal (eve$x_prompt_length - current_offset); endif; endif; endprocedure; ! eve$$prompt_post_filter ! ! EVE$TERMINALS.TPU Page 19 procedure eve$insist_y_n ! Get a yes/no answer (the_prompt; initial_reply, ! initial reply (yes or no prevent prompting) default_no) ! Procedure to get a yes/no answer. A null answer defaults to eve$x_yes, ! otherwise the answer must be either eve$x_yes or eve$x_no or and abbreviation ! thereof. A key defined as EXIT defaults to no. If eve$prompt_line ! aborts, return eve$k_error; all other errors return FALSE (= eve$k_warning). local original_reply, ! String returned by read_line after prompt lower_reply; ! Lowercase version of original_reply on_error [OTHERWISE]: endon_error; ! Loop until we get a yes/no reply (or just CR for yes or EXIT key for no) if initial_reply <> tpu$k_unspecified then if initial_reply <> "" then lower_reply := initial_reply; else lower_reply := eve$prompt_line (the_prompt, eve$$x_prompt_terminators, ""); endif; else lower_reply := eve$prompt_line (the_prompt, eve$$x_prompt_terminators, ""); endif; loop if lower_reply = 0 then return (eve$k_error); endif; if eve$test_synonym ("exit", eve$$lookup_comment (last_key, eve$x_key_map_list)) then ! EXIT = no return (FALSE); endif; original_reply := lower_reply; change_case (lower_reply, LOWER); if (length (lower_reply) = 0) then if (default_no <> tpu$k_unspecified) then return (FALSE); ! CR = NO else return (TRUE); ! CR = YES endif; endif; if (lower_reply = substr (eve$x_yes, 1, length (lower_reply))) then return (TRUE); else if lower_reply = substr (eve$x_no, 1, length (lower_reply)) then return (FALSE); else eve$message (EVE$_DONTUNDERYN, 0, original_reply); endif; endif; lower_reply := eve$prompt_line (the_prompt, eve$$x_prompt_terminators, ""); endloop; return (FALSE); endprocedure; ! eve$insist_y_n ! EVE$TERMINALS.TPU Page 20 procedure eve$in_prompt ! Test if cursor is in [command|prompt] buffer prompt ! Procedure to determine if cursor is in [command|prompt] buffer prompt if not eve$in_prompting_window then return (FALSE); endif; if not (get_info (current_buffer, "bound")) then return (FALSE); endif; if mark (FREE_CURSOR) = end_of (current_buffer) then return (FALSE); endif; if (current_window = eve$command_window) then if (substr (current_line, 1, eve$x_command_prompt_length) = eve$x_command_prompt) and (current_offset <= eve$x_command_prompt_length) then return (TRUE); endif; else if (substr (current_line, 1, eve$x_prompt_length) = eve$x_prompt) and (current_offset <= eve$x_prompt_length) then return (TRUE); endif; endif; return (FALSE); endprocedure; ! eve$in_prompt ! ! EVE$TERMINALS.TPU Page 21 procedure eve$in_prompting_window ! Test if cursor's in a prompting window ! Procedure to determin if cursor is in prompting window return ((current_window = eve$command_window) or (current_window = eve$prompt_window)); endprocedure; ! eve$in_prompting_window ! ! EVE$TERMINALS.TPU Page 22 procedure eve$move_prompt_end ! Move to end of [command|prompt] buffer prompt ! Procedure to move to the end of the [command|prompt] buffer prompt. ! Assumes we're in the prompting line. if not eve$in_prompting_window then return (FALSE); endif; if mark (NONE) = end_of (current_buffer) then return (FALSE); endif; if (current_window = eve$command_window) then if (substr (current_line, 1, eve$x_command_prompt_length) = eve$x_command_prompt) then move_horizontal (eve$x_command_prompt_length - current_offset); return (TRUE); endif; else if (substr (current_line, 1, eve$x_prompt_length) = eve$x_prompt) then move_horizontal (eve$x_prompt_length - current_offset); return (TRUE); endif; endif; return (FALSE); endprocedure; ! eve$move_prompt_end ! EVE$TERMINALS.TPU Page 23 procedure eve$key_name ! Make a key-name printable (the_key) local the_string, ! string: return value: User readable string the_name, ! string: the TPU key name as a string the_modifiers, ! int: bit coded result of key_modifiers get_info the_type, ! keyword result of key_type get_info char_pointer, ! temp index into strings found_name, ! boolean set false if lookup_key fails returned_name, ! results of lookup key the_unmodified_key; ! key: the_key without modifiers on_error [TPU$_NODEFINITION]: ! Indicate lookup_key failure found_name := FALSE; endon_error; ! ! Get info about the key ! the_name := get_info (the_key, "name"); the_modifiers := get_info (the_key, "key_modifiers"); the_type := get_info (the_key, "key_type"); ! ! If the key was shifted, then init our eventual output with gold shift ! string: "GOLD-" case the_type [SHIFT_PRINTING, SHIFT_KEYPAD, SHIFT_FUNCTION, SHIFT_CONTROL]: the_string := lookup_key (key_name (eve$k_shift_key_key), COMMENT, eve$x_current_language_keymap) + eve$kt_modifier_delimiter_sequence; [OTHERWISE]: the_string := ''; endcase; ! ! Direct lookup: If we get a translation don't bother dissecting modifiers ! found_name := TRUE; returned_name := lookup_key (the_key, COMMENT, eve$x_current_language_keymap); if found_name ! Sometimes we get a hit when we shouldn't: a null string then if get_info (returned_name, "type") = STRING then if returned_name <> "" then return (the_string + returned_name); endif; endif; endif; ! ! Construct modifers string ! if the_modifiers <> 0 then if (the_modifiers and 1) <> 0 ! -- SHIFT_MODIFIED then the_string := the_string + lookup_key (key_name (eve$k_shift_modified_key), COMMENT, eve$x_current_language_keymap) + eve$kt_modifier_delimiter_standard; endif; if ((the_modifiers and 2) <> 0) ! -- CTRL_MODIFIED then the_string := the_string + lookup_key (key_name (eve$k_ctrl_modified_key), COMMENT, eve$x_current_language_keymap) + eve$kt_modifier_delimiter_standard; endif; if (the_modifiers and 4) <> 0 ! -- HELP_MODIFIED then the_string := the_string + lookup_key (key_name (eve$k_help_modified_key), COMMENT, eve$x_current_language_keymap) + eve$kt_modifier_delimiter_standard; endif; if (the_modifiers and 8) <> 0 ! -- ALT_MODIFIED then the_string := the_string + lookup_key (key_name (eve$k_alt_modified_key), COMMENT, eve$x_current_language_keymap) + eve$kt_modifier_delimiter_standard; endif; endif; ! ! Derive the keyname to display to the user ! case the_type [PRINTING, SHIFT_PRINTING]: ! -- simple printing key: display as itself ! unless we find a translation for it. ! standard translations for printing keys ! include space, and single and double quotes char_pointer := index (the_name, "'"); if char_pointer <> 0 ! key is single-quote or double-quote then if substr (the_name, char_pointer - 1, 1) = '"' then the_name := "'"; ! the key is single-quote else the_name := '"'; ! the key is a double-quote endif; else if index (the_name, "SPACE") <> 0 then the_name := " "; endif; the_name := substr (the_name, index (the_name, '"') + 1, 1); endif; found_name := TRUE; returned_name := lookup_key (key_name(the_name), COMMENT, eve$x_current_language_keymap); if found_name then if get_info (returned_name, "type") = STRING then if returned_name <> "" then the_name := returned_name; endif; endif; endif; [OTHERWISE]: ! ! Parse out the non-printing key_name ! char_pointer := index (the_name, '('); if char_pointer <> 0 then the_name := substr (the_name, char_pointer + 1, index (the_name, ',') - (char_pointer + 1)); endif; the_unmodified_key := execute ("return(key_name (" + the_name + "))"); found_name := TRUE; returned_name := lookup_key (the_unmodified_key, COMMENT, eve$x_current_language_keymap); if found_name then if get_info (returned_name, "type") = STRING then if returned_name <> "" then return (the_string + returned_name); endif; endif; endif; ! ! We didn't get a hit so cleanup the TPU keyname by getting rid ! of "_KEY" trailer and "CTRL_" header char_pointer := index (the_name, "_KEY"); if char_pointer <> 0 then the_name := substr (the_name, 1, char_pointer - 1); endif; char_pointer := index (the_name, "CTRL_"); if char_pointer = 1 then the_name := substr (the_name, 6); ! ! Add control prefix ! the_string := the_string + lookup_key (key_name (eve$k_ctrl_modified_key), COMMENT, eve$x_current_language_keymap ) + eve$kt_modifier_delimiter_standard; else case substr (the_name, 1, 1) ["1", "2", "3", "4", "5", "6", "7", "8", "9", "0"]: case the_type [SHIFT_FUNCTION, FUNCTION]: the_name := eve$unknown_key (FUNCTION, int (the_name)); [SHIFT_CONTROL, CONTROL]: the_name := eve$unknown_key (CONTROL, int (the_name)); [SHIFT_KEYPAD, KEYPAD]: the_name := eve$unknown_key (KEYPAD, int (the_name)); endcase; endcase; endif; endcase; return (the_string + the_name); endprocedure; ! eve$key_name ! EVE$TERMINALS.TPU Page 24 procedure eve$unknown_key ! Names of non-DEC keys (key_type, key_index) ! ! The following routine may be overloaded in order to convert ! the key-names correctly parsed by TPU, but not sent by DEC ! terminals and thus not known to TPU. case key_type [CONTROL]: return message_text (EVE$_UNKCONTROL, 1, key_index); [FUNCTION]: return message_text (EVE$_UNKFUNCTION, 1, key_index); [KEYPAD]: return message_text (EVE$_UNKKEYPAD, 1, key_index); endcase; endprocedure; ! eve$unknown_key procedure eve$$engraved_names ! Special case E1-E6 (the_string) ! ! The following routine may be overloaded to alter the way that ! the editing (mini-) keypad keys are displayed. (It could also be ! used for other keys such as the Fn function keys or CTRL keys.) ! case the_string ["E1"]: the_string := "FIND"; ["E2"]: the_string := "INSERT HERE"; ["E3"]: the_string := "REMOVE"; ["E4"]: the_string := "SELECT"; ["E5"]: the_string := "PREV SCREEN"; ["E6"]: the_string := "NEXT SCREEN"; endcase; endprocedure; ! eve$$engraved_names ! EVE$TERMINALS.TPU Page 25 procedure eve$$remove_word ! remove a word (the_string, the_word) local ptr; on_error [OTHERWISE]: endon_error; ptr := index (the_string, the_word); if ptr <> 0 then the_string := substr (the_string, 1, ptr - 1) + substr (the_string, ptr + length (the_word), length (the_string)); endif; return ptr <> 0; endprocedure; ! eve$$remove_word ! EVE$TERMINALS.TPU Page 26 procedure eve$undefined_key ! executed for undefined keys (the_key) local local_key; on_error [OTHERWISE]: eve$message (TPU$_NODEFINITION, 0, "", eve$key_name (local_key)); endon_error; local_key := the_key; if ascii (local_key) <> ascii (0) ! PRINTING (not ALT-modified) then if eve$$x_state_array {eve$$k_pending_delete_active} then ! Decwindows typing keys remove the select range eve$$pending_delete (1); return; endif; endif; case get_info (local_key, "key_modifiers") [0]: ! Check for CTRL/X if eve$key_name (local_key) = 'CTRL/X' ! for compatibility CCT then execute (CTRL_U_KEY); return; endif; [1, 2]: ! 1 = SHIFT_MODIFIED, 2 = CTRL_MODIFIED if (lookup_key (get_info (local_key, "unmodified"), PROGRAM) <> 0) then execute (get_info (local_key, "unmodified")); return; endif; endcase; eve$message (TPU$_NODEFINITION, 0, "", eve$key_name (local_key)); endprocedure; ! eve$undefined_key ! EVE$TERMINALS.TPU Page 27 procedure eve$$mouse_button_number (the_key) ! Which button? return get_info (the_key, "mouse_button"); endprocedure; ! eve$$mouse_button_number ! EVE$TERMINALS.TPU Page 28 procedure eve$is_mouse ! See if the key is a mouse key (this_key) ! Returns true if mouse key, false if not on_error [OTHERWISE]: endon_error; return (eve$$mouse_button_number (this_key) <> 0); endprocedure; ! eve$is_mouse ! ! EVE$TERMINALS.TPU Page 29 procedure eve$is_mouse_down ! See if the key is a mouse down key (this_key) ! Returns true if a mouse down button, false if not on_error [OTHERWISE]: endon_error; if index (get_info (this_key, "name"), "DOWN") <> 0 then return (TRUE); endif; return FALSE; endprocedure; ! eve$is_mouse_down ! EVE$TERMINALS.TPU Page 30 procedure eve$is_mouse_up ! See if the key is a mouse up key (this_key) on_error [OTHERWISE]: endon_error; if index (get_info (this_key, "name"), "UP") <> 0 then return (TRUE); endif; return FALSE; endprocedure; ! eve$is_mouse_up ! EVE$TERMINALS.TPU Page 31 procedure eve$is_mouse_drag ! See if the key is a mouse drag key (this_key) on_error [OTHERWISE]: endon_error; if index (get_info (this_key, "name"), "DRAG") <> 0 then return (TRUE); endif; return FALSE; endprocedure; ! eve$is_mouse_drag ! EVE$TERMINALS.TPU Page 32 procedure eve$is_mouse_click ! See if the key is a mouse click key (this_key) on_error [OTHERWISE]: endon_error; if index (get_info (this_key, "name"), "CLICK") <> 0 then return (TRUE); endif; return FALSE; endprocedure; ! eve$is_mouse_click ! EVE$TERMINALS.TPU Page 33 procedure eve$is_mouse_motion ! See if mouse button matches the motion (the_motion, ! string for mouse motion ("DOWN", "UP",...) the_key) ! the mouse button ! Returns true if the_key is a mouse button with the same motion as ! the_motion, e.g., the_motion = "DRAG" matches the_key = ! KEY_NAME(M1DRAG,SHIFT_MODIFIED) on_error [OTHERWISE]: endon_error; case the_motion ["DOWN"]: return (eve$is_mouse_down (the_key)); ["DRAG"]: return (eve$is_mouse_drag (the_key)); ["UP"]: return (eve$is_mouse_up (the_key)); ["CLICK", "CLICK2", "CLICK3", "CLICK4", "CLICK5"]: return (eve$is_mouse_click (the_key)); endcase; return (FALSE); endprocedure; ! eve$is_mouse_motion ! EVE$TERMINALS.TPU Page 34 procedure eve$$strip_modifiers ! Return modifiers of this key (the_key) ! Returns a string containing all keyname modifiers for the_key, or "". local the_string; !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! The following local constant MUST be synchronized with the literals in TPU !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! constant eve$kt_keyname := "KEY_NAME ("; !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! on_error [OTHERWISE]: endon_error; the_string := get_info (the_key, "name"); ! see if "key_name (" exists if eve$$remove_word (the_string, eve$kt_keyname) then ! remove trailing ")" the_string := substr (the_string, 1, length (the_string) - 1); ! remove "keyname, " the_string := substr (the_string, index (the_string, ",") + 2, length (the_string)); return (the_string); else return (""); endif; endprocedure; ! eve$$strip_modifiers ! EVE$TERMINALS.TPU Page 35 procedure eve$$not_mixed_mouse_modifiers ! Enforce sticky modifiers (the_key, ! mouse button keyname motion_name) ! motion name, e.g., "DRAG" (not "DOWN") ! If (1) the last down button (eve$$x_mouse_down_button) exists in EVE's ! eve$x_mouse_list, and (2) an EVE definition exists for the same button ! number as the_key and same motion type as motion_name - but with the down ! button's modifiers, then execute that EVE button and return false. ! Otherwise, if a user mouse definition exists for the same button ! number as the_key and same motion type as motion_name - but with the down ! button's modifiers, then execute that user button and return false. ! Otherwise, return true. ! (This allows sloppy mousing, i.e., we assume mixed mouse actions are a ! mistake, and the user really meant to hold down the same modifiers thru-out ! the entire mouse sequence.) local the_modifiers, new_button, new_motion_name, the_key_map_list; the_modifiers := eve$$strip_modifiers (the_key); if the_modifiers <> eve$$x_mouse_down_modifiers then ! Oops, sloppy mousing...enforce sticky modifier policy. ! Convert this button's keyname to down's modifiers. if eve$$x_mouse_down_modifiers <> "" then ! modifiers exist, add comma new_motion_name := motion_name + ", "; else new_motion_name := motion_name; endif; ! e.g., create "key_name(M2DRAG, SHIFT_MODIFIED, CTRL_MODIFIED)" new_button := execute ("return(key_name(M" + str (eve$$mouse_button_number (the_key)) + new_motion_name + eve$$x_mouse_down_modifiers + "))"); ! Was down button EVE's and EVE's motion_name/modified mouse exists? the_key_map_list := eve$current_key_map_list; if ! down is in mouse k_m_l (lookup_key (eve$$x_mouse_down_button, PROGRAM, eve$x_mouse_list) <> 0) and ! sticky modified button is in mouse k_m_l (lookup_key (new_button, PROGRAM, eve$x_mouse_list) <> 0) and ! down is not in user k_m_l or ((lookup_key (eve$$x_mouse_down_button, PROGRAM, the_key_map_list) = 0) or ! down = M1DOWN and is in user k_m_l (was rejected) ((lookup_key (eve$$x_mouse_down_button, PROGRAM, the_key_map_list) <> 0) and (eve$$x_mouse_down_button = M1DOWN))) then ! EVE's down button, execute EVE's motion/modified button execute (new_button, eve$x_mouse_list); return (FALSE); else ! not EVE's down button (or it was, but no like-modified EVE motion), ! look for one in user key_map_list if lookup_key (new_button, PROGRAM, the_key_map_list) <> 0 then execute (new_button, the_key_map_list); return (FALSE); endif; endif; endif; return (TRUE); ! not mixed modifier mousing endprocedure; ! eve$$not_mixed_mouse_modifiers ! EVE$TERMINALS.TPU Page 36 procedure eve$create_terminator ! New entry in array (terminator_list) ! eve$create_terminator ! Create a terminator key structure ! ! Description ! Create another element in the array containing EVE's terminator key ! groupings. Double the size of the array if we've run out of elements. ! Implicit Inputs ! eve$$x_terminator_array - an array where each element contains strings ! for all keys that are terminators for a specific EVE command group. ! eve$$x_terminator_array {0} - count of used elements in the array ! Implicit Outputs ! eve$$x_terminator_array - updated to contain new array element ! eve$$x_terminator_array {0} - incremented by 1 ! Parameters ! terminator_list - string of terminators, e.g., "advance forward" ! Return Value ! The value of eve$$x_terminator_array {0} = index of element just created local high_index, the_terminators, temp; on_error [OTHERWISE]: endon_error; ! expand the array if it's already full high_index := get_info (eve$$x_terminator_array, "high_index"); if eve$$x_terminator_array {0} = high_index then temp := create_array (1 + 10 + high_index, 0); loop exitif high_index < 0; temp {high_index} := eve$$x_terminator_array {high_index}; high_index := high_index - 1; endloop; eve$$x_terminator_array := temp; endif; the_terminators := terminator_list; edit (the_terminators, TRIM, COMPRESS, LOWER, OFF); eve$$x_terminator_array {0} := eve$$x_terminator_array {0} + 1; eve$$x_terminator_array {eve$$x_terminator_array {0}} := the_terminators; return (eve$$x_terminator_array {0}); endprocedure; ! eve$create_terminator ! EVE$TERMINALS.TPU Page 37 procedure eve$add_terminator ! Add a terminator to structure (terminator_index, the_terminator) ! eve$add_terminator ! Add a new string to terminator key structure ! ! Description ! Add another string to a terminator held in the eve$$x_terminator_array. ! Implicit Inputs ! eve$$x_terminator_array - an array where each element contains strings ! for all keys that are terminators for a specific EVE command group. ! Implicit Outputs ! eve$$x_terminator_array {terminator_index} - updated with new string ! Parameters ! terminator_index - integer index into eve$$x_terminator_array ! (output from call to eve$create_terminator) ! the_terminator - new terminator string, e.g., "go_below" ! Return Value ! true - successfully added (or it's already in the terminator structure) ! false - invalid terminator_index was specified local local_terminator; on_error [OTHERWISE]: endon_error; ! Test if the_terminator is already in the {terminator_index} element if eve$test_terminator (terminator_index, the_terminator) then return (TRUE); endif; ! Add the_terminator to the {terminator_index} element local_terminator := the_terminator; edit (local_terminator, TRIM, COMPRESS, LOWER, OFF); eve$$x_terminator_array {terminator_index} := eve$$x_terminator_array {terminator_index} + " " + local_terminator; return (TRUE); endprocedure; ! eve$add_terminator ! EVE$TERMINALS.TPU Page 38 procedure eve$test_terminator ! Is string a term key? (terminator_index, the_terminator) ! eve$test_terminator ! Test if a string equates to a terminator key ! ! Description ! See if the passed string is a terminator in the terminator key group. ! The string will be lowercased and trimmed before testing. ! Implicit Inputs ! eve$$x_terminator_array - an array where each element contains strings ! for all keys that are terminators for a specific EVE command group. ! Parameters ! terminator_index - integer index into eve$$x_terminator_array ! (output from call to eve$create_terminator) ! the_terminator - the terminator string, e.g., "progress" ! Return Value ! true - if it is a terminator ! false - if it is not a terminator local local_terminator; on_error [OTHERWISE]: endon_error; local_terminator := the_terminator; edit (local_terminator, TRIM, COMPRESS, LOWER, OFF); ! Test if the_terminator is already in the {terminator_index} element ! (add a space before and after to insure it's unambiguous) return (index (" " + eve$$x_terminator_array {terminator_index} + " ", " " + local_terminator + " ") > 0); endprocedure; ! eve$test_terminator ! EVE$TERMINALS.TPU Page 39 procedure eve$remove_terminator ! Remove a term. string (terminator_index, the_terminator) ! eve$remove_terminator ! Remove a string from a terminator structure ! ! Description ! Remove a string from a terminator group held in an element in ! eve$$x_terminator_array. ! Implicit Inputs ! eve$$x_terminator_array - an array where each element contains strings ! for all keys that are terminators for a specific EVE command group. ! Implicit Outputs ! eve$$x_terminator_array {terminator_index} - updated string removed ! Parameters ! terminator_index - integer index into eve$$x_terminator_array ! (output from call to eve$create_terminator) ! the_terminator - the terminator string, e.g., "progress" ! Return Value ! true - successfully removed ! false - invalid terminator_index, or it wasn't a terminator local the_index, term_length, elem_length, local_terminator; on_error [OTHERWISE]: endon_error; ! Test if the_terminator is already in the {terminator_index} element if not eve$test_terminator (terminator_index, the_terminator) then return (FALSE); endif; ! Remove the_terminator from the {terminator_index} element local_terminator := the_terminator; edit (local_terminator, TRIM, COMPRESS, LOWER, OFF); the_index := index (" " + eve$$x_terminator_array {terminator_index} + " ", " " + local_terminator + " "); term_length := length (local_terminator); elem_length := length (eve$$x_terminator_array {terminator_index}); eve$$x_terminator_array {terminator_index} := substr (eve$$x_terminator_array {terminator_index}, 1, the_index - 1) + substr (eve$$x_terminator_array {terminator_index}, the_index + term_length, elem_length - term_length); edit (eve$$x_terminator_array {terminator_index}, TRIM, COMPRESS, OFF); return (TRUE); endprocedure; ! eve$remove_terminator ! EVE$TERMINALS.TPU Page 40 procedure eve$set_keypad_gold ! Store a keypad's GOLD key (the_keypad; the_key) ! Description ! Set a keypad gold key, synchronizing with both the gold key array and ! eve$current_keypad. ! Parameters: ! the_keypad = keypad containing the gold key ! the_key = keypad's gold key (TPU$K_UNSPECIFIED if no gold key) local temp_key, temp_keypad; on_error [OTHERWISE]: endon_error; eve$$create_gold_key_array; ! insure it exists ! user is doing either ! 1. SET KEYPAD VT100/NUMERIC, ! 2. SET KEYPAD XXX ! if other non-user keypad has a gold key that was defined, then undefine it if (the_keypad <> eve$$x_gold_keys {eve$x_keypad}) and (eve$$x_gold_keys {eve$x_keypad} <> tpu$k_unspecified) then ! remove the other non-user keypad temp_keypad := eve$$x_gold_keys {eve$x_keypad}; temp_key := eve$$x_gold_keys {temp_keypad}; eve$$undefine_key (temp_key, temp_keypad); eve$$x_gold_keys {temp_keypad} := tpu$k_unspecified; eve$$x_gold_keys {eve$x_keypad} := tpu$k_unspecified; endif; if the_key = tpu$k_unspecified then ! user is doing SET KEYPAD VT100/NUMERIC if not eve$$if_user_gold_key then eve$set_nogold_key; ! No user GOLD key, ok to remove gold key endif; return (TRUE); else ! user is doing SET KEYPAD XXX eve$$x_gold_keys {eve$x_keypad} := the_keypad; eve$$x_gold_keys {the_keypad} := the_key; ! may = TPU$K_UNSPECIFIED ! if there already is a user gold, redefine the keypad's gold key if eve$$if_user_gold_key then eve$$redefine_gold_key (the_key, the_keypad); else ! give them a gold key if not int (eve$set_gold_key (the_key, the_keypad)) then eve$$x_gold_keys {eve$x_keypad} := tpu$k_unspecified; eve$$x_gold_keys {the_keypad} := the_key; return (FALSE); endif; endif; endif; return (TRUE); endprocedure; ! eve$set_keypad_gold ! EVE$TERMINALS.TPU Page 41 procedure eve$set_keypad_gold_off ! Remove a keypad's gold key (the_keypad) ! keypad containing the gold key ! If a keypad had a gold key that was defined then undefine it. local temp_key, temp_keypad; on_error [OTHERWISE]: endon_error; eve$$create_gold_key_array; ! insure it exists temp_key := eve$$x_gold_keys {the_keypad}; eve$$undefine_key (temp_key, the_keypad); eve$$x_gold_keys {eve$x_keypad} := tpu$k_unspecified; if not eve$$if_user_gold_key then eve$set_nogold_key; ! No user GOLD key, ok to remove the gold key endif; eve$$x_gold_keys {the_keypad} := tpu$k_unspecified; return (TRUE); endprocedure; ! eve$set_keypad_gold_off ! EVE$TERMINALS.TPU Page 42 procedure eve$set_user_gold ! Turn on or shut off a user gold key. (the_key) ! user's gold key, or OFF if they want to set no gold key local got_one, ! Boolean if the_key matches existing gold key an_index, ! Keypad index in gold key array a_key, ! Keyword for key current gold key the_key_map_list; ! Key map list to look old gold key up in on_error [OTHERWISE]: endon_error; eve$$create_gold_key_array; ! insure it exists if the_key = OFF then ! User is doing SET NOGOLD, make current keypad's gold key (if any) ! the real gold key, else restore SET(SHIFT_KEY) gold key (if one) the_key_map_list := eve$current_key_map_list; a_key := get_info (the_key_map_list, "shift_key"); if a_key = key_name (a_key, SHIFT_KEY) then eve$message (EVE$_NOGOLDKEY); return (FALSE); else ! A gold key exists, is it a keypad's, user's, or SET(SHIFT_KEY) ! that's been caught and put into gold_key array an_index := eve$$x_gold_keys {eve$x_keypad}; if an_index <> tpu$k_unspecified then if (eve$$x_gold_keys {an_index} = a_key) then got_one := TRUE; endif; endif; if eve$$x_gold_keys {eve$x_user_keys} = a_key then got_one := TRUE; endif; if eve$$x_gold_keys {message_text (EVE$_SHIFT)} = a_key then got_one := TRUE; endif; if not got_one then ! SET(SHIFT_KEY) not in array yet ! shut it off in the k_m_l's set (SHIFT_KEY, key_name (a_key, SHIFT_KEY), the_key_map_list); set (SHIFT_KEY, key_name (a_key, SHIFT_KEY), eve$x_command_key_map_list); if eve$$if_user_gold_key then set (SHIFT_KEY, eve$$x_gold_keys {eve$x_user_keys}, the_key_map_list); set (SHIFT_KEY, eve$$x_gold_keys {eve$x_user_keys}, eve$x_command_key_map_list); eve$message (EVE$_SHIFTRESTORED, 0, str (eve$$x_gold_keys {eve$x_user_keys})); else if not eve$$restore_keypad_gold_key then eve$message (EVE$_SHIFTREM, 0); endif; endif; return (TRUE); endif; endif; if eve$$if_user_gold_key then if not eve$$restore_keypad_gold_key then ! No keypad GOLD key, see if user did SET(SHIFT_KEY,...) ! that's not in the gold key array if (eve$$x_gold_keys {message_text (EVE$_SHIFT)} = tpu$k_unspecified) then ! No GOLD key, ok to remove gold key eve$set_nogold_key; eve$message (EVE$_SHIFTREM); else eve$restore_tpu_gold; endif; endif; else a_key := eve$$x_gold_keys {message_text (EVE$_SHIFT)}; if (a_key <> tpu$k_unspecified) then ! no user gold or SET(SHIFT_KEY) gold if eve$$x_gold_keys {eve$x_keypad} = tpu$k_unspecified then ! no keypad gold either, no more gold key set (SHIFT_KEY, key_name (a_key, SHIFT_KEY), the_key_map_list); set (SHIFT_KEY, key_name (a_key, SHIFT_KEY), eve$x_command_key_map_list); endif; eve$$x_gold_keys {message_text (EVE$_SHIFT)} := tpu$k_unspecified; eve$message (EVE$_SHIFTREM); else eve$message (EVE$_NOGOLDKEY); return (FALSE); endif; endif; else ! User is doing SET GOLD, if there isn't already a user gold then ! we have to redefine current keypad's gold key (if there is one) if not eve$$if_user_gold_key then if eve$$x_gold_keys {eve$x_keypad} <> tpu$k_unspecified then eve$$redefine_gold_key (eve$$x_gold_keys {eve$$x_gold_keys {eve$x_keypad}}, eve$$x_gold_keys {eve$x_keypad}); endif; endif; endif; if the_key = OFF then eve$$x_gold_keys {eve$x_user_keys} := tpu$k_unspecified; else eve$$x_gold_keys {eve$x_user_keys} := the_key; ! may = TPU$K_UNSPECIFIED endif; return (TRUE); endprocedure; ! eve$set_user_gold ! EVE$TERMINALS.TPU Page 43 procedure eve$$create_gold_key_array ! insure gold key array exists ! The dynamic array for saving gold keys for the editing keypads. Only if a ! keypad is defined and it has a GOLD key is an element created for that keypad; ! the array index is the key_map (keypad) name, and the element is the gold ! keyname, e.g., {eve$x_edt_keys} = PF1. ! Only if the user issues the SET GOLD KEY command is an element created ! for the eve$x_user_keys keymap; it is deleted with the SET NOGOLD KEY command. ! If the user GOLD key supersedes a keypad GOLD key, the keypad name is ! saved in the element {eve$x_keypad}. A typical array would be: ! {eve$x_user_keys} = F20 ! from SET GOLD KEY command ! {eve$x_edt_keys} = PF1 ! saved keypad gold key ! {eve$x_keypad} = eve$x_edt_keys ! saved gold keypad if get_info (eve$$x_gold_keys, "type") <> ARRAY then eve$$x_gold_keys := create_array (); endif; endprocedure; ! eve$$create_gold_key_array ! ! EVE$TERMINALS.TPU Page 44 procedure eve$$if_user_gold_key ! Test if SET GOLD KEY is active ! See if the user has done SET GOLD KEY return (eve$$x_gold_keys {eve$x_user_keys} <> tpu$k_unspecified); endprocedure; ! eve$$if_user_gold_key ! ! EVE$TERMINALS.TPU Page 45 procedure eve$$restore_keypad_gold_key ! Restore current keypad's gold key local gold_index, the_keyname, the_keystring, the_gold_key, the_key, keypad_name, the_keypad, pointer; on_error [OTHERWISE]: endon_error; the_keypad := eve$$x_gold_keys {eve$x_keypad}; if the_keypad <> tpu$k_unspecified then the_keyname := eve$$x_gold_keys {the_keypad}; the_keystring := eve$key_name (the_keyname); if the_keystring = 0 then return (FALSE); endif; if not (int (eve$set_gold_key (the_keyname, the_keypad))) then return (FALSE); endif; ! tell 'em which key is now the GOLD key if index (substr (the_keypad, 1, 4), "EVE$") <> 0 then keypad_name := substr (the_keypad, 5, length (the_keypad)); pointer := index (keypad_name, "_KEYS"); if (pointer <> 0) and (pointer <> 1) then keypad_name := substr (keypad_name, 1, pointer - 1); endif; endif; eve$message (EVE$_GOLDRESTORED, 0, the_keystring, keypad_name); ! the gold key may have been defined to point to the users gold key eve$$undefine_key (the_keyname, the_keypad); return (TRUE); endif; return (FALSE); endprocedure; ! eve$$restore_keypad_gold_key ! ! EVE$TERMINALS.TPU Page 46 procedure eve$$redefine_gold_key ! define a new one (the_key, the_keypad) local saved_informational; on_error [TPU$_CONTROLC]: if saved_informational <> 0 then set (INFORMATIONAL, saved_informational); endif; eve$learn_abort; abort; [OTHERWISE]: if saved_informational <> 0 then set (INFORMATIONAL, saved_informational); endif; endon_error; if get_info (SYSTEM, "informational") then saved_informational := ON; else saved_informational := OFF; endif; set (INFORMATIONAL, OFF); define_key ("eve$$not_gold_key", the_key, message_text (EVE$_OLDGOLDKEY, 1), the_keypad); set (INFORMATIONAL, saved_informational); endprocedure; ! eve$$redefine_gold_key procedure eve$$undefine_key ! EVE's version of the builtin (the_key, the_keypad) on_error [OTHERWISE]: endon_error; if (the_key <> tpu$k_unspecified) and (the_keypad <> tpu$k_unspecified) then if lookup_key (the_key, PROGRAM, the_keypad) <> 0 then undefine_key (the_key, the_keypad); endif; endif; endprocedure; ! eve$$undefine_key ! EVE$TERMINALS.TPU Page 47 procedure eve$$not_gold_key ! User pressed inactive keypad gold key ! User pressed a keypad gold key that has been overridden by SET GOLD KEY eve$message (EVE$_NOTGOLDKEY, 0, eve$key_name (get_info (eve$current_key_map_list, "shift_key"))); endprocedure; ! eve$$not_gold_key ! ! EVE$TERMINALS.TPU Page 48 procedure eve$on_a_pre_lk201 ! Test if on a pre-LK201 keyboard if not get_info (COMMAND_LINE, "display") then return (FALSE); endif; if get_info (SCREEN, "vt200") then return (FALSE); endif; if get_info (SCREEN, "vt300") then return (FALSE); endif; if get_info (SCREEN, "vaxstation") then return (FALSE); endif; if get_info (SCREEN, "vk100") then return (TRUE); endif; if (get_info (SCREEN, "eightbit")) and ! Funny VT200 generation (get_info (SCREEN, "ansi_crt")) and ! stuff and V3 defs (get_info (SCREEN, "edit_mode")) then return (FALSE); endif; if get_info (SCREEN, "vt100") then return (TRUE); endif; return (FALSE); endprocedure; ! eve$on_a_pre_lk201 ! ! EVE$TERMINALS.TPU Page 49 procedure eve$current_keypad ! Determine the current keypad (; which_list) ! Procedure to find the key_map that determines the keypad local the_key_map, the_key_map_list, keypads; on_error [OTHERWISE]: endon_error; if which_list = tpu$k_unspecified then the_key_map_list := eve$x_key_map_list; else the_key_map_list := which_list; endif; keypads := ""; the_key_map := get_info (KEY_MAP, "first", eve$x_keypad_list); loop exitif the_key_map = 0; keypads := keypads + " " + the_key_map; the_key_map := get_info (KEY_MAP, "next", eve$x_keypad_list); endloop; the_key_map := get_info (KEY_MAP, "last", the_key_map_list); loop exitif the_key_map = 0; if index (keypads, " " + the_key_map) <> 0 then return (the_key_map); endif; the_key_map := get_info (KEY_MAP, "previous", the_key_map_list); endloop; return 0; endprocedure; ! eve$current_keypad ! EVE$TERMINALS.TPU Page 50 procedure eve$alphabetic ! Test if a key is a printing character (this_key) ! Procedure to check if a key is a printing character (in DEC Multinational ! set). Returns the character if alphabetic, else returns the null string. ! ! Parameters: ! this_key Keyword of key to check - input local ascii_key; ! String for this_key on_error [OTHERWISE]: endon_error; ascii_key := ascii (this_key); if ascii_key = ascii (0) then return (""); else return (ascii_key); endif; endprocedure; ! eve$alphabetic ! EVE$TERMINALS.TPU Page 51 procedure eve$cleanse_string ! Remove whitespace from string (this_string) ! Eliminates extra whitespace and trailing punctuation from a string. on_error [OTHERWISE]: endon_error; if index ("\|", substr (this_string, length (this_string), 1)) > 0 then this_string := substr (this_string, 1, length (this_string) - 1); endif; edit (this_string, TRIM); endprocedure; ! eve$cleanse_string ! EVE$TERMINALS.TPU Page 52 procedure eve$$add_do_key ! Add a DO key to the array (the_do_key, the_key_map) ! This procedure will add a DO key to eve$$x_do_key_array local str_do_key; ! string of the DO key on_error [OTHERWISE]: endon_error; if get_info (eve$$x_do_key_array, "type") <> ARRAY then eve$$x_do_key_array := create_array (); endif; str_do_key := eve$key_name (the_do_key); if eve$$x_do_key_array {the_key_map} = tpu$k_unspecified then eve$$x_do_key_array {the_key_map} := str_do_key + " "; else eve$$x_do_key_array {the_key_map} := eve$$x_do_key_array {the_key_map} + str_do_key + " "; endif; endprocedure ! eve$$add_do_key ! EVE$TERMINALS.TPU Page 53 procedure eve$$redefine_do_key ! Try to redefine a DO key (the_do_key; ! - a key currently defined as DO the_command, ! - command to redefine the_do_key to be is_learn, ! - key to become a learn sequence undef_flag) ! - flag for undefine_key command - not define ! Check to see if it is possible to redefine a DO key. If the only parameter ! is the key, then return, removing it as a do key if its not the last one. ! A DO key can be redefined if there is at least one VALID DO key left ! available to the user. A check is made to determine if a VALID DO key ! will exist on a VT100 assuming the specified key gets redefined. ! If the key is redefinable, a warning to the user is flashed according to ! whether they will have a VALID DO key on a VT100 and a value of TRUE is ! returned. If the key getting redefined was in the user key map then it is ! removed from the DO key array. A value of FALSE is returned otherwise. ! local local_do_key, ! string of DO key passed in the_key_type, temp_do_keyword, ! the temp_do_key as a keyword temp_do_key, ! DO key in array string currently looking at string_do_keys, ! string of DO keys in array map_key_in, ! key map the DO key is defined in temp_index, ! index of space in string of DO keys valid_on_a_vt100, ! flag for if redefining last available DO on VT100 okay_to_redefine, ! okay to redefine key - another DO key exists the_key_map_list, ! current key map list temp_key_map; ! temporary for walking thru key map list on_error [TPU$_RECURLEARN]: eve$message (EVE$_NORECURS); eve$learn_abort; return (FALSE); [OTHERWISE]: endon_error; local_do_key := eve$key_name (the_do_key); ! keyword to string okay_to_redefine := FALSE; valid_on_a_vt100 := FALSE; ! determine if user has more than one valid DO key the_key_map_list := eve$current_key_map_list; temp_key_map := get_info (KEY_MAP, "first", the_key_map_list); loop exitif temp_key_map = 0; string_do_keys := eve$$x_do_key_array {temp_key_map}; if string_do_keys <> tpu$k_unspecified then temp_index := index (string_do_keys, " "); else temp_index := 0; endif; loop exitif temp_index = 0; temp_do_key := substr (string_do_keys, 1, temp_index - 1); string_do_keys := substr (string_do_keys, temp_index + 1, 999); temp_do_keyword := eve$$parse_keystring (temp_do_key); map_key_in := lookup_key (temp_do_keyword, KEY_MAP, the_key_map_list); if temp_key_map = map_key_in then ! have a valid do key if temp_do_key <> local_do_key then ! can redefine okay_to_redefine := TRUE; the_key_type := get_info (temp_do_keyword, "key_type"); if (the_key_type <> FUNCTION) and (the_key_type <> SHIFT_FUNCTION) then ! VT100 key still available valid_on_a_vt100 := TRUE; endif; endif; endif; exitif okay_to_redefine and valid_on_a_vt100; temp_index := index (string_do_keys, " "); endloop; temp_key_map := get_info (KEY_MAP, "next", the_key_map_list); endloop; if (the_command = tpu$k_unspecified) then return okay_to_redefine; endif; if okay_to_redefine then if eve$x_user_keys = lookup_key (the_do_key, KEY_MAP, the_key_map_list) then ! delete from eve$$x_do_key_array string_do_keys := eve$$x_do_key_array {eve$x_user_keys}; temp_index := index (string_do_keys, local_do_key); string_do_keys := substr (string_do_keys, 1, temp_index - 1) + substr (string_do_keys, temp_index + 1 + length (local_do_key), 999); eve$$x_do_key_array {eve$x_user_keys} := string_do_keys; endif; if (undef_flag = tpu$k_unspecified) then if (is_learn = tpu$k_unspecified) then if not valid_on_a_vt100 then eve$$define_key (the_command, the_do_key, eve$x_user_keys, 1); else eve$$define_key (the_command, the_do_key, eve$x_user_keys); endif; else if is_learn = 1 then ! define key to be a learn seq. define_key (the_command, the_do_key, eve$x_sequence, eve$x_user_keys); ! clear LEARN message if still there if not eve$$x_state_array {eve$$k_in_init_file} then eve$message (EVE$_SEQREMMED); endif; endif; if not valid_on_a_vt100 then ! flash user a warning eve$message (EVE$_NODOVT100); endif; endif; ! vanilla DO else ! undefine flag set eve$$undefine_key (the_do_key, eve$x_user_keys); if not eve$$x_state_array {eve$$k_in_init_file} then eve$message (EVE$_KEYUNDEF); endif; if not valid_on_a_vt100 then eve$message (EVE$_UNDEFDOVT100); endif; endif; ! no undefine flag return TRUE; else return FALSE; endif; endprocedure; ! eve$$redefine_do_key ! EVE$TERMINALS.TPU Page 54 procedure eve$$define_key ! Define a key (with comment) (command_name_arg, key_name_arg, key_map_arg; vt100_message_flag) local the_code, ! Code to bind to the key original_code, ! Code without error handler first_four, ! Initial 4 characters of the command paren_index, ! Pointer to the parens in original_code added_paren, ! Boolean set if parens added to comment added_argument, ! Boolean set if non-default arg is in comment call_argument, ! Arguments from the parser the_argument, ! One of the arguments define_comment, ! Comment to put on the key key_delimiters, ! string of acceptable key string separators the_key_map, ! Keymap portion if command_name_arg ! specifies a key and not a command the_key_map_length, ! and its length the_key_name, ! Key-name portion of same... defined_key_map, ! Key-map variable for finding the key comma_index, ! Index of , under_index, ! Index of _ dollar_index, ! Index of $ prefix_length, ! Length of EVE_ command_name; ! Modifiable local version of command_name_arg constant define_facility := "EVE"; ! Variable some day? constant the_tpu_command := 'eve_tpu('; on_error [TPU$_COMPILEFAIL]: eve$message (EVE$_BADCODE, 0, original_code); eve$learn_abort; return (0); [OTHERWISE]: endon_error; key_delimiters := "-_/ "; command_name := command_name_arg; ! See if the string is a complete command (disable parser messages since ! we want to continue parsing if all of the string is not a command) edit (command_name, OFF, TRIM); first_four := change_case (substr (command_name, 1, 4), UPPER); if ((first_four = "TPU ") or (index (first_four, "TP ") = 1)) then original_code := edit (substr (command_name, 4), TRIM_LEADING); define_comment := 'program (' + original_code + ')'; the_code := "on_error" + " [TPU$_CONTROLC]:" + " eve$learn_abort;" + " abort;" + " [OTHERWISE]:" + "endon_error;" + original_code + ";" + "return 1"; else eve$$x_state_array {eve$$k_help_active} := 4; original_code := eve$$parse (command_name); eve$$x_state_array {eve$$k_help_active} := 0; if original_code <> "" then prefix_length := length (eve$$x_command_prefix) + 1; paren_index := index (original_code, "("); if paren_index = 0 then define_comment := substr (original_code, prefix_length); else call_argument := substr (original_code, paren_index); define_comment := substr (original_code, prefix_length, paren_index - prefix_length); ! add non-default args to legend part of key comment loop exitif call_argument = ""; comma_index := index (call_argument, ","); if comma_index <> 0 then ! get the next arg the_argument := substr (call_argument, 1, comma_index - 1); call_argument := substr (call_argument, comma_index + 1); else ! get the last (or only) arg the_argument := call_argument; call_argument := ""; endif; ! remove '""' and 'eve$k_no_arg' default args from parser if (the_argument <> '""') and (the_argument <> "eve$k_no_arg") then if not added_paren then ! start legend part of comment added_paren := TRUE; define_comment := define_comment + " (" + define_comment; endif; define_comment := define_comment + " " + the_argument; added_argument := TRUE; endif; endloop; if added_argument then ! close the arg list define_comment := define_comment + ")"; else ! leave command without legend (no args) define_comment := substr (original_code, prefix_length, paren_index - prefix_length); endif; endif; the_code := eve$$kt_return + original_code; else ! see if a key_map was given the_key_map := eve$$get_next_word (command_name, key_delimiters); edit (the_key_map, TRIM, UPPER, OFF); the_key_map_length := length (the_key_map); defined_key_map := get_info (KEY_MAP, "first", eve$x_keypad_list); loop exitif (defined_key_map = 0); dollar_index := index (defined_key_map, "$"); if dollar_index = 0 then exitif (index (defined_key_map, the_key_map) = 1); else exitif (index (substr (defined_key_map, dollar_index + 1, the_key_map_length), the_key_map) = 1); endif; defined_key_map := get_info (KEY_MAP, "next", eve$x_keypad_list); endloop; ! handle the EVE$STANDARD_KEYS keymap separately because it's not ! in eve$x_keypad_list if defined_key_map = 0 then dollar_index := index (eve$x_standard_keys, "$"); if index (substr (eve$x_standard_keys, dollar_index + 1, the_key_map_length), the_key_map) = 1 then defined_key_map := eve$x_standard_keys; endif; endif; if defined_key_map = 0 then ! The {command | keypad-name key-name} argument to DEFINE KEY ! is neither a recognized command nor keypad. Parse it again, ! allowing error messages this time, and return. command_name := the_key_map + " " + command_name; original_code := eve$$parse (command_name); return; ! parser has already output the error message else if command_name = "" then if not (eve$prompt_string ("", command_name, message_text (EVE$_KEYCOPYPROMPT, 1, the_key_map), message_text (EVE$_NOKEYDEF, 0))) then return; endif; endif; if command_name = "" then eve$message (EVE$_NOKEYDEF); return; endif; the_key_name := eve$$parse_keystring (command_name); if the_key_name = 0 then return; endif; the_code := lookup_key (the_key_name, PROGRAM, defined_key_map); define_comment := lookup_key (the_key_name, COMMENT, defined_key_map); if (define_comment = "") or (get_info (the_code, "type") <> PROGRAM) then under_index := index (defined_key_map, "_KEYS"); if under_index <> 0 then defined_key_map := substr (defined_key_map, (dollar_index + 1), under_index - (dollar_index + 1)); endif; eve$message (EVE$_KEYNOTCOPY, 0, defined_key_map, command_name); return; endif; endif; endif; endif; !++ ! Define the new key (the_code is either a string ! (from eve$$parse) or a program variable (from lookup_key)) !-- if defined_key_map = 0 ! use EVE facility then define_key (the_code, key_name_arg, define_facility + " " + define_comment, key_map_arg); else define_key (the_code, key_name_arg, define_comment, key_map_arg); endif; if not eve$$x_state_array {eve$$k_in_init_file} then if (vt100_message_flag <> tpu$k_unspecified) then if vt100_message_flag then eve$message (EVE$_NODOVT100); else eve$message (EVE$_KEYDEF); endif; else eve$message (EVE$_KEYDEF); endif; endif; endprocedure; ! eve$$define_key ! ! EVE$TERMINALS.TPU Page 55 procedure eve$$get_next_word ! strips word off front of sentence (sentence, delimiters) local sentence_length, ! number of chars in sentence local_delimiters, ! local copy for modification c, i, ! for loop counters word, ! first word local_delimiter_length, ! length of delimiter string end_of_first_word; ! char position of first word ! This procedure expects to get a compressed string, i.e. ! sentence := edit(sentence,compress,trim); ! It accepts a string of delimiters i.e. - " _/-" ! sentence is modified to the rest of the sentence minus the first word, ! and the first word is a returned value on_error [OTHERWISE]: endon_error; sentence_length := length (sentence); end_of_first_word := sentence_length + 1; local_delimiters := delimiters; if local_delimiters = "" then local_delimiters := " "; endif; local_delimiter_length := length (local_delimiters); c := 1; loop exitif (c > local_delimiter_length); i := index (sentence, substr (local_delimiters, c, 1)); if i > 0 then if i < end_of_first_word then end_of_first_word := i; ! SHOULDN'T THIS BE I - 1? endif; endif; c := c + 1; endloop; ! ! If end_of_first_word is still greater then sentence_length, then ! no delimiters were found, and the whole sentence is one word. ! ! If the delimiter was the first character (end_of_first_word = 1) ! then send the delimiter as the word. This is in case we are parsing ! something like "SHIFT/-" where the user wants to bind something ! to SHIFT DASH ! ! Otherwise, send the word, and strip off the delimiter ! if (end_of_first_word > sentence_length) then word := sentence; sentence := ""; else if end_of_first_word = 1 then word := substr (sentence, 1, 1); sentence := substr (sentence, 3, sentence_length - 2); else word := substr (sentence, 1, end_of_first_word - 1); sentence := substr (sentence, end_of_first_word + 1, sentence_length - end_of_first_word); endif; endif; return (word); endprocedure; ! eve$$get_next_word ! EVE$TERMINALS.TPU Page 56 procedure eve$$parse_keystring ! key as string => keyword (key_string); ! This is our input key string local delimiter_index, ! of first delimiter of any type in string delimited_key_string, ! holds key string with delims. xlated local_key_string; local_key_string := key_string; edit (local_key_string, COMPRESS, TRIM, OFF); if local_key_string = "" then eve$message (EVE$_NOKEYNAM); return (FALSE); endif; ! ! Find the first delimiter of any type ! delimited_key_string := local_key_string; translate (delimited_key_string, eve$kt_xlate_parameter, eve$kt_modifier_delimiters); delimiter_index := index (delimited_key_string, eve$kt_modifier_delimiter_standard); ! ! If there were no modifer delimiters, or the input is only 1 char long ! then we're dealing with an unmodified key ! if (delimiter_index = 0) or (length (local_key_string) = 1) then return eve$$parse_unmodified_key (local_key_string); endif; return (eve$$parse_key_with_modifier (local_key_string, delimiter_index)); endprocedure ! eve$$parse_keystring ! EVE$TERMINALS.TPU Page 57 procedure eve$set_gold_key ! Set the gold key (the_key, the_key_map) local the_key_map_list, ! Key map list to look old gold key up in old_gold_key; ! Keyword for the old gold key on_error [OTHERWISE]: endon_error; eve$$create_gold_key_array; ! insure array exists if the_key = RET_KEY then return (EVE$_NOSHIFTRETURN); else if eve$test_synonym ("do", eve$$lookup_comment (the_key, "")) then if not eve$$redefine_do_key (the_key,, 0) then return (EVE$_NOSHIFTDO); else eve$remember_tpu_gold; ! save GOLD from SET(SHIFT_KEY,...) set (SHIFT_KEY, the_key, eve$current_key_map_list); set (SHIFT_KEY, the_key, eve$x_command_key_map_list); return (EVE$_SHIFTSET); endif; else if eve$is_mouse (the_key) then return (EVE$_NOSHIFTMOUSE); else if eve$alphabetic (the_key) = "" then the_key_map_list := eve$current_key_map_list; if the_key = key_name (the_key, SHIFT_KEY) ! A golded key? then ! Yes, not allowed. return (EVE$_BADSHIFTKEY); else ! save GOLD from SET(SHIFT_KEY,...) eve$remember_tpu_gold; set (SHIFT_KEY, the_key, the_key_map_list); set (SHIFT_KEY, the_key, eve$x_command_key_map_list); return (EVE$_SHIFTSET); endif; else return (EVE$_NOSHIFTTYP); endif; endif; endif; endif; endprocedure; ! eve$set_gold_key procedure eve$set_shift_key ! For V2.0 compatibility (the_key, the_key_map) return eve$set_gold_key (the_key, the_key_map); endprocedure; ! eve$set_shift_key ! EVE$TERMINALS.TPU Page 58 procedure eve$set_nogold_key ! Actually remove any GOLD key local the_key, ! Keyword for key current gold key the_key_map_list; ! Key map list to look old gold key up in on_error [OTHERWISE]: endon_error; the_key_map_list := eve$current_key_map_list; the_key := get_info (the_key_map_list, "shift_key"); if the_key = key_name (the_key, SHIFT_KEY) then ! no gold key exists if eve$$x_gold_keys {message_text (EVE$_SHIFT)} <> tpu$k_unspecified then eve$restore_tpu_gold; else eve$$x_gold_keys {message_text (EVE$_SHIFT)} := tpu$k_unspecified; return (FALSE); endif; else if the_key <> eve$$x_gold_keys {message_text (EVE$_SHIFT)} then set (SHIFT_KEY, key_name (the_key, SHIFT_KEY), the_key_map_list); set (SHIFT_KEY, key_name (the_key, SHIFT_KEY), eve$x_command_key_map_list); eve$restore_tpu_gold; ! restore GOLD from SET(SHIFT_KEY,...) return (TRUE); endif; endif; return (TRUE); endprocedure; ! eve$set_nogold_key ! EVE$TERMINALS.TPU Page 59 procedure eve$remember_tpu_gold ! Save set(shift_key,...) gold key local the_key, ! Keyword for key current gold key an_index, ! Index into gold key array the_key_map_list; ! Key map list to look old gold key up in on_error [OTHERWISE]: endon_error; the_key_map_list := eve$current_key_map_list; the_key := get_info (the_key_map_list, "shift_key"); if the_key = key_name (the_key, SHIFT_KEY) then ! no gold key exists eve$$x_gold_keys {message_text (EVE$_SHIFT)} := tpu$k_unspecified; return; else if eve$$x_gold_keys {eve$x_user_keys} = the_key then ! user gold is the gold key return; else an_index := eve$$x_gold_keys {eve$x_keypad}; if an_index <> tpu$k_unspecified then if eve$$x_gold_keys {an_index} = the_key then ! a keypad gold is the gold key return; endif; endif; endif; endif; ! user defined a gold key using SET(SHIFT_KEY,...) eve$$x_gold_keys {message_text (EVE$_SHIFT)} := the_key; endprocedure; ! eve$remember_tpu_gold procedure eve$restore_tpu_gold ! Restore set(shift_key,...) gold key local the_keystring, the_key; the_key := eve$$x_gold_keys {message_text (EVE$_SHIFT)}; if the_key <> tpu$k_unspecified then if the_key <> key_name (get_info (eve$current_key_map_list, "shift_key"), SHIFT_KEY) then ! it's not already the GOLD key set (SHIFT_KEY, the_key, eve$current_key_map_list); set (SHIFT_KEY, the_key, eve$x_command_key_map_list); the_keystring := eve$key_name (the_key); eve$message (EVE$_SHIFTRESTORED, 0, the_keystring); return (TRUE); else return (TRUE); endif; endif; return (FALSE); endprocedure; ! eve$restore_tpu_gold ! EVE$TERMINALS.TPU Page 60 procedure eve$set_noshift_key ! For V2.0 compatibility return eve$set_nogold_key; endprocedure; ! eve$set_noshift_key ! EVE$TERMINALS.TPU Page 61 procedure eve$vt100_keys ! Define numeric keypad for VT100s (; caller, ! 0 for eve_set_keypad_vt100, 1 for edt, 2 for wps define_do_flag) ! = 0 if ok to do only code past call to eve$init_do_key ! = 1 if ok to call eve$init_do_key and all code past it ! = 2 or "" or tpu$k_unspecified if ok to do all code ! Define numeric keyboard layout for VT100 series keyboards local status, doit; if (define_do_flag = tpu$k_unspecified) or (define_do_flag = "") then doit := 2; else doit := define_do_flag; endif; if doit = 2 then eve$set_keypad (eve$x_vt100_keys); endif; status := TRUE; if doit <> 0 then status := eve$init_do_key (caller, define_do_flag); if status = eve$k_async_prompting then return (status); endif; endif; eve$x_numeric_keypad := FALSE; return (status); endprocedure; ! eve$vt100_keys ! EVE$TERMINALS.TPU Page 62 procedure eve$init_do_key ! Make sure there is a DO key (; caller, ! 0 = eve_set_keypad_vt100, 1 = edt, 2 = wps define_do_flag) ! = 1 if ok to redefine pf4 ! = 2 if should prompt user about redefining pf4 ! Make sure there is a DO key either on DO or PF4 local status; on_error [OTHERWISE]: endon_error; status := TRUE; if eve$on_a_pre_lk201 then if lookup_key (PF4, PROGRAM, eve$x_user_keys) <> 0 then if not eve$test_synonym ("do", eve$$lookup_comment (PF4, eve$x_user_keys)) then if define_do_flag <> tpu$k_unspecified then if define_do_flag = 1 then status := 1; endif; endif; if not status then status := eve$insist_y_n (message_text (EVE$_ASKPF4, 1)); endif; if status then define_key (eve$$kt_return + "eve_do ('')", PF4, " do", eve$x_user_keys); endif; endif; endif; endif; return status; endprocedure; ! eve$init_do_key ! EVE$TERMINALS.TPU Page 63 procedure eve$set_keypad ! Change the keypad layout (which_key_map; ! which_key_map = the new keypad the_gold_key) ! the_gold_key = optional keyname for the keypad's GOLD key local the_key_map, ! Local version of which_key_map (upper-case) temp_key_map, ! Temporary for walking through the key-map list result, ! Result of eve$set_gold_key saw_it; ! TRUE if the_key_map is in the list already on_error [TPU$_CONTROLC]: ! insure the standard keys are available (don't worry about keypad) if get_info (KEY_MAP, "last", eve$x_key_map_list) <> eve$x_standard_keys then add_key_map (eve$x_key_map_list, "last", eve$x_standard_keys); endif; if get_info (KEY_MAP, "last", eve$x_command_key_map_list) <> eve$x_standard_keys then add_key_map (eve$x_command_key_map_list, "last", eve$x_standard_keys); endif; eve$learn_abort; abort; [TPU$_KEYMAPNOTFND]: ! ignore errors [OTHERWISE]: if get_info (KEY_MAP, "last", eve$x_key_map_list) <> eve$x_standard_keys then add_key_map (eve$x_key_map_list, "last", eve$x_standard_keys); endif; if get_info (KEY_MAP, "last", eve$x_command_key_map_list) <> eve$x_standard_keys then add_key_map (eve$x_command_key_map_list, "last", eve$x_standard_keys); endif; endon_error; the_key_map := which_key_map; change_case (the_key_map, UPPER); ! Remove any keypad key_maps from both the main and command buffer's ! key_map_list's. Also make sure the new one is in the key_map_list containing ! all keypad key_maps. temp_key_map := get_info (KEY_MAP, "first", eve$x_keypad_list); loop exitif temp_key_map = 0; remove_key_map (eve$x_key_map_list, temp_key_map, ALL); remove_key_map (eve$x_command_key_map_list, temp_key_map, ALL); if the_key_map = temp_key_map then saw_it := TRUE; endif; temp_key_map := get_info (KEY_MAP, "next", eve$x_keypad_list); endloop; ! Put this one in the list if we didn't see it there already if not saw_it then add_key_map (eve$x_keypad_list, "last", the_key_map); endif; ! Now put it in the penultimate (next to last) position in both key_map_lists. remove_key_map (eve$x_key_map_list, eve$x_standard_keys, ALL); add_key_map (eve$x_key_map_list, "last", the_key_map); add_key_map (eve$x_key_map_list, "last", eve$x_standard_keys); remove_key_map (eve$x_command_key_map_list, eve$x_standard_keys, ALL); add_key_map (eve$x_command_key_map_list, "last", the_key_map); add_key_map (eve$x_command_key_map_list, "last", eve$x_standard_keys); ! Set the keypad's gold key (the_gold_key = TPU$K_UNSPECIFIED means no gold ! key exists for the keypad) return (eve$set_keypad_gold (which_key_map, the_gold_key)); endprocedure; ! eve$set_keypad ! EVE$TERMINALS.TPU Page 64 procedure eve$set_function_keys ! Change the function-keys (which_key_map) local the_key_map, ! Local version of which_key_map (upper-case) temp_key_map, ! Temporary for walking through the key-map list saw_it; ! TRUE if the_key_map is in the list already on_error [TPU$_CONTROLC]: ! insure the standard keys are available (don't worry about others) if get_info (KEY_MAP, "last", eve$x_key_map_list) <> eve$x_standard_keys then add_key_map (eve$x_key_map_list, "last", eve$x_standard_keys); endif; if get_info (KEY_MAP, "last", eve$x_command_key_map_list) <> eve$x_standard_keys then add_key_map (eve$x_command_key_map_list, "last", eve$x_standard_keys); endif; eve$learn_abort; abort; [TPU$_KEYMAPNOTFND]: ! ignore errors [OTHERWISE]: if get_info (KEY_MAP, "last", eve$x_key_map_list) <> eve$x_standard_keys then add_key_map (eve$x_key_map_list, "last", eve$x_standard_keys); endif; if get_info (KEY_MAP, "last", eve$x_command_key_map_list) <> eve$x_standard_keys then add_key_map (eve$x_command_key_map_list, "last", eve$x_standard_keys); endif; endon_error; the_key_map := which_key_map; change_case (the_key_map, UPPER); ! Remove any function-key key_maps from both the main and command buffer's ! key_map_list's. Also make sure the new one is in the key_map_list containing ! all function-key key_maps. temp_key_map := get_info (KEY_MAP, "first", eve$x_function_key_map_list); loop exitif temp_key_map = 0; remove_key_map (eve$x_key_map_list, temp_key_map, ALL); remove_key_map (eve$x_command_key_map_list, temp_key_map, ALL); if the_key_map = temp_key_map then saw_it := TRUE; endif; temp_key_map := get_info (KEY_MAP, "next", eve$x_function_key_map_list); endloop; ! Put this one in the list if we didn't see it there already if not saw_it then add_key_map (eve$x_function_key_map_list, "last", the_key_map); endif; ! Now put it in the 3rd from last position in both key_map_lists. remove_key_map (eve$x_key_map_list, eve$x_standard_keys, ALL); temp_key_map := get_info (KEY_MAP, "last", eve$x_key_map_list); remove_key_map (eve$x_key_map_list, temp_key_map, ALL); add_key_map (eve$x_key_map_list, "last", the_key_map); ! function-key add_key_map (eve$x_key_map_list, "last", temp_key_map); ! keypad add_key_map (eve$x_key_map_list, "last", eve$x_standard_keys); ! standard remove_key_map (eve$x_command_key_map_list, eve$x_standard_keys, ALL); temp_key_map := get_info (KEY_MAP, "last", eve$x_command_key_map_list); remove_key_map (eve$x_command_key_map_list, temp_key_map, ALL); add_key_map (eve$x_command_key_map_list, "last", the_key_map); add_key_map (eve$x_command_key_map_list, "last", temp_key_map); add_key_map (eve$x_command_key_map_list, "last", eve$x_standard_keys); return (TRUE); endprocedure; ! eve$set_function_keys ! EVE$TERMINALS.TPU Page 65 procedure eve$test_synonym ! Test for an EVE command synonym (the_command, ! eve$$x_synonym_array string index, e.g., "next_screen" the_synonym; ! a possible command synonym string, e.g., "go_below" substr_flag, ! true if test for non-exact match (a substr will do) result) ! matching string found in the array (if any) - output ! eve$test_synonym ! Test for an EVE command synonym ! ! Description ! See if the synonym has a match in the command's synonym structure. ! The command must already be lowercased, and have spaces trimmed. ! The synonym will be lowercased, and have spaces trimmed before testing. ! Implicit Inputs ! eve$$x_synonym_array - an array where each element contains strings ! for all keys that are synonyms for a specific EVE command. This array ! is created at startup time by code dynamically created by EVE$BUILD.TPU ! Non-command elements can be created also, as SET TAB's arguments, for ! internationalizing. ! Return Value ! true - if the_synonym is a synonym for the_command ! false - if the_synonym is not a synonym for the_command local the_index, space_index, synonym_string, index_string, local_synonym; ! No errors are expected on_error [OTHERWISE]: endon_error; ! Lowercase and trim the synonym local_synonym := the_synonym; edit (local_synonym, TRIM, COMPRESS, LOWER, OFF); ! A null synonym cannot be a synonym if local_synonym = "" then return (FALSE); endif; ! An exact match is always a synonym if local_synonym = the_command then result := local_synonym; return (TRUE); endif; ! Give up here if no array (e.g., during editor startup before ! eve$synonyms_module_init is called) if get_info (eve$$x_synonym_array, "type") <> ARRAY then return (FALSE); endif; ! Get the (possible) synonym string from the synonym array synonym_string := eve$$x_synonym_array {the_command}; if synonym_string = tpu$k_unspecified then return (FALSE); endif; ! Set up the match string if substr_flag = 1 then index_string := " " + local_synonym; ! Only initial match needed else index_string := " " + local_synonym + " "; ! Uniqueness required endif; ! Test if synonym is in the synonym array element the_index := index (" " + synonym_string + " ", index_string); if the_index <> 0 then space_index := index (substr (synonym_string, the_index, 999), " "); if space_index = 0 then space_index := length (synonym_string); endif; result := substr (synonym_string, the_index, space_index); return (TRUE); endif; return (FALSE); endprocedure; ! eve$test_synonym ! EVE$TERMINALS.TPU Page 66 procedure eve$key_map_list_exists ! Is there one already? (the_name) local temp; on_error [TPU$_NOKEYMAPLIST]: return FALSE; endon_error; temp := get_info (KEY_MAP, "first", the_name); return TRUE; endprocedure; ! eve$key_map_list_exists procedure eve$key_map_exists ! Is there one already? (the_name) local temp; on_error [TPU$_NOKEYMAP]: return FALSE; endon_error; temp := get_info (DEFINED_KEY, "first", the_name); return TRUE; endprocedure; ! eve$key_map_exists ! EVE$TERMINALS.TPU Page 67 procedure eve$$save_settings ! Save GOLD and DO keys ! save the GOLD and DO keys in procedure eve$$restore_settings which will ! restore the state of the gold_keys structure and eve$$x_do_key_array at ! editor startup. local saved_mark, the_index; ! string index into array on_error [OTHERWISE]: position (saved_mark); endon_error; saved_mark := mark (FREE_CURSOR); if get_info (eve$context_buffer, "type") <> BUFFER then ! can't forward ref eve$init_buffer from this module, duplicate it: if eve$x_buf_str_saved_context = tpu$k_unspecified then eve$x_buf_str_saved_context := "SAVED$CONTEXT$"; endif; eve$context_buffer := create_buffer (eve$x_buf_str_saved_context); set (NO_WRITE, eve$context_buffer); set (SYSTEM, eve$context_buffer); else erase (eve$context_buffer); endif; position (beginning_of (eve$context_buffer)); copy_text ("procedure eve$$restore_settings"); split_line; split_line; copy_text ("eve$$x_gold_keys := create_array ();"); split_line; copy_text ("eve$$x_do_key_array := create_array ();"); split_line; split_line; ! save contents of gold key array - assume the index into the array is ! of type STRING. Elements of the array can be KEYWORD or STRING. if get_info (eve$$x_gold_keys, "type") = ARRAY then the_index := get_info (eve$$x_gold_keys, "first"); loop exitif the_index = tpu$k_unspecified; case get_info (eve$$x_gold_keys {the_index}, "type") [KEYWORD]: ! Save array { string } := keyword; ! Like: eve$$x_gold_keys {'EVE$EDT_KEYS'} := PF1; copy_text (fao ("eve$$x_gold_keys {'!AS'} := !AS;", the_index, get_info (eve$$x_gold_keys {the_index}, "name"))); [STRING]: ! Save array { string } := string; copy_text (fao ("eve$$x_gold_keys {'!AS'} := '!AS';", the_index, eve$$x_gold_keys {the_index})); endcase; split_line; the_index := get_info (eve$$x_gold_keys, "next"); endloop; ! for saving GOLD keys endif; ! save all DO keys defined - each array element assumed to be of type ! string. This array will always be specified - (default DO keys) if get_info (eve$$x_do_key_array, "type") = ARRAY then the_index := get_info (eve$$x_do_key_array, "first"); loop exitif the_index = tpu$k_unspecified; ! Save array { string } := string; copy_text (fao ("eve$$x_do_key_array {'!AS'} := '!AS';", the_index, eve$$x_do_key_array {the_index})); split_line; the_index := get_info (eve$$x_do_key_array, "next"); endloop; ! for saving DO keys endif; copy_text ("endprocedure"); split_line; set (INFORMATIONAL, OFF); compile (eve$context_buffer); %if eve$x_option_decwindows %then eve$$$save_widget_arrays; %endif position (saved_mark); endprocedure; ! eve$$save_settings ! EVE$TERMINALS.TPU Page 68 procedure eve$set_key_procedure ! Set a pre-key or post-key procedure (pre_key, ! pre (1) or post (0) key procedure which_list, ! the key_map_list code_source, ! program (0 = delete) which_index) ! caller specifies index per facility code local count, the_index, proc_array, the_array, upper_list, the_key_map_list, the_program; on_error [OTHERWISE]: endon_error; if which_list = "" then the_key_map_list := eve$x_key_map_list; else the_key_map_list := get_info (KEY_MAP_LIST, "first"); upper_list := change_case (which_list, UPPER, NOT_IN_PLACE); loop if the_key_map_list = 0 then return (FALSE); ! invalid key_map_list endif; exitif the_key_map_list = upper_list; the_key_map_list := get_info (KEY_MAP_LIST, "next"); endloop; endif; if code_source <> 0 then case get_info (code_source, "type") [STRING, BUFFER, RANGE]: ! compile the code only once the_program := compile (code_source); [PROGRAM, LEARN]: the_program := code_source; [OTHERWISE]: return (FALSE); endcase; else the_program := 0; endif; ! create the array indexed by k_m_l (each points to array of programs for ! that k_m_l) if pre_key then if get_info (eve$$x_pre_key_procedures, "type") <> ARRAY then if the_program = 0 then return (FALSE); ! no procedure (array) to delete else eve$$x_pre_key_procedures := create_array; endif; endif; proc_array := eve$$x_pre_key_procedures; else if get_info (eve$$x_post_key_procedures, "type") <> ARRAY then if the_program = 0 then return (FALSE); ! no procedure (array) to delete else eve$$x_post_key_procedures := create_array; endif; endif; proc_array := eve$$x_post_key_procedures; endif; ! get the_key_map_list's array of pre/post-key procedures if proc_array {the_key_map_list} = tpu$k_unspecified then proc_array {the_key_map_list} := create_array; the_array := proc_array {the_key_map_list}; else the_array := proc_array {the_key_map_list}; endif; if the_program = 0 then ! delete the key procedure at which_index if the_array {which_index} = tpu$k_unspecified then return (FALSE); ! no program else the_array {which_index} := tpu$k_unspecified; ! disable pre/post key dispatcher if no more k_m_l procedures the_index := get_info (the_array, "first"); loop exitif the_index = tpu$k_unspecified; count := count + 1; the_index := get_info (the_array, "next"); endloop; if count = 0 then if pre_key then set (PRE_KEY_PROCEDURE, the_key_map_list, ""); else set (POST_KEY_PROCEDURE, the_key_map_list, ""); endif; endif; return (TRUE); endif; else ! add the new key procedure the_array {which_index} := the_program; ! disable pre/post key dispatcher if no more k_m_l procedures the_index := get_info (the_array, "first"); loop exitif the_index = tpu$k_unspecified; count := count + 1; the_index := get_info (the_array, "next"); endloop; if count = 1 ! This is the first pre/post-key procedure, then ! enable EVE's dispatcher for this k_m_l. if pre_key then set (PRE_KEY_PROCEDURE, the_key_map_list, "eve$$pre_key_dispatcher"); else set (POST_KEY_PROCEDURE, the_key_map_list, "eve$$post_key_dispatcher"); endif; endif; return (TRUE); endif; return (FALSE); endprocedure; ! eve$set_key_procedure ! EVE$TERMINALS.TPU Page 69 procedure eve$$pre_key_dispatcher ! Execute pre-key procedures ! EVE's pre-key procedure dispatcher. Dispatches procedures set by ! eve$set_key_procedure. local temp_array, count, the_key_map_list, the_index, the_program, the_array, the_window, the_column, the_row; on_error [OTHERWISE]: eve$$x_pre_dispatch_active := FALSE; endon_error; if eve$$x_pre_dispatch_active ! paranoia check then return; endif; ! don't call eve$is_mouse here for speed if get_info (last_key, "type") <> KEYWORD then return; ! read was aborted endif; if get_info (last_key, "mouse_button") <> 0 then if not locate_mouse (the_window, the_column, the_row) then return; endif; the_key_map_list := get_info (the_window, "key_map_list"); else the_key_map_list := get_info (current_buffer, "key_map_list"); endif; the_array := eve$$x_pre_key_procedures {the_key_map_list}; if the_array = tpu$k_unspecified then ! shouldn't have been called for this k_m_l set (PRE_KEY_PROCEDURE, the_key_map_list, ""); return; endif; eve$$x_pre_dispatch_active := TRUE; ! copy the_array indexes so we can step thru the_array even if it changes ! out from under us temp_array := create_array; the_index := get_info (the_array, "first"); loop exitif the_index = tpu$k_unspecified; count := count + 1; temp_array {count} := the_index; the_index := get_info (the_array, "next"); endloop; if count = 0 then ! no pre-key procedures active for this k_m_l set (PRE_KEY_PROCEDURE, the_key_map_list, ""); eve$$x_pre_dispatch_active := FALSE; return; endif; the_index := get_info (temp_array, "first"); loop exitif the_index = tpu$k_unspecified; the_program := the_array {temp_array {the_index}}; ! insure this element wasn't deleted by executing a previous pre-key if the_program <> tpu$k_unspecified then execute (the_program); endif; the_index := get_info (temp_array, "next"); endloop; eve$$x_pre_dispatch_active := FALSE; endprocedure; ! eve$$pre_key_dispatcher ! EVE$TERMINALS.TPU Page 70 procedure eve$$post_key_dispatcher ! Execute post-key procedures ! EVE's post-key procedure dispatcher. Dispatches procedures set by ! eve$set_key_procedure. local temp_array, count, the_key_map_list, the_index, the_program, the_array, the_window, the_column, the_row; on_error [OTHERWISE]: eve$$x_post_dispatch_active := FALSE; endon_error; if eve$$x_post_dispatch_active ! paranoia check then return; endif; ! don't call eve$is_mouse here for speed if get_info (last_key, "type") <> KEYWORD then return; ! read was aborted endif; if get_info (last_key, "mouse_button") <> 0 then if not locate_mouse (the_window, the_column, the_row) then return; endif; the_key_map_list := get_info (the_window, "key_map_list"); else the_key_map_list := get_info (current_buffer, "key_map_list"); endif; the_array := eve$$x_post_key_procedures {the_key_map_list}; if the_array = tpu$k_unspecified then ! shouldn't have been called for this k_m_l set (POST_KEY_PROCEDURE, the_key_map_list, ""); return; endif; eve$$x_post_dispatch_active := TRUE; ! copy the_array indexes so we can step thru the_array even if it changes ! out from under us temp_array := create_array; the_index := get_info (the_array, "first"); loop exitif the_index = tpu$k_unspecified; count := count + 1; temp_array {count} := the_index; the_index := get_info (the_array, "next"); endloop; if count = 0 then ! no post-key procedures active for this k_m_l set (POST_KEY_PROCEDURE, the_key_map_list, ""); eve$$x_post_dispatch_active := FALSE; return; endif; the_index := get_info (temp_array, "first"); loop exitif the_index = tpu$k_unspecified; the_program := the_array {temp_array {the_index}}; ! insure this element wasn't deleted by executing a previous post-key if the_program <> tpu$k_unspecified then execute (the_program); endif; the_index := get_info (temp_array, "next"); endloop; eve$$x_post_dispatch_active := FALSE; endprocedure; ! eve$$post_key_dispatcher ! EVE$TERMINALS.TPU Page 71 procedure eve$$parse_key_with_modifier ! called by eve$$parse_keystring (key_string, ! User input key name expression delimiter_index); ! First delimiter in that same expression ! Performs eve$$parse_keystring's functions once that routine determines ! that the string contains a leading modifier. This routine and ! eve$$parse_keystring call each other to recursively parse and remove ! modifiers from the user's key string. local intermediate_key, ! keyname before we apply our modifier a_modifier_as_string, ! holds the modifer prior to lookup a_modifier_as_keyword; ! results of our lookup a_modifier_as_string := substr (key_string, 1, delimiter_index - 1); ! ! Special case the ^ modifier: assume a CTRL_MODIFIED modifier ! if (delimiter_index = 1) and (substr (key_string, 1, 1) = eve$kt_modifier_delimiter_control) then a_modifier_as_keyword := CTRL_MODIFIED; else ! ! If the modifier lookup failed, then try to handle the whole keystring ! as a single simple key. This handles cases where the user entered ! keyname is multiple words. ! if not eve$$lookup_modifier (a_modifier_as_string, a_modifier_as_keyword) then return eve$$parse_unmodified_key (key_string); endif; endif; ! ! Recursively call eve$$parse_keystring without the modifier. Eventually ! we'll peel all of the modifiers off the user entered keyname expression. ! intermediate_key := eve$$parse_keystring (substr (key_string, delimiter_index + 1)); if intermediate_key = FALSE then return (FALSE); endif; return (key_name (intermediate_key, a_modifier_as_keyword)); ! We're done! endprocedure ! eve$$parse_key_with_modifier ! EVE$TERMINALS.TPU Page 72 procedure eve$$parse_unmodified_key ! assume no modifiers in input (key_string) ! Performs eve$$parse_keystring's functions once that routine determines ! that the string contains no leading modifiers. This routine does not ! expect leading modifiers. local no_names, upper_key_string, key_to_define, expanded_key, multiple_names; ! set if multiplenames from expand_name on_error [TPU$_NONAMES]: no_names := TRUE; ! continue processing [TPU$_MULTIPLENAMES]: multiple_names := TRUE; ! continue processing [TPU$_NOTDEFINABLE]: eve$message (TPU$_NOTDEFINABLE); return (FALSE); [OTHERWISE]: endon_error; if key_string = "" then eve$message (EVE$_NOKEYNAM); return (FALSE); endif; ! ! Single printing characters always represent themselves ! if length (key_string) = 1 then return key_name (key_string); endif; ! ! Lookup the string to see if its a synonym for a TPU keyname ! (DELETE => DEL, RETURN => RET, FIND => E1) ! key_string := eve$$lookup_key (key_string); if key_string = FALSE then return FALSE; endif; expanded_key := expand_name (key_string, KEYWORDS); if no_names then return eve$$parse_unknown_key (key_string); endif; if multiple_names then upper_key_string := key_string; edit (upper_key_string, TRIM, UPPER); expanded_key := expanded_key + " "; if index (expanded_key, upper_key_string + " ") <> 0 then expanded_key := key_string; ! got an exact match else if index (expanded_key, upper_key_string + "_KEY ") <> 0 then expanded_key := (upper_key_string + "_KEY"); ! e.g., tab_key else ! else, punt eve$message (EVE$_AMBKEYNAM, 0, key_string); return (FALSE); endif; endif; endif; if (expanded_key = key_string) then ! do we match a keyword exactly? key_to_define := key_string; else key_to_define := expanded_key; endif; return (execute ("return(key_name (" + key_to_define + "))")); endprocedure ! eve$$parse_unmodified_key ! EVE$TERMINALS.TPU Page 73 procedure eve$$parse_unknown_key ! names of style "xxx(999)" (key_string) ! the user-entered string of form xxx(999) ! Parses a key whose name is not known. Such keys would include function, ! keypad, and control keys not present on the keypads that EVE normally ! deals with. User entered key names of this type are composed of an ! optional modifier such as FUNCTION or KEYPAD followed by an integer ! between 0 and 255 in parenthesis. ! Examples: FUNCTION(23) (123) KEYPAD(17) local type_end, ! points to paren between end modifier/begin integer key_type, ! parsed modifier part of input key_value, ! the parsed integer value a_modifier_as_keyword, ! for modifier lookup tpu_key, ! stores key_value as integer - used in error checking multiple_names; ! set if multiplenames from expand_name constant ! Error handler flags inconsistent key errors in pgm below eve$$x_key_program_header1 := "on_error" + " [TPU$_INCKWDCOM]:" + " eve$message (EVE$_ILLKEYNAM, 0, '" constant eve$$x_key_program_header2 := "');" + " return (false);" + " [OTHERWISE]:" + "endon_error;"; on_error [TPU$_INVNUMSTR]: eve$message (EVE$_ILLKEYNAM, 0, key_string); return (FALSE); [TPU$_INCKWDCOM]: eve$message (EVE$_ILLKEYNAM, 0, key_string); return (FALSE); [OTHERWISE]: endon_error; ! ! Parse key names of type xxx(999) ! type_end := index (key_string, "("); if (type_end = 0) or (index (key_string, ")") <> length (key_string)) then eve$message (EVE$_ILLKEYNAM, 0, key_string); return (FALSE); endif; key_type := substr (key_string, 1, type_end - 1); key_value := substr (key_string, type_end + 1); key_value := substr (key_value, 1, length (key_value) - 1); ! cause a deliberate error if key-value isn't ! an integer tpu_key := int (key_value); if type_end <> 1 then ! A modifier is present. Parse, xlate, and use it if not eve$$lookup_modifier (key_type, a_modifier_as_keyword) then eve$message (EVE$_ILLKEYNAM, 0, key_string); return (FALSE); endif; case a_modifier_as_keyword [FUNCTION]: key_type := "FUNCTION"; [KEYPAD]: key_type := "KEYPAD"; [CTRL_MODIFIED]: key_type := "CTRL_MODIFIED"; [OTHERWISE]: eve$message (EVE$_ILLKEYNAM, 0, key_string); return (FALSE); endcase; return execute (eve$$x_key_program_header1 + key_value + eve$$x_key_program_header2 + "return(key_name (" + key_value + "," + key_type + "))"); else ! no modifier supplied, just use integer portion return execute (eve$$x_key_program_header1 + key_value + eve$$x_key_program_header2 + "return(key_name (" + key_value + "))"); endif; endprocedure ! eve$$parse_unknown_key ! EVE$TERMINALS.TPU Page 74 procedure eve$$lookup_modifier ! called by eve$$parse_keystring (user_modifier_string, ! A modifier as entered by the user modifier_keyword); ! The translated TPU keyword ! Parse a user entered modifier into the TPU keyword it represents. local hit_status, ! how many hits on tble lookup local_user_modifier_string, tpu_modifer_as_string; ! result of table lookup local_user_modifier_string := user_modifier_string; edit (local_user_modifier_string, COMPRESS, TRIM, UPPER, OFF); ! ! Perform a table lookup on user's entry to get translated string ! if not eve$$lookup_string_table (lookup_key (key_name (eve$kt_modif_xlations_key), COMMENT, eve$x_current_language_keymap), local_user_modifier_string, tpu_modifer_as_string, hit_status) then return FALSE; endif; ! ! Check for ambiguous results ! case hit_status [0]: ! ! Take user's input in case user entered a TPU keyword exactly. ! (we don't put exact keywords in the translation tables) ! tpu_modifer_as_string := user_modifier_string; [1]: ! ! Got a hit; we're OK. Take no action ! [2]: ! ! We can't handle ambiguous input ! eve$message (EVE$_AMBKEYNAM, 0, user_modifier_string); return (FALSE); [OTHERWISE]: eve$message (EVE$_COMMANDSTOP); return (FALSE); endcase; ! ! Now take our lookup results and translate to the appropriate keyword ! edit (tpu_modifer_as_string, COMPRESS, TRIM, UPPER, OFF); case tpu_modifer_as_string ["SHIFT_KEY"]: modifier_keyword := SHIFT_KEY; ["FUNCTION"]: modifier_keyword := FUNCTION; ["KEYPAD"]: modifier_keyword := KEYPAD; ["SHIFT_MODIFIED"]: modifier_keyword := SHIFT_MODIFIED; ["CTRL_MODIFIED"]: modifier_keyword := CTRL_MODIFIED; ["HELP_MODIFIED"]: modifier_keyword := HELP_MODIFIED; ["ALT_MODIFIED"]: modifier_keyword := ALT_MODIFIED; [OTHERWISE]: return FALSE; endcase; return TRUE; endprocedure ! eve$$lookup_modifier ! EVE$TERMINALS.TPU Page 75 procedure eve$$lookup_key ! called by eve$$parse_keystring (user_key_string); ! INPUT: string which represents a keyname ! Lookup a user entered key string and return it's translated version, ! or FALSE if no such version exists. local hit_status, tpu_key_name; ! ! Perform a table lookup on user's entry to get translated string ! if not eve$$lookup_string_table (lookup_key (key_name (eve$kt_key_xlations_key), COMMENT, eve$x_current_language_keymap), user_key_string, tpu_key_name, hit_status) then return FALSE; endif; ! ! Check results ! case hit_status [0]: ! ! Take user's input in case user entered a TPU keyword exactly. ! (we don't put exact keywords in the translation tables) ! return (user_key_string); [1]: ! ! Got a hit; we're done. ! return (tpu_key_name); [2]: ! ! We can't handle ambiguous input ! eve$message (EVE$_AMBKEYNAM, 0, user_key_string); return (FALSE); [OTHERWISE]: eve$message (EVE$_COMMANDSTOP); return (FALSE); endcase; endprocedure ! eve$$lookup_key ! EVE$TERMINALS.TPU Page 76 procedure eve$$lookup_string_table ! lookup into a single long string (string_table, ! INPUT: string which holds keyname/key entries string_to_lookup, ! INPUT: string which represents a keyname found_string, ! OUTPUT: Results of the lookup results); ! OUTPUT: 0 = Lookup failed, 1 = Unique, 2 = ambiguous ! This routine does a "table lookup" on single string which contains ! a series of two string entries. Each entry looks like: ! ! eve$kt_key_string_delimiter + string_to_match + ! eve$kt_key_name_delimiter + string_to_return ! ! Given a string to lookup, try to match it against the string_to_match ! in all of the entries in the table. Return the string in the second ! part of the matching entry. Handle abbreviated input and flag ambiguous ! input. ! ! We use a single string instead of an array for the table so we can ! handle abbreviated search strings efficiently. local entry_start, ! Marks start of entry with match, then start of match entry_exact, ! Marks start of entry with exact match local_string_to_lookup, found_string_end, ! Marks end of found_string entry_sub; ! substring of the table string, starting at the match local_string_to_lookup := string_to_lookup; edit (local_string_to_lookup, TRIM, UPPER); entry_start := index (string_table, eve$kt_key_string_delimiter + local_string_to_lookup); if entry_start = 0 then ! Keyname was not found in our translation table results := 0; return TRUE; endif; ! ! Find an exact match, and adjust starting point accordingly. ! entry_exact := index (string_table, eve$kt_key_string_delimiter + local_string_to_lookup + eve$kt_key_string_delimiter); if entry_exact <> 0 then entry_start := entry_exact; endif; ! ! Strip off first part of the table, leaving just the found_string and ! the remainder of the table. ! entry_sub := substr (string_table, entry_start); entry_start := index (entry_sub, eve$kt_key_name_delimiter); entry_sub := substr (entry_sub, entry_start + 1); ! ! Put matching entry in found_string and check for ambiguity ! found_string_end := index (entry_sub, eve$kt_key_string_delimiter); found_string := substr (entry_sub, 1, found_string_end - 1); if index (entry_sub, eve$kt_key_string_delimiter + local_string_to_lookup) <> 0 then if entry_exact <> 0 then results := 1; else results := 2; ! Ambiguous keyname endif; else results := 1; endif; return TRUE; endprocedure ! eve$$lookup_string_table ! EVE$TERMINALS.TPU Page 77 procedure eve$$filter_key ! Filter user-entered keys (the_key, ! Key as entered by the user new_key, ! Alternate key or the_key, will allways be set msg_id) ! If the_key is not valid, then this will hold EVE error keyword ! Verifies that the users' key is valid for binding a learn sequence or an ! EVE command to. Also changes all varieties of mouse drags to ups and ! mouse downs to clicks. local the_modifiers, ! int: bit coded result of key_modifiers get_info local_the_key, ! local version of parameter the_type, ! keyword result of key_type get_info char_pointer, ! temp index into strings the_unmodified_key; ! key: the_key without modifiers new_key := the_key; ! Be sure we have default output values msg_id := TPU$_SUCCESS; ! ! check if illegal mouse key ! if get_info (the_key, "type") = ARRAY then if the_key {0} = eve$k_user_window then local_the_key := the_key {1}; new_key := local_the_key; the_key := local_the_key; else msg_id := EVE$_MOUSEOUTWINDOW; return (FALSE); endif; else local_the_key := the_key; endif; ! ! check if VALID DO key ! if eve$test_synonym ("do", eve$$lookup_comment (local_the_key, "")) then if not eve$$redefine_do_key (local_the_key) then msg_id := EVE$_NODEFDO; ! can't delete last DO key return (FALSE); endif; endif; if local_the_key = get_info (eve$current_key_map_list, "shift_key") then ! it's the shift key msg_id := EVE$_NOGOLDUNDEF; return (FALSE); endif; the_type := get_info (local_the_key, "key_type"); ! ! Filter mouse presses, reject printing keys ! case the_type [CONTROL]: ! ! Reject unmodified RETURN key ! if local_the_key = RET_KEY then msg_id := EVE$_NOKEYDEF; return FALSE; endif; [PRINTING]: ! ! If the key is a simple printing key, then don't bother ! if ascii (local_the_key) <> ascii (0) then ! it's not ALT/modified msg_id := EVE$_NODEFTYP; return FALSE; endif; [FUNCTION, SHIFT_FUNCTION]: ! ! Reject unmodified Mouse button 1 key ! if the_type = FUNCTION then case local_the_key [M1DOWN, key_name (M1DOWN, SHIFT_MODIFIED), M1DRAG, M1UP, M1CLICK, M1CLICK2, M1CLICK3, M1CLICK4, M1CLICK5]: msg_id := EVE$_NODEFINEM1; return (FALSE); endcase; endif; ! ! Translate all mouse downs to clicks, and all drags to ups ! the_unmodified_key := get_info (local_the_key, "unmodified"); case the_unmodified_key [M1DOWN]: new_key := M1CLICK; [M1DRAG]: new_key := M1UP; [M2DOWN]: new_key := M2CLICK; [M2DRAG]: new_key := M2UP; [M3DOWN]: new_key := M3CLICK; [M3DRAG]: new_key := M3UP; [M4DOWN]: new_key := M4CLICK; [M4DRAG]: new_key := M4UP; [M5DOWN]: new_key := M5CLICK; [M5DRAG]: new_key := M5UP; [key_name (M1DOWN, SHIFT_MODIFIED)]: new_key := key_name (M1CLICK, SHIFT_MODIFIED); [key_name (M1DRAG, SHIFT_MODIFIED)]: new_key := key_name (M1UP, SHIFT_MODIFIED); [key_name (M2DOWN, SHIFT_MODIFIED)]: new_key := key_name (M2CLICK, SHIFT_MODIFIED); [key_name (M2DRAG, SHIFT_MODIFIED)]: new_key := key_name (M2UP, SHIFT_MODIFIED); [key_name (M3DOWN, SHIFT_MODIFIED)]: new_key := key_name (M3CLICK, SHIFT_MODIFIED); [key_name (M3DRAG, SHIFT_MODIFIED)]: new_key := key_name (M3UP, SHIFT_MODIFIED); [key_name (M4DOWN, SHIFT_MODIFIED)]: new_key := key_name (M4CLICK, SHIFT_MODIFIED); [key_name (M4DRAG, SHIFT_MODIFIED)]: new_key := key_name (M4UP, SHIFT_MODIFIED); [key_name (M5DOWN, SHIFT_MODIFIED)]: new_key := key_name (M5CLICK, SHIFT_MODIFIED); [key_name (M5DRAG, SHIFT_MODIFIED)]: new_key := key_name (M5UP, SHIFT_MODIFIED); [OTHERWISE]: ! ! the specified key was not a mouse key and we ! may now safely exit ! return TRUE; endcase; ! of local_the_key ! ! Construct modifers string ! ! NOTE that the previous case statement's OTHERWISE CLAUSE filters ! out all cases EXCEPT mouse keys which we need to restore the ! proper modifiers to. ! the_modifiers := get_info (local_the_key, "key_modifiers"); if the_modifiers <> 0 then if (the_modifiers and 1) <> 0 ! -- SHIFT_MODIFIED then new_key := key_name (new_key, SHIFT_MODIFIED); endif; if ((the_modifiers and 2) <> 0) ! -- CTRL_MODIFIED then new_key := key_name (new_key, CTRL_MODIFIED); endif; if (the_modifiers and 4) <> 0 ! -- HELP_MODIFIED then new_key := key_name (new_key, HELP_MODIFIED); endif; if (the_modifiers and 8) <> 0 ! -- ALT_MODIFIED then new_key := key_name (new_key, ALT_MODIFIED); endif; endif; msg_id := EVE$_SUBSTITUTE; ! We switched keys endcase; return TRUE; endprocedure; ! eve$$filter_key ! EVE$TERMINALS.TPU Page 78 ! Module initialization code local screen_length; ! screen length screen_length := get_info (SCREEN, "visible_length"); if (screen_length < (eve$$k_minimum_cct_height + 2)) and (get_info (COMMAND_LINE, "display")) then message (EVE$_SCREENTOOSMALL); quit (OFF, eve$k_error); endif; !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!!! Field Test Variables !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! eve$x_debug := FALSE; ! customer can set true to help us debug qars !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!!! Field Test Variables !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! set (MESSAGE_ACTION_LEVEL, eve$k_warning); set (MESSAGE_ACTION_TYPE, REVERSE); eve$x_prompt := ""; ! Prompt in eve$prompt_buffer eve$x_prompt_length := 0; ! Length of prompt in eve$prompt_buffer ! global state array eve$$x_state_array := create_array (eve$$k_state_array_length, eve$$k_state_array_indexes); eve$$x_state_array {TYPE} := eve$$k_state_context; eve$$x_state_array {eve$$k_clipboard} := FALSE; eve$$x_state_array {eve$$k_message_box} := TRUE; eve$$x_state_array {eve$$k_dialog_box} := TRUE; eve$$x_state_array {eve$$k_pending_delete_enabled} := FALSE; eve$$x_state_array {eve$$k_pending_delete_active} := FALSE; eve$$x_state_array {eve$$k_select_all_active} := FALSE; eve$$x_state_array {eve$$k_in_init_file} := FALSE; ! True if EVE$INIT.EVE running eve$$x_state_array {eve$$k_command_line_flag} := FALSE;! True if exe cmd line eve$$x_state_array {eve$$k_prompt_flag} := FALSE; ! True if prompt reply <> "" eve$$x_state_array {eve$$k_help_active} := FALSE; ! = 1,4 to disable parser error msgs eve$$x_state_array {eve$$k_leading_whitespace} := FALSE; eve$$x_state_array {eve$$k_find_whitespace} := FALSE; eve$$x_state_array {eve$$k_ambiguous_parse} := FALSE; ! True if choices are displayed eve$$x_state_array {eve$$k_is_quoted_string} := FALSE; ! 1 if parser token=quoted str eve$$x_state_array {eve$$k_is_number} := FALSE; ! True if parser token is a number eve$$x_state_array {eve$$k_is_symbol} := FALSE; ! True if parser token is a symbol eve$$x_state_array {eve$$k_wps_upper_case} := FALSE; eve$$x_state_array {eve$$k_wps_lower_case} := FALSE; eve$$x_state_array {eve$$k_ruler_margin_changed} := FALSE; eve$$x_state_array {eve$$k_ruled_status_bold} := FALSE; eve$$x_state_array {eve$$k_ruled_status_blink} := FALSE; eve$$x_state_array {eve$$k_ruled_status_reverse} := FALSE; eve$$x_state_array {eve$$k_ruled_status_underline} := FALSE; eve$$x_state_array {eve$$k_find_case_exact} := FALSE; ! = not exact eve$$x_state_array {eve$$k_find_diacritical} := TRUE; ! = sensitive eve$$x_state_array {eve$$k_saved_resize_mark} := FALSE; ! create the terminator array eve$$x_terminator_array := create_array (1 + 10, 0); ! load the terminator array eve$$x_terminator_array {0} := 0; ! number of used elements in array ! eve$create_terminator returns integer values eve$$x_find_forward_keys := eve$create_terminator ("advance forward"); eve$$x_find_reverse_keys := eve$create_terminator ("backup reverse"); eve$$x_find_toggle_keys := eve$create_terminator ("change_direction"); ! for up/down arrows eve$$x_recall_up_terminators := eve$create_terminator ("move_up recall"); eve$$x_recall_terminators := eve$create_terminator (eve$$x_terminator_array {eve$$x_recall_up_terminators} + " " + "move_down"); ! terminators for eve$prompt_line to act (sort of) like read_line eve$$x_prompt_terminators := eve$create_terminator ("return do exit find wildcard_find help " + "next_screen previous_screen " + ! cmd help "fndnxt " + ! EDT "continue_search_select " + ! WPS "continue_search_key " + ! WPS "search_right_angle"); ! WPS ! terminators for eve$find eve$$x_find_terminators := eve$create_terminator (eve$$x_terminator_array {eve$$x_find_forward_keys} + " " + eve$$x_terminator_array {eve$$x_find_reverse_keys} + " " + eve$$x_terminator_array {eve$$x_find_toggle_keys} + " " + eve$$x_terminator_array {eve$$x_prompt_terminators}); ! terminators for command help eve$$x_help_terminators := eve$create_terminator ("return help exit next_screen previous_screen"); eve$$x_help_vt100_terminators := eve$create_terminator (eve$$x_terminator_array {eve$$x_help_terminators} + " " + "move_up move_down"); ! strings eve$$x_default_message := ""; eve$x_yes := message_text (EVE$_YES, 1); eve$x_no := message_text (EVE$_NO, 1); eve$x_sequence := message_text (EVE$_SEQUENCE, 1); ! define_key in eve_remember eve$x_command_prompt := message_text (EVE$_CMDPROMPT, 1); ! Command prompt for Do key eve$x_command_prompt_length := length (eve$x_command_prompt); ! Length of eve$x_command_prompt ! set cmd pre/post-key filters eve$set_key_procedure (TRUE, eve$x_command_key_map_list, "eve$$command_pre_filter", eve$$k_cmd_pre_filter_id); eve$set_key_procedure (FALSE, eve$x_command_key_map_list, "eve$$command_post_filter", eve$$k_cmd_post_filter_id); ! Create all the necessary default windows eve$x_mouse_list := "EVE$MOUSE_LIST"; ! Init. for use here as a parameter ! Create the message window at the very bottom of the screen. ! Check message window size has been specified if get_info (eve$$x_message_window_size, "type") <> INTEGER then eve$$x_message_window_size := 1; endif; if get_info (message_window, "type") <> WINDOW then message_window := create_window (screen_length - eve$$x_message_window_size + 1, eve$$x_message_window_size, OFF); set (KEY_MAP_LIST, eve$x_mouse_list, message_window); endif; ! Create the command window, prompt window and prompt area, all of which ! go on the next to the last line. if get_info (eve$$x_command_window_size, "type") <> INTEGER then eve$$x_command_window_size := 1; endif; if get_info (eve$command_window, "type") <> WINDOW then eve$command_window := create_window (screen_length - eve$$x_message_window_size - eve$$x_command_window_size + 1, eve$$x_command_window_size, OFF); set (KEY_MAP_LIST, eve$x_mouse_list, eve$command_window); endif; if get_info (eve$prompt_window, "type") <> WINDOW then eve$prompt_window := create_window (screen_length - eve$$x_message_window_size - eve$$x_command_window_size + 1, 1, OFF); set (KEY_MAP_LIST, eve$x_mouse_list, eve$prompt_window); endif; set (PROMPT_AREA, screen_length - eve$$x_message_window_size - eve$$x_command_window_size + 1, 1, REVERSE); ! Create the choice window--used by parser to display choices when a name is ! ambiguous. It overlays the last few lines of the main or bottom window. if get_info (eve$choice_window, "type") <> WINDOW then eve$x_choice_window_length := ((screen_length - eve$$x_message_window_size - eve$$x_command_window_size) / 4) + 1; eve$choice_window := create_window (screen_length - (eve$x_choice_window_length + 1), eve$x_choice_window_length, ON); set (KEY_MAP_LIST, eve$x_mouse_list, eve$choice_window); endif; ! Try to determine if terminal is VT100 or VT200 on VMS V3 and V4. ! If terminal is eight-bit, edit-mode, ansi crt, then assume it ! is a VT200 series terminal. The VT200 bindings are saved in the ! section file by default. The following determines whether there ! is a VT200 out there and if not sets the VT100 numeric keypad. ! (the following must occur after the eve$$x_gold_keys array is created) if eve$on_a_pre_lk201 then if eve$current_keypad = eve$x_numeric_keys then eve$vt100_keys; endif; endif; eve$x_box_select_flag := FALSE; ! normal selections endmodule; ! EVE$TERMINALS.TPU Page 79 ! ! Global Constant and Variable Declarations ! !** constant eve$k_user_window := 0; ! PUT IN EVE$CONSTANTS.SDL constant eve$k_status_line := 1; ! PUT IN EVE$CONSTANTS.SDL !** constant eve$$x_command_prefix := "EVE_"; ! For the parser ! Default error handler for bound keys. Makes CTRL/C print a message, stops ! both learn sequence play-back and repeat loops, and invokes any superior ! CTRL/C handlers. All other errors return 0. ! constant eve$$kt_return := "on_error" + " [TPU$_CONTROLC]:" + " eve$learn_abort;" + " abort;" + " [OTHERWISE]:" + "endon_error; " + "return "; constant eve$k_no_arg := tpu$k_unspecified; ! Place holder when no argument is specified ! Global integer constants constant eve$kt_null := ""; ! Null string constant eve$kt_spaces := " " + " "; ! For padding ! Global get_info arguments constant eve$kt_beyond_eol := "beyond_eol"; constant eve$kt_buffer := "buffer"; constant eve$kt_current_row := "current_row"; constant eve$kt_file_name := "file_name"; constant eve$kt_first := "first"; constant eve$kt_last := "last"; constant eve$kt_left_margin := "left_margin"; constant eve$kt_mode := "mode"; constant eve$kt_name := "name"; constant eve$kt_offset_column := "offset_column"; constant eve$kt_output_file := "output_file"; constant eve$kt_record_count := "record_count"; constant eve$kt_right_margin := "right_margin"; constant eve$kt_type := "type"; constant eve$kt_visible_length := "visible_length"; constant eve$kt_visible_top := "visible_top"; constant eve$kt_width := "width"; constant eve$kt_word_wrap_routine := "eve$$word_wrap"; ! Word wrap routine constant eve$kt_modifier_delimiter_standard := "/", eve$kt_modifier_delimiter_control := "^", eve$kt_modifier_delimiter_sequence := "-", eve$kt_modifier_delimiter_underline := "_", eve$kt_modifier_delimiters := eve$kt_modifier_delimiter_standard + eve$kt_modifier_delimiter_control + eve$kt_modifier_delimiter_sequence + eve$kt_modifier_delimiter_underline, eve$kt_xlate_parameter := eve$kt_modifier_delimiter_standard + eve$kt_modifier_delimiter_standard + eve$kt_modifier_delimiter_standard + eve$kt_modifier_delimiter_standard; constant eve$kt_key_language_prefix := "EVE$KEY_LANGUAGE=", eve$kt_key_string_delimiter := ascii (10), ! (line feed) eve$kt_key_name_delimiter := ascii (13), ! (carrage return) eve$kt_null_program := "on_error; endon_error;", eve$kt_xlations_version := '1.1', ! Version of key translation software eve$kt_xlations_ver_key := ! Holds Version of translation software key_name ('0', ctrl_modified, help_modified, shift_modified, alt_modified), eve$kt_key_xlations_key := ! Holds key cap engraving translations key_name ('1', ctrl_modified, help_modified, shift_modified, alt_modified), eve$kt_modif_xlations_key := ! Holds modifier translations key_name ('2', ctrl_modified, help_modified, shift_modified, alt_modified), eve$k_shift_key_key := ! Each key_name ('3', ctrl_modified, help_modified, shift_modified, alt_modified), eve$k_function_key := ! key key_name ('4', ctrl_modified, help_modified, shift_modified, alt_modified), eve$k_keypad_key := ! comment key_name ('5', ctrl_modified, help_modified, shift_modified, alt_modified), eve$k_shift_modified_key := ! holds key_name ('6', ctrl_modified, help_modified, shift_modified, alt_modified), eve$k_ctrl_modified_key := ! user key_name ('7', ctrl_modified, help_modified, shift_modified, alt_modified), eve$k_help_modified_key := ! names for key_name ('8', ctrl_modified, help_modified, shift_modified, alt_modified), eve$k_alt_modified_key := ! modifier key_name ('9', ctrl_modified, help_modified, shift_modified, alt_modified); variable eve$command_buffer; variable eve$prompt_buffer; variable eve$default_buffer; variable eve$recall_line_buffer; variable eve$restore_buffer; variable eve$x_char_buffer; variable eve$x_word_buffer; variable eve$x_line_buffer; variable eve$x_sentence_buffer; variable eve$x_key_map_list; variable eve$x_keypad_list; variable eve$x_command_key_map_list; variable eve$x_vt100_keys; variable eve$x_standard_keys; variable eve$x_user_keys; variable eve$x_mouse_list; variable eve$x_default_left_margin; variable eve$x_default_right_margin; variable eve$x_keypad; variable eve$$x_synonym_array; variable eve$x_starting_up; variable eve$x_function_key_map_list; variable eve$$x_mouse_down_button; variable eve$$x_resize_new_width; variable eve$$x_resize_new_length; variable eve$$x_resize_old_width; variable eve$$x_resize_old_length; ! The minimal EVE editor requires EVE$TERMINALS.TPU plus the following modules. ! They are commented out because eve$$require doesn't work for modules ! positioned after this one in EVE$MASTER.FILE. Forward procedure references ! to those modules are allowed. !eve$$require ("eve$windows"); !eve$$require ("eve$file"); !eve$$require ("eve$core"); ! EVE$TERMINALS.TPU Page 80 ! ! EVE$BUILD time executable code ! ! Ensure that calls to key routines won't fail during startup by setting ! up the initial keymap. While the caption reads "English", there are no ! English key engravings defined at this point. ! if get_info (eve$x_current_language_keymap, "type") <> STRING then eve$x_current_language_keymap := eve$kt_key_language_prefix + "ENGLISH"; if not eve$key_map_exists (eve$x_current_language_keymap) then eve$x_current_language_keymap := create_key_map (eve$x_current_language_keymap); endif; endif;