! LSE$EVE_TERMINALS.TPU ! !************************************************************************* ! * ! © Copyright 2005 Hewlett-Packard Development Company, L.P. * ! * ! Confidential computer software. Valid license from HP required for * ! possession, use or copying. Consistent with FAR 12.211 and 12.212, * ! Commercial Computer Software, Computer Software Documentation, and * ! Technical Data for Commercial Items are licensed to the U.S. * ! Government under vendor's standard commercial license. * ! * !************************************************************************* ! !++ ! FACILITY: ! VAX Language-Sensitive Editor ! ! ABSTRACT: ! This file contains superceded EVE procedures that are located in the ! file EVE$TERMINALS.TPU. ! ! ENVIRONMENT: ! VAX/VMS ! ! CREATION DATE: 21-DEC-1989 ! ! MODIFIED BY: ! ! X3.1-1 DAS 21-Dec-89 First pass. ! X3.1-2 CCC 14-Feb-90 Fix eve$clear_message to handler /NODISP. ! X3.2 DAS 25-May-90 Performance work superceding ! X3.2-1 DAS 31-May-90 Fix not putting out null messages in EVE$MESSAGE ! X3.2-2 DBH 31-May-90 In EVE$KEY_NAME replaced ',' with ')' (thx DAS) ! X3.2-3 WCC 12-Jul-90 fix eve$prompt_line to ensure the window ! is mapped to buffer when calling unmap. ! X3.2-4 LRH 29-Oct-90 Supersede eve$$lookup_string_table for gold/do bug ! X3.2-5 DAS 30-Dec-90 Suppress single space messages also ! X3.2-6 SHE 20-Feb-91 Modifed eve$key_name to look for ',' and then ')'. ! Restructured calls to lookup key in eve$undefined_key. ! X3.2-7 LRH 26-Feb-91 Superseded eve$$parse_key_with_modifier in order to ! fix a problem with ctrl// being returned as ! ctrl_o_key. This is a hack and should be removed ! when TPU fixes the real problem. ! X4.0-1 WC3 29-Apr-91 Fix eve$key_name to handle shifted space key ! X4.0-2 WC3 13-Jun-91 Prompting consistency, make eve$prompt_line call ! lse$prompt_string ! X4.0-3 DAS 16-Jun-91 Added default value and cancel in eve$prompt_line ! X4.0-4 AVH 22-Jul-91 Added default value of '' in eve$prompt_line when the 3rd ! parameter is missing. ( Make a valid response ). ! X4.0-5 WC3 31-Jul-91 Remove default value from eve$prompt_line ! X4.0-6 SHE 01-Aug-91 Changed UPDATE (ALL) in lse$$eve_prompt_line back ! to UPDATE (eve$prompt_window) ! X4.0-7 WC3 13-Sep-91 Added: ! eve$set_key_procedure ! eve$$pre_key_dispatcher ! eve$$post_key_dispatcher ! eve$$save_key_procedure ! eve$$restore_key_procedure ! eve$$execute_saved_key_procedure ! to fix EVE's deletion of the user's pre and post ! key procedures. We're not sure the EVE team will ! accept the changes so we're superceeding procedures ! X4.0-8 SHE 01-Oct-91 Superseded eve$set_function_keys to avoid having ! EVE's Motif key bindings in our key map list. ! X4.0-9 WC3 12-Dec-91 Remove MODULE/ENDMODULE construct ! X4.0-10 WC3 12-Feb-92 Provide special HELP support in EVE$PROMPT_LINE !- procedure lse$eve_terminals_module_ident return "X4.0-10"; endprocedure; ! ! LSE: Overridden to clear multiple line message windows. The changes are that ! the first n-1 lines are always displayed without the bell while the last line ! is displayed without the bell for null messages only. This routine also ! suppresses the displaying of blank lines if the lines at the end of the ! buffer are already blank. ! procedure eve$clear_message ! Output a null message local saved_window, saved_mark, quiet_lines, null_message, saved_bell_mode, blank_range; 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 we need some blank lines, then count how many are already there and ! then recompute the number needed. Note that this code allows the number ! of quiet lines to go negative, but the testing checks it to be greater ! than zero. ! if ( quiet_lines > 0 ) and !+ ! Check if there is no message buffer (ex. /NODISP ) !- ( get_info ( tpu$x_message_buffer, "type" ) = BUFFER ) then position (end_of (tpu$x_message_buffer)); blank_range := search_quietly (notany (""), REVERSE, EXACT); if blank_range <> 0 then quiet_lines := quiet_lines + 1 + get_info (end_of(blank_range),"record_number") - get_info (end_of(tpu$x_message_buffer),"record_number"); endif; eve$$restore_position (saved_window, saved_mark); endif; ! ! If quiet lines are still needed, then display them ! 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; ! This procedure was copied from eve$message in EVE$TERMINALS.TPU. It has ! been modified to simply return if the text for the message is null or ! contains a single space. ! procedure eve$message (message_arg; ! Output a msg with error/warning flash 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; ! ! LSE CHANGE: Do not display null messages... ! case get_info (message_arg, "type") [INTEGER, KEYWORD]: if (message_text(message_arg) = "") or (message_text(message_arg) = " ") then return; endif; [STRING]: if (message_arg = "") or (message_arg = " ") then return; endif; endcase; ! ! End of LSE change. ! 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; ! We superceed this procedure so that all the EVE calls to it will ! go through LSE's consistent prompting ! procedure eve$prompt_line (prompt, ! Prompt for a line terminator_mask; initial_reply) LOCAL local_prompt, response; IF terminator_mask = HELP THEN ! Special, help processing must be performed by the old ! eve$prompt line renamed lse$$eve_prompt_line ! RETURN lse$$eve_prompt_line( prompt, terminator_mask, initial_reply); ENDIF; IF GET_INFO( initial_reply, 'type' ) = STRING THEN local_prompt := prompt + initial_reply; ELSE local_prompt := prompt; ENDIF; IF lse$prompt_string( , response, local_prompt, '', '' ) THEN return response; ELSE return 0; ENDIF; endprocedure; ! EVE$TERMINALS.TPU Page 16 ! 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. ! Parameters: ! ! 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) ! Returned Value: ! The string entered by the user (user can use last_key to get the ! terminator). procedure lse$$eve_prompt_line(prompt, ! Prompt for a line terminator_mask; initial_reply) local recall_line, ! Recalled string temp_string, ! Returned string 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]: lse$$post_prompt_line; eve$learn_abort; abort; !%IF eve$x_at_least_tpu_2_2 !%THEN [TPU$_READABORTED]: lse$$post_prompt_line; eve$message (EVE$_READABORTED); return; !%ENDIF; [OTHERWISE]: lse$$post_prompt_line; endon_error; if get_info (eve$prompt_window, "buffer") <> 0 then eve$message (EVE$_ALRPROMPTING); return (FALSE); endif; if initial_reply = eve$k_no_arg then initial_reply := ""; endif; ! ! Save all of the information that is necessary ! lse$$pre_prompt_line; 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 + initial_reply); update (eve$prompt_window); eve$x_prompt := prompt; eve$x_prompt_length := length (prompt); 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 !%IF eve$x_at_least_tpu_2_2 !%THEN eve$message (EVE$_NOMOUSEINPROMPT); !%ELSE !% eve$message ("The mouse is not supported during this prompt.", !% eve$k_warning); !%ENDIF; else if lse$$prompt_printing_key (this_key, "tpu$key_map_list") then copy_text(ascii(this_key)); else temp_string := (substr (current_line, eve$x_prompt_length+1, 999)); if (temp_string = "") then !### LSE restorations lse$$post_prompt_line; !### End of change return (""); else if (this_key = DEL_KEY) ! DELETE key then execute (this_key); else !### LSE restorations lse$$post_prompt_line; !### End of change 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; !+ ! LSE must explicitly test for CTRL/C because this prompt may be in ! response to a CMS callback. CMS has set up a CTRL/C ast procedure ! which prevents TPU from seeing the CTRL/C character. !- if (this_key = ctrl_c_key) then eve$message (TPU$_CONTROLC); abort; endif; if ((this_key = DEL_KEY) or (this_key = RIGHT) or (this_key = LEFT)) then if (this_key = DEL_KEY) then if (current_offset > eve$x_prompt_length) then erase_character (-1); endif; else execute (this_key); lse$$prompt_post_filter; endif; else if lse$$prompt_printing_key (this_key) then copy_text(ascii(this_key)); else eve$$parse_comment (this_key,lse$x_cmd_key_map_list,facility,legend,topic); if topic <> "" then exitif index (" " + local_mask + " ", " " + topic + " ") <> 0; if index (" " + eve$$x_terminator_array {eve$$x_recall_terminators} + " ", " " + topic + " ") <> 0 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); erase_line; copy_text (prompt + recall_line); else execute (this_key, lse$x_cmd_key_map_list); lse$$prompt_post_filter; ! update (all); endif; else if eve$is_mouse (this_key) then !%IF eve$x_at_least_tpu_2_2 !%THEN eve$message (EVE$_NOMOUSEINPROMPT); !%ELSE !% eve$message ("The mouse is not supported during this prompt.", !% eve$k_warning); !%ENDIF; else execute (this_key, lse$x_cmd_key_map_list); lse$$prompt_post_filter; ! update (all); endif; endif; if (get_info (eve$prompt_window, "buffer") = 0) then !### LSE restorations lse$$post_prompt_line; !### End of change return; endif; if (current_buffer <> eve$prompt_buffer) then unmap (eve$prompt_window); !### LSE restorations lse$$post_prompt_line; !### End of change 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); ! ### Added by LSE to remove text at end of the prompt buffer. ### ERASE(CREATE_RANGE(MARK(NONE), END_OF(eve$prompt_buffer), NONE)); ! ### end of LSE modification. ### endif; endif; endif; update (eve$prompt_window); endloop; endif; !### Show progress by forcing out the following POSITION(BEGINNING_OF(eve$prompt_buffer)); UPDATE(eve$prompt_window); !### End of change temp_string := substr (current_line, eve$x_prompt_length + 1, length (current_line)); 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; !### LSE restorations lse$$post_prompt_line; return (temp_string); endprocedure; ! ! LSE supercedes to change message if we are in a prompt ! ! EVE$TERMINALS.TPU Page 24 procedure eve$undefined_key (the_key) local undefine_flag, the_string, key_string, key_delimiters, the_word, local_key; on_error eve$message (TPU$_NODEFINITION, 0, "", eve$key_name (the_key)); endon_error; undefine_flag := true; local_key := the_key; if eve$$x_state_array {eve$$k_pending_delete_active} then ! Decwindows typing keys remove the select range if lse$$prompt_printing_key (local_key) then lse$$pending_delete (1); return; endif; endif; the_string:= eve$key_name(local_key); ! special case for ctrl/del_key or shift/ctrl/del_key. Have to convert them ! to ctrl/u key, because pressing ctrl/del_key will get keyname(ctrl_x_key) ! but it really has ctrl/u function. if (the_string = 'CTRL/X') or (the_string = 'SHIFT/CTRL/X') then the_string := 'CTRL/U'; endif; key_string := the_string; key_delimiters := "-_/"; edit(key_string, COMPRESS, TRIM, UPPER, OFF); the_word := eve$$get_next_word (key_string, key_delimiters); ! ! Check special keynames such as SHIFT/ALT/DELETE or ALT/a, give it a last try If (length (key_string) >= 1) AND ((the_word = 'SHIFT') OR (the_word = 'ALT') OR (the_word = 'CTRL')) then loop exitif (length(key_string) <= 0) ; the_word := eve$$get_next_word (key_string, key_delimiters); endloop; if length(key_string) <= 0 then key_string := the_word; ! what's the last substring in keystring? endif; if length(key_string) > 1 ! like 'ALT/SHIFT/DELETE' key then local_key := eve$$parse_keystring(key_string); if (local_key <> 0) then if (lookup_key (local_key, program) <> 0) then undefine_flag := false; execute(local_key); ! e.g. execute DEL_KEY endif; endif; else ! like 'ALT/a' key edit(the_string,invert); ! use original key string local_key := eve$$parse_keystring(the_string); if (local_key <> 0 ) then if (lookup_key(local_key,program) <> 0) then undefine_flag := false; execute(local_key); ! e.g. execute ALT/A key endif; endif; endif; endif; if undefine_flag = true then if eve$in_prompt then eve$message ("Key !AS!AS has no definition at prompts", 0, "", eve$key_name (the_key)); else eve$message (TPU$_NODEFINITION, 0, "", eve$key_name (the_key)); endif; endif; endprocedure; ! ! supersede eve$key_name to handle spaces and double quotes correctly ! 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 end_index; ! LSE only - location of , or ) in key name 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 ! *** why???????????? 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 ! ! Changes for lse: make the_name be everything between the quotes, ! rather than just the first character (this is to deal with ! SPACE_KEY, which used to come out as "S".) Also, if the character ! the user typed was a DOUBLE QUOTE, then it will appear inside ! single quotes, everything else will appear between double quotes. ! Also " " is changed to "SPACE". ! if (the_name = "SPACE_KEY") or (the_name = "KEY_NAME (SPACE_KEY, SHIFT_KEY)") then return the_string + "SPACE"; endif; char_pointer := index (the_name, "'"); if char_pointer <> 0 ! the key is either single-quote or ! double-quote then if substr (the_name, char_pointer - 1, 1) = '"' then !the key is single-quote the_name := "'"; else ! the key is a double-quote the_name := '"'; endif; else ! it's some other character, so extract ! the part between the double-quotes char_pointer := index (the_name, '"'); the_name := substr (the_name, char_pointer + 1, length(the_name) - (char_pointer + 1)); char_pointer := index (the_name, '"'); the_name := substr (the_name, 1, char_pointer - 1); if the_name = " " ! if the character is a space, change to keyword ! "SPACE" then the_name := "SPACE" endif; endif; ! end lse changes ! the_name := substr (the_name, index (the_name, '"') + 1, 1); [OTHERWISE]: ! ! Parse out the non-printing key_name char_pointer := index (the_name, '('); if char_pointer <> 0 then end_index := index (the_name, ','); if end_index = 0 then end_index := index (the_name, ')'); endif; the_name := substr (the_name, char_pointer + 1, end_index - (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 ! ! Superceded for performance work only ! ! 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, 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); temp := create_array (11 + 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; eve$$x_terminator_array {0} := eve$$x_terminator_array {0} + 1; eve$$x_terminator_array {eve$$x_terminator_array {0}} := edit (terminator_list, TRIM, COMPRESS, LOWER, OFF, NOT_IN_PLACE); return (eve$$x_terminator_array {0}); endprocedure; ! eve$create_terminator ! ! The following procedure was extracted from the TPU_BUGS note conference ! note 1425.3, in order to fix a bug with DEFINE KEY GOLD/DO. ! 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 or exact ! 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. ! 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. ! found_string_end := index (entry_sub, eve$kt_key_string_delimiter); found_string := substr (entry_sub, 1, found_string_end - 1); ! ! Check for ambiguity and exact match. ! if index (entry_sub, eve$kt_key_string_delimiter + local_string_to_lookup) <> 0 then if entry_exact <> 0 then results := 1; ! Exact match else results := 2; ! Ambiguous keyname endif; else results := 1; endif; return TRUE; endprocedure ! eve$$lookup_string_table 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; !************************* HACK ALERT ************************************* ! The following code is here as a temporary fix to a TPU problem where * ! CTRL// is being returned as CTRL_O_KEY. A note is posted in TPU_BUGS * ! 1715.0. The code should be removed when TPU does the real fix. * !************************************************************************** if a_modifier_as_keyword = CTRL_MODIFIED then if intermediate_key = KEY_NAME("/") then return US_KEY endif; endif; return (key_name (intermediate_key, a_modifier_as_keyword)); ! We're done! endprocedure ! eve$$parse_key_with_modifier ! LSE change: Added to fix EVE's deletion of the user's pre and post key ! procedures. We're not sure the EVE team will accept the ! changes so we're superceeding procedures ! 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 eve$$restore_key_procedure( pre_key, the_key_map_list ); 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. eve$$save_key_procedure( the_key_map_list ); 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 ! LSE change: Added to fix EVE's deletion of the user's pre and post key ! procedures. We're not sure the EVE team will accept the ! changes so we're superceeding procedures ! 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, "mouse_button") <> 0 then if 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 eve$$restore_key_procedure( true, 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 eve$$restore_key_procedure( true, 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$$execute_saved_key_procedure( true, the_key_map_list ); eve$$x_pre_dispatch_active := FALSE; endprocedure; ! eve$$pre_key_dispatcher ! LSE change: Added to fix EVE's deletion of the user's pre and post key ! procedures. We're not sure the EVE team will accept the ! changes so we're superceeding procedures ! 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, "mouse_button") <> 0 then if 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 eve$$restore_key_procedure( false, 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 eve$$restore_key_procedure( false, 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$$execute_saved_key_procedure( false, the_key_map_list ); eve$$x_post_dispatch_active := FALSE; endprocedure; ! eve$$post_key_dispatcher ! LSE change: Added to fix EVE's deletion of the user's pre and post key ! procedures. We're not sure the EVE team will accept the ! changes so we're superceeding procedures ! procedure eve$$save_key_procedure ! Called to save any pre/post key ! procedures that might be on a ! key map list (the_key_map_list) ! Key map list to use local the_array; ! create the root array when necessary if eve$$x_saved_key_procedures = tpu$k_unspecified then eve$$x_saved_key_procedures := create_array; endif; ! create the keymaplist array when necessary if eve$$x_saved_key_procedures{ the_key_map_list } = tpu$k_unspecified then eve$$x_saved_key_procedures{ the_key_map_list } := create_array( 2, 0 ); endif; ! save the pre/post key procedures the_array := eve$$x_saved_key_procedures{ the_key_map_list }; the_array{ true } := get_info( the_key_map_list, 'pre_key_procedure' ); the_array{ false} := get_info( the_key_map_list, 'post_key_procedure' ); endprocedure; ! LSE change: Added to fix EVE's deletion of the user's pre and post key ! procedures. We're not sure the EVE team will accept the ! changes so we're superceeding procedures ! procedure eve$$restore_key_procedure ! When all the pre/post key procedures ! registered with a keymap are deleted ! we put the user's back ( pre_key, ! true pre_key, false post_key the_key_map_list ) ! Key map list to use local the_array;; ! check that there is something to restore if eve$$x_saved_key_procedures = tpu$k_unspecified then return; endif; if eve$$x_saved_key_procedures{ the_key_map_list } = tpu$k_unspecified then return; endif; the_array := eve$$x_saved_key_procedures{ the_key_map_list }; if the_array = tpu$k_unspecified then return; endif; if the_array{ pre_key } = 0 then return; endif; ! Restore if pre_key then set( pre_key_procedure, the_key_map_list, the_array{ pre_key } ); else set( post_key_procedure, the_key_map_list, the_array{ pre_key } ); endif; endprocedure; ! LSE change: Added to fix EVE's deletion of the user's pre and post key ! procedures. We're not sure the EVE team will accept the ! changes so we're superceeding procedures ! procedure eve$$execute_saved_key_procedure ! Used bu the pre/post key ! dispatchers to execute the user's ! pre/post key procedure ( pre_key, ! true pre_key, false post_key the_key_map_list ) ! Key map list to use local the_array;; ! check that there is something to restore if eve$$x_saved_key_procedures = tpu$k_unspecified then return; endif; the_array := eve$$x_saved_key_procedures{ the_key_map_list }; if the_array = tpu$k_unspecified then return; endif; if the_array{ pre_key } = 0 then return; endif; execute( the_array{ pre_key } ); endprocedure; ! 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); ! ! ## LSE CHANGE ! if the_key_map = eve$x_motif_function_keys then ! ! We don't want EVE's Motif key bindings. Just ours. ! return (TRUE); endif; ! 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