! LSE$EVE_PARSER.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$PARSER.TPU. ! ! ENVIRONMENT: ! VAX/VMS ! ! CREATION DATE: 21-DEC-1989 ! ! MODIFIED BY: ! ! X3.1-1 DAS 21-Dec-89 First pass. ! X3.2 DAS 02-Oct-90 Parser rewrite incorporated ! X3.2-1 DAS 30-Oct-90 Removed ARGN support from parser ! X3.2-2 DAS 01-Nov-90 Added ability to enter raw TPU code ! Made passing arguments as "" or tpu$k_unspecified ! based on global LSE$$X_PARSER_PROMPTING ! X3.2-3 DAS 08-Nov-90 Fix extraneous "" when parser prompting ! X3.2-4 DAS 07-Dec-90 Fix routine calling support to check entire string ! Changed is_symbol/number/quoted_string to variables ! Removed unused is_number support ! X3.2-5 SAA 07-Feb-91 Remove eve$$parse 'prefix' arg and its associated ! capability (e.g., parse TPU builtins). ! Added lse$$strip_choices; implemented multi- ! grammar capability in eve$$parse. ! X3.2-6 SAA 08-Feb-91 eve$$parse can now handle blank lines and comments ! (but not eol-comments...not yet). ! X3.2-7 SAA 08-Feb-91 Modified routine eve$process_command, and added ! to this module, in order to alter "double-DO" ! behaviour. ! X3.2-8 SAA 11-Feb-91 prefixes may now be any arbitrary string ! (no longer use underscore as a delimiter). ! X3.2-9 SAA 04-Mar-91 Fixed bug in 'ambiguous' branches so that argument ! processing is done properly. ! X3.2-10 DAS 08-Apr-91 Help using parser ! X4.0-1 WC3 13-Jun-91 Prompting consistency, remove parser promting ! as an option ! X4.0-2 WC3 11-Jul-91 Replace use of eve$display_choices ! w/lse$prompt_list_buffer ! X4.0-3 WC3 22-Jul-91 Use lse$prompt_list_buffer only when no parameters ! are in the command. i.e. "left side ambiguous" ! X4.0-4 SHE 01-Aug-91 Moved UPDATE within eve$process_command to within ! 'if' body ! X4.0-5 WC3 13-Aug-91 Remove lse$eve_process_command ! X4.0-6 DAS 27-Aug-91 Remove ability to enter raw TPU code ! X4.0-7 SAA 3-Oct-91 Trim leading/trailing whitespace in eve$$parse ! X4.0-8 WC3 18-Oct-91 Fix the parser to make P ambigious for: ! PASTE ! PREVIOUS ... ! ! X4.0-9 DAS 14-Nov-91 Removed empty module init ! X4.0-10 WC3 23-Jan-92 Courtesy of Duane Smith, parser returns anything ! that has an exact match. i.e. "s f" is ! ambiguous with "save file" and "set font" ! but is LSE_S_F exists is will call it without ! asking about ambiguouity. ! X4.0-11 WC3 11-Feb-92 Fix the above fix to only apply to ! "ambiguous 2" ! X4.0-12 WC3 13-Apr-92 Improve parser performance by a factor of 10 by: ! Adding lse$$quick_parse ! Moving comment ascape higher ! Writing lse$$get_token in BLISS ! X4.0-13 SHE 25-Apr-92 Fixed lse$$quick_parse to work from the last stack ! index to the first ! X4.0-14 WC3 28-Apr-92 Fixed lse$$quick_parse to search each prefix before ! reducing the number of tokens ! X4.0-15 WC3 30-Apr-92 Fixed lse$$quick_parse to: ! Detect non-symbols better ! Detect multiple hits in multiple grammars ! X4.0-16 WC3 13-May-92 Fixed lse$$quick_parse to detect ! trailing noise words !- procedure lse$eve_parser_module_ident return "X4.0-16"; endprocedure; ! ! This procedure is superceded in order to save information about the buffer ! such as insert/overstrike setting. ! ! Since this routine also writes out the prompt, we will invert the prompt. ! ! EVE$PARSER.TPU Page 6 ! Procedures to support command-line editor ! Set up command line editor procedure eve$$enter_command_window ! Enter the command window local saved_window, saved_mark; on_error [OTHERWISE]: eve$$restore_position (saved_window, saved_mark); endon_error; saved_window := current_window; saved_mark := mark (FREE_CURSOR); eve$$x_start_do_key := eve$$lookup_comment (last_key, ""); eve$check_bad_window; eve$$x_pre_command_window := current_window; eve$goto_command_window; position (end_of (eve$command_buffer)); if get_info (eve$command_buffer, "record_count") = 0 then ! make entire buffer unmodifiable except the current line copy_text (eve$x_command_prompt); set (RECORD_ATTRIBUTE, create_range (beginning_of (eve$command_buffer), end_of (eve$command_buffer), NONE), MODIFIABLE, OFF); set (RECORD_ATTRIBUTE, mark (NONE), MODIFIABLE, ON); else split_line; ! makes modifiable line move_vertical (-1); copy_text (eve$x_command_prompt); if get_info (eve$command_buffer, "record_count") <= 3 then ! insure initial "get file & @init_file" are made unmodifiable set (RECORD_ATTRIBUTE, create_range (beginning_of (eve$command_buffer), end_of (eve$command_buffer), NONE), MODIFIABLE, OFF); set (RECORD_ATTRIBUTE, mark (NONE), MODIFIABLE, ON); ! makes new line modifiable endif; endif; eve$$x_choice_range := 0; eve$$x_state_array {eve$$k_prompt_flag} := 0; ! set when cmd prompts for arg set (SHIFT_KEY, get_info (eve$x_key_map_list, "shift_key"), eve$x_command_key_map_list); eve$$set_command_line; ! ! LSE - Save the original insert/overstrike setting ! lse$$x_command_line_saved_mode := get_info (eve$command_buffer, "mode"); endprocedure; ! eve$$enter_command_widow ! ! This procedure is superceded in order to restore information about the ! buffer that was saved upon entry. Examples are insert/overstrike setting. ! ! ! EVE$PARSER.TPU Page 7 ! Leave command line editor (unless parser finds an ambiguity, in which case, ! the choices are displayed in the choice window). procedure eve$$exit_command_window ! Start processing the command local saved_window, ! For ^C cleanup if command was executed saved_mark, ! Maintain editing position in command buffer did_repair, ! Boolean set if called eve$$repair_command did_command, ! Boolean set if cmd was executed changed_window, ! Boolean set if on_error should change windows start_mark, ! Start of EVE$$X_CHOICE_RANGE end_mark, ! End of EVE$$X_CHOICE_RANGE current_command_line, ! String containing current command buffer line learn_buffer_name; on_error [TPU$_CONTROLC]: if changed_window ! eve$check_bad_window moved from cmd_w then eve$$restore_position (eve$command_window, saved_mark); else if did_repair! eve$$command_post_filter will not be run, so we have then ! to save the current cmd in eve$$x_saved_command_line ! in case the user modified a previous command eve$$set_command_line; else if did_command ! command was executed, insure command window then ! is cleared saved_window := current_window; saved_mark := mark (FREE_CURSOR); position (end_of (eve$command_buffer)); update (eve$command_window); position (saved_window); position (saved_mark); endif; endif; endif; ! LSE change ! unmap( eve$command_window ); eve$learn_abort; abort; [OTHERWISE]: if changed_window ! eve$check_bad_window moved from cmd_window then eve$$restore_position (eve$command_window, saved_mark); else if did_repair! eve$$command_post_filter will not be run, so we have then ! to save the current cmd in eve$$x_saved_command_line ! in case the user modified a previous command eve$$set_command_line; else if did_command ! command was executed, insure command window then ! is cleared saved_mark := mark (FREE_CURSOR); position (end_of (eve$command_buffer)); update (eve$command_window); position (saved_mark); endif; endif; endif; endon_error; if current_window <> eve$command_window then eve$message (EVE$_NOTINCMD); else saved_mark := mark (NONE); ! padding is ok here changed_window := TRUE; if eve$check_bad_window ! position out of command window then if get_info (eve$$x_pre_command_window, "type") <> WINDOW then eve$$x_pre_command_window := current_window; endif; endif; position (eve$command_window); changed_window := FALSE; position (saved_mark); ! restore command buf editing position eve$$x_stop_do_key := eve$$lookup_comment (last_key, ""); current_command_line := current_line;! save the cmd & restore modified line eve$$repair_command_line; ! (may move saved_mark to next bol) did_repair := TRUE; position (end_of (eve$command_buffer)); move_vertical (-1); set (RECORD_ATTRIBUTE, mark (NONE), MODIFIABLE, ON); erase_line; split_line; ! makes modifiable line move_vertical (-1); copy_text (current_command_line); if substr (current_command_line, 1, eve$x_command_prompt_length) = eve$x_command_prompt then current_command_line := substr (current_command_line, eve$x_command_prompt_length + 1, length (current_command_line)); endif; end_mark := mark (NONE); move_horizontal (-length (current_command_line)); start_mark := mark (NONE); position (end_mark); eve$$x_choice_range := create_range (start_mark, end_mark, NONE); set (RECORD_ATTRIBUTE, mark (NONE), MODIFIABLE, OFF); eve$unmap_if_mapped (eve$choice_window); update (eve$$x_pre_command_window); ! eve$clear_message; eve$$x_prompt_range := 0; eve$$x_state_array {eve$$k_command_line_flag} := TRUE; position (eve$$x_pre_command_window); did_repair := FALSE; did_command := TRUE; ! ! LSE - Restore the original insert/overstrike setting. This must be done ! prior to executing the command. ! set (lse$$x_command_line_saved_mode, eve$command_buffer); ! ^C will now leave cursor in pre_command_window or the one the cmd moves to eve$parser_dispatch (current_command_line); ! may display choices + move to did_command := FALSE; ! window <> pre_command_window eve$$x_state_array {eve$$k_command_line_flag} := FALSE; ! ! LSE -- if the learn buffer is mapped, then map it again to raise it in ! front of the command window. Only do this if the current window ! is not the command window. This fixes QAR 1. ! if (current_window <> eve$command_window) then learn_buffer_name := get_info (lse$$learn_window, "buffer"); if learn_buffer_name <> 0 then saved_window := current_window; saved_mark := mark (FREE_CURSOR); map (lse$$learn_window, learn_buffer_name); position (saved_window); position (saved_mark); endif; endif; ! LSE only uses EVE's command window for GOTO COMMAND under V3.1 ! compatibility. Once it is exited, we don't want it anywhere ! unmap( eve$command_window ); endif; endprocedure; ! ! I have been working on the EVE parser in order to speed it up. I have ! achieved a 2½ time speedup by modifying the attached procedures. The ! procedures have been changed substantially, but still have the same basic ! algorithms. ! ! eve$$get_token ! eve$$parse ! ! The procedure eve$$enough_tokens had a minor change in that the result is ! now returned as the procedure value as opposed to getting a third argument. ! ! The procedure eve$$complete is no longer needed. Extending your section file ! by the attached routines will simply leave eve$$complete as dead code. ! ! The match buffer is no longer used at all. ! There is no longer a 5 token restriction in names. procedure eve$$get_token ! Get next token in the command line ! Description ! EVE$$GET_TOKEN returns the next token in the command line or ! a null string if no more tokens. Normally leaves the cursor on ! the whitespace after a token; exceptions are: ! o will leave it on the "=" in DEFINE=, or DEFINE KEY= ! o will leave it on the character after the "@" in "@file_name" ! ! Tokens include symbols, quoted strings, and punctuation, and strings ! that are "none of the above." A quoted string at the end of a line ! does not have to have a final close quote. ! ! Special cases the "=" in the DEFINE KEY command. ! Special cases the "@" in the @ (ATFILE) command. User may enter the ! command "@file_name" which invoked EVE__AT_FILE(file_name) ! ! Implicit Inputs ! eve$$x_command_line Command entered ! eve$$x_command_index Index into eve$$x_command_line while parsing ! eve$$x_command_length Length of eve$$x_command_line ! ! Implicit Outputs ! lse$$x_token_is_symbol Token only alphanumeric $ _ ! lse$$x_token_is_quoted Token is a quoted string ! ! Return Value ! the token local original_index, ! Original index into command line quote_char, ! Quote character being used for quoted string c, ! Current character in command line closed_quote, ! True if quote_char ends quoted string saw_equals_sign; ! True if equal sign already encountered on_error [OTHERWISE]: endon_error; ! ! Default get_token variables ! lse$$x_token_is_symbol := FALSE; lse$$x_token_is_quoted := FALSE; ! ! Move eve$$x_command_index over whitespace. Stay put if not on whitespace ! when starting. If we reach the end of the command line, then return as ! having not found a token. ! loop if eve$$x_command_index > eve$$x_command_length then return ""; endif; c := substr (eve$$x_command_line, eve$$x_command_index, 1); exitif index (eve$$x_token_separators, c) = 0; eve$$x_command_index := eve$$x_command_index + 1; endloop; ! ! Save this non-whitespace index ! original_index := eve$$x_command_index; ! ! Handle special characters when obtaining the first token for a command. ! Being on the first token for a command is determined by the variable ! eve$$x_uppercase_token (which is the concatenation of all previous tokens ! for this command) being empty. ! if (eve$$x_uppercase_token = "") then ! ! If the character is an '_', then return that character as the token. ! ! Question: Why does this section of code not advance the pointer? ! Question: Why this special case? ! if (c = "_") then return "_"; endif; ! ! If the character is an '@', then return the token _AT_FILE and advance ! the index over the character. ! if (c = "@") then eve$$x_command_index := eve$$x_command_index + 1; lse$$x_token_is_symbol := TRUE; return "_AT_FILE"; endif; endif; ! ! If the character is an '=', then set a flag that will tell us that we've ! already seen an equal sign. Otherwise, set the flag to false. ! saw_equals_sign := (c = '='); ! ! Process symbols. If the current character is a symbol character (defined in ! EVE$CORE to be letters, number, dollar sign and underscore), then process ! this token up to the next non-symbol character. ! ! The exception to this is when obtaining a key specifier on a DEFINE_KEY or ! an UNDEFINE_KEY command in which case we either use everything up to the next ! token separator or we terminate the string if we had not already seen the ! equals sign. ! ! The string "XXX=foo" will return the token XXX. The string "=foo" will return ! the token "=foo". ! if (index (eve$x_symbol_characters, c) > 0) or saw_equals_sign then lse$$x_token_is_symbol := TRUE; loop ! ! If we are currently working on a symbol, then see if it is still a ! symbol. Question: This seems to contradict the definition of ! is_symbol at the top of this routine since the symbol characters ! include $, _, and numbers. ! if lse$$x_token_is_symbol then lse$$x_token_is_symbol := (index (eve$x_symbol_characters, c) <> 0); endif; ! ! Bump the character in the command to the next character. Exit if we ! run off the end of the command line. ! eve$$x_command_index := eve$$x_command_index + 1; exitif eve$$x_command_index > eve$$x_command_length; c := substr (eve$$x_command_line, eve$$x_command_index, 1); ! ! Exit if this character is a token separator ! exitif index (eve$$x_token_separators, c) > 0; ! ! If we see and "=" for the first time and we are in a DEFINE_KEY or ! an UNDEFINE_KEY command, then break the token there. Otherwise, we ! will make the = sign part of the current token. ! if (c = "=") and (not saw_equals_sign) then exitif (index ("EVE_DEFINE_KEY", eve$$x_uppercase_token) <> 0); exitif (index ("EVE_UNDEFINE_KEY", eve$$x_uppercase_token) <> 0); endif; endloop; ! ! The token is all characters from the saved original index to the current. ! return substr (eve$$x_command_line, original_index, eve$$x_command_index - original_index); endif; ! ! Process quoted strings. If the current character is a '"' or a "'", then ! eat all characters looking for either the end of the command line or the ! closing quote. ! if (c = "'") or (c = '"') then ! ! Reflect the quoted string in the state_array variable and remember what ! the opening quote character was. ! ! Question: Why was closed_quote never initialized before? This would ! affect having a single or double quote at the end of the line. ! lse$$x_token_is_quoted := true; quote_char := c; closed_quote := false; ! ! Loop looking for the closing quote character. Exit the loop if we have ! run out of characters. Note that closed_quote will now be false in that ! case. ! loop eve$$x_command_index := eve$$x_command_index + 1; exitif eve$$x_command_index > eve$$x_command_length; c := substr (eve$$x_command_line, eve$$x_command_index, 1); ! ! If the character is the same as the opening quote character, then ! ensure that it is not doubled ('This is '' doubled'). ! if c = quote_char then ! ! Mark the fact that we have found the closing quote. If we do ! detect that this is a doubled quote, we will reset it back to ! not having found the ending quote. ! closed_quote := true; ! ! Advance to next character exiting the loop if there are no more. ! eve$$x_command_index := eve$$x_command_index + 1; exitif eve$$x_command_index > eve$$x_command_length; c := substr (eve$$x_command_line, eve$$x_command_index, 1); ! ! Exit the loop if this is not another quote character. ! exitif c <> quote_char; ! ! This was a double quote situation. Reset the fact that we have ! not found the closing quote. ! closed_quote := false; endif; endloop; ! ! Assign this procedure either the token or add the closing quote first. ! if closed_quote then return substr (eve$$x_command_line, original_index, eve$$x_command_index - original_index); else return substr (eve$$x_command_line, original_index, eve$$x_command_index - original_index) + quote_char; endif; endif; ! ! Non-symbol, non-quoted string. Simply return the next token. ! loop exitif eve$$x_command_index > eve$$x_command_length; exitif index (eve$$x_token_separators, substr (eve$$x_command_line, eve$$x_command_index, 1)) <> 0; eve$$x_command_index := eve$$x_command_index + 1; endloop; return substr (eve$$x_command_line, original_index, eve$$x_command_index - original_index); endprocedure; ! eve$$get_token PROCEDURE lse$$quick_parse (new_command_line) ! ! OUTPUT ! ! new_command_line - TPU statment to execute ! ! RETURN VALUE: ! ! 0 - Nothing useful happened here ! 1 - Use the result, we're done ! LOCAL c, wild_match, loop_index, loop_num_symbols, prefix, prefix_index, expansion_seen, num_tokens, num_symbols, the_token, the_prefix, the_prefix_index, temp_expansion, the_expansion, string_to_expand; ON_ERROR [TPU$_MISSINGQUOTE]: eve$message( ERROR_TEXT ); eve$learn_abort; ABORT; [TPU$_NONAMES] : ; [TPU$_MULTIPLENAMES] : IF wild_match THEN RETURN 0; ELSE wild_match := true; ENDIF; [OTHERWISE]: lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$$quick_parse"); ENDON_ERROR; ! Create the array if it does not exist ! the_expansion := ''; IF get_info (lse$$x_quick_array, 'type') <> ARRAY THEN lse$$x_quick_array := create_array (50); lse$$x_quick_array_quoted := create_array (50); ENDIF; ! Load tokens until we get a non-symbol ! lse$$init_get_token( eve$$x_command_line ); LOOP the_token := lse$$get_token; EXITIF the_token = ''; num_tokens := num_tokens + 1; lse$$x_quick_array {num_tokens} := the_token; c := SUBSTR( the_token, 1, 1 ); lse$$x_quick_array_quoted {num_tokens} := (c = '"') OR (C = "'"); EXITIF (c < 'A') OR ! First char not alpha ((c > 'Z') AND (c < 'a' )) OR (c > 'z') OR (INDEX( the_token, '*' ) <> 0) OR ! Expand name wildcards (INDEX( the_token, '%' ) <> 0) OR lse$$x_quick_array_quoted {num_tokens}; ! Quoted character num_symbols := num_symbols + 1; ENDLOOP; ! Now we must get the rest of the tokens ! LOOP the_token := lse$$get_token; EXITIF the_token = ''; num_tokens := num_tokens + 1; lse$$x_quick_array {num_tokens} := the_token; lse$$x_quick_array_quoted {num_tokens} := (SUBSTR( the_token, 1, 1 ) = '"') OR (SUBSTR( the_token, 1, 1 ) = "'"); ENDLOOP; ! At this point: ! num_tokens - The number of tokens ! num_symbols - The number of symbols that might make up a procedure name ! ! Now we are ready for the meat of this process. Based on the tokens in the ! array and the number of symbols, build a string of the form FOO*BAR*BAZ*. ! ! To do this we loop across the prefixes and the tokens trying to find ! one match. ! ! *** NOTE *** a bug in this loop means a bug in the following "*" loop ! ! Loop across symbols ! loop_num_symbols := num_symbols; LOOP EXITIF loop_num_symbols <= 0; string_to_expand := ''; loop_index := 1; LOOP EXITIF loop_index >= loop_num_symbols; string_to_expand := string_to_expand + lse$$x_quick_array {loop_index} + "_"; loop_index := loop_index + 1; ENDLOOP; string_to_expand := string_to_expand + lse$$x_quick_array {loop_index}; ! Loop across prefixes ! prefix_index := get_info (lse$$x_prefix_stack, "last"); expansion_seen := 0; LOOP ! Done when there are no more prefixes ! EXITIF prefix_index = tpu$k_unspecified; ! Do the expansion ! temp_expansion := EXPAND_NAME( lse$$x_prefix_stack {prefix_index} + string_to_expand, procedures); ! Count the number of expansions. We aren't just done because ! there may be duplicates in other grammars ! IF temp_expansion <> '' THEN IF expansion_seen >= 1 THEN RETURN false; ENDIF; the_expansion := temp_expansion; expansion_seen := 1; ENDIF; ! Next prefix ! prefix_index := GET_INFO (lse$$x_prefix_stack, "previous"); ENDLOOP; ! Done whe we've found something ! EXITIF expansion_seen; ! One less symbol ! loop_num_symbols := loop_num_symbols - 1; ENDLOOP; ! If we didn't get anything, we're done ! IF (the_expansion = '') OR wild_match THEN ! Try again using wild cards ! ! *** NOTE *** a bug in this loop means a bug in the above "_" loop ! ! Loop across symbols ! loop_num_symbols := num_symbols; LOOP EXITIF loop_num_symbols <= 0; string_to_expand := ''; loop_index := 1; LOOP EXITIF loop_index > loop_num_symbols; string_to_expand := string_to_expand + lse$$x_quick_array {loop_index} + "*"; loop_index := loop_index + 1; ENDLOOP; ! Loop across prefixes ! prefix_index := get_info (lse$$x_prefix_stack, "last"); expansion_seen := 0; LOOP ! Done when there are no more prefixes ! EXITIF prefix_index = tpu$k_unspecified; ! Do the expansion ! temp_expansion := EXPAND_NAME( lse$$x_prefix_stack {prefix_index} + string_to_expand, procedures); ! Count the number of expansions. We aren't just done because ! there may be duplicates in other grammars ! IF temp_expansion <> '' THEN IF expansion_seen >= 1 THEN RETURN false; ENDIF; the_expansion := temp_expansion; expansion_seen := 1; ENDIF; ! Next prefix ! prefix_index := GET_INFO (lse$$x_prefix_stack, "previous"); ENDLOOP; ! Done whe we've found something ! EXITIF expansion_seen; ! One less symbol ! loop_num_symbols := loop_num_symbols - 1; ENDLOOP; ENDIF; ! We got exactly one hit because the error trap returns on multiple hits. ! ! Do we have the right number of arguments? ! IF ((num_tokens - loop_num_symbols) < get_info (PROCEDURES, "minimum_parameters", the_expansion)) OR ((num_tokens - loop_num_symbols) > get_info (PROCEDURES, "maximum_parameters", the_expansion)) THEN RETURN 0; ENDIF; ! The above loops don't handle trailing noise words properly. ! Here we test if we've done any trim backs, If we have, then we see ! if the first parameter is a sub-string of the procedure we've found ! if it is then we've failed. ! IF loop_num_symbols < num_symbols THEN IF INDEX( the_expansion, '_' + EDIT( lse$$x_quick_array{loop_num_symbols+1}, UPPER)) <> 0 THEN RETURN 0; ENDIF; ENDIF; ! We have something we can complete ! new_command_line := ''; ! Concatenate the parameters ! loop_num_symbols := loop_num_symbols + 1; LOOP EXITIF loop_num_symbols > num_tokens; IF lse$$x_quick_array_quoted{ loop_num_symbols } = 1 THEN new_command_line := new_command_line + lse$$x_quick_array{loop_num_symbols}; ELSE new_command_line := new_command_line + '"' + lse$$x_quick_array{loop_num_symbols} + '"'; ENDIF; loop_num_symbols := loop_num_symbols + 1; EXITIF loop_num_symbols > num_tokens; new_command_line := new_command_line + ','; ENDLOOP; ! Close it off ! IF new_command_line = '' THEN new_command_line := the_expansion; ELSE new_command_line := the_expansion + '(' + new_command_line + ')'; ENDIF; RETURN 1; endprocedure; procedure eve$$parse ! The EVE parser (line_to_parse; ! Eve command string - input prefix) ! This EVE arg is not supported by LSE. ! Description ! The main parsing procedure. It parses procedure names starting with ! eve$$x_command_prefix, VAXTPU builtins (no prefix), or variable names ! (help informational topics) starting with a prefix passed in the optional ! second argument. ! ! General information about LSE commands: ! 1. They call procedures whose names start with any of the ! enabled grammar prefixes (e.g., "LSE_", "EVE_") ! ! For example, command SHIFT LEFT may call procedure LSE_SHIFT_LEFT ! or EVE_SHIFT_LEFT, depending on the stacking order. (Note also ! that multi-word commands may be typed with space characters ! instead of underscores.) ! ! 3. They can be typed with or without quotation marks. ! ! 4. They can be typed with or without arguments. Default arguments are ! provided (null string where strings are expected, eve$k_no_arg where ! integers are expected). All LSE_xxx procedures are expected to ! prompt for missing arguments. LSE allows only string and integer ! arguments for its commands. ! ! 6. Commands may be subsets/supersets of other commands. The following ! are valid commands: ! SET, SET FOO, SET FOO BAR, SET FOO BAR BLETCH, ... ! ! 7. Commands may have tokens that are substrings of other commands' ! tokens. The following are valid commands: ! SET FOO, SET FOOS ! ! Overview of token processing: ! 1. Test 1st token for only symbol characters ! 2. Expand_name on (prefix + token), put into choice_buffer ! 3. Move through choice buffer looking for exact match ! 4. If not exact, search choice buffer for exact token match, ! subset token match, or substring token match. Move ambiguous matches ! to match_buffer, and search for exactness again. ! 5. Once have a single command, process expected arguments. ! 6. Determine how many arguments expected (eve$argN_...). ! 7. Supply default arguments for missing ones. ! 8. Handle quoted arguments ! 9. Insure argument types are either string or integer ! 10. Handle last argument ! 11. Return complete command string ! ! Calling sequences: EVE_DO ! cmd = "" | | cmd <> "" ! ------<-------------- ----->---- ! cur_w<>cmd_w| cur_w=cmd_w| | ! | | | ! | EVE$$ENTER_COMMAND_WINDOW | ! EVE$EXECUTE_FILE --->EVE$$EXIT_COMMAND_WINDOW | ! | | | ! --------->------------------<------------------ ! | ! EVE$PARSER_DISPATCH ! | ! EVE_HELP EVE$PROCESS_COMMAND EVE$$DEFINE_KEY ! | | | ! -------------->------------------<-------- ! | ! EVE$$PARSE ! Implicit Inputs ! lse$$x_token_is_symbol Token only alphanumeric $ _ ! lse$$x_token_is_quoted Token is a quoted string ! ! eve$$x_state_array {eve$$k_help_active} ! Flag = 1 (help) or 4 (define key) to disable ! parser error messages. If parsing variables, ! then set this so that the illegal/ambiguous ! "command" messages are not output. ! eve$argN_command_name Expected integer arguments (1...N) for a command ! ! Implicit Outputs ! eve$$x_command_line The input line to parse ! eve$$x_command_index Index of next character to process in command ! eve$$x_command_length Length of command line ! eve$$x_state_array {eve$$k_ambiguous_parse} ! Flag = 1 if ambiguous command ! eve$$x_uppercase_token Appended string of all tokens processed so far ! ! Return Value ! success: VAXTPU procedure/variable string, e.g., ! procedure string = EVE_SET_LEFT_MARGIN(eve$k_no_arg), or ! variable string = EVE$KT_TOPIC_EVE_FOOBAR ! failure: null string local parse_result, ! String containing VAXTPU command to execute current_token, ! String currently being processed completion, ! First possible_completion this_buffer, ! Current buffer max_args, ! Maximum arguments expected for this command min_args, ! Maximum arguments expected for this command original_token, ! Copy of current token (not upcased) arg_count, ! Number of argument currently being processed search_pattern, ! Pattern for token look-ahead search_range, ! Found pattern range found_string, ! Found pattern string hit_argument, ! Set if exact match found in valid cmds ! chosen before non-cmd token received the_prefix, ! Prefix for procedure/variable name found_only_one, ! Set if only one command found built_pattern, ! Pattern variable curr_endtoken, curr_subtoken, prev_endtoken, prev_subtoken, current_line_text, current_line_length, uppercase_token_length, beginning_of_range, first_token_flag, ! Set if on first token underscore_index, expanded_name, ! String with all candidate commands expand_name_result, ! 0 = nonames, 1 = onename, 2 = multiple number_of_matches, ! At least one hit in choice buffer choice_mark, ! Marker for erasing text from choice buffer match_string, ! list of procedures matched for a given prefix i, ! array index (induction variable) new_command_line; ! result of quick parse on_error [TPU$_CONTROLC ] : return (""); [TPU$_NONAMES ] : expand_name_result := expand_name_result - 1; [TPU$_MULTIPLENAMES] : expand_name_result := expand_name_result + 1; [OTHERWISE]: endon_error; if prefix <> tpu$k_unspecified then lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse eve$$parse"); endif; !message ("LINE_TO_PARSE = '" + LINE_TO_PARSE + "'"); eve$$x_command_line := edit (line_to_parse, TRIM); eve$$x_state_array {eve$$k_ambiguous_parse} := FALSE; ! ! If this is a comment line or a blank line, this is a "no-op". ! Don't return "", because that indicates an error. Instead, ! return "return". This string can safely be fed to execute() ! or compile() with no ill effects. ! case substr (eve$$x_command_line,1,1) [ '!', '' ]: return "return"; ! the TPU keyword for procedure return. endcase; ! Attempt to do a "quick parse". This improves the speed of executing buffers ! because it is an agressive attempt. ! if lse$$quick_parse (new_command_line) = 1 then ! message ("Quick parse yielded '" + new_command_line + "'"); RETURN new_command_line; endif; eve$$x_command_line := edit (line_to_parse, TRIM); eve$$x_command_length := length (eve$$x_command_line); eve$$x_command_index := 1; erase (eve$choice_buffer); parse_result := ""; ! ! Handle first token separately, outside the loop, for easier diagnostics ! and handling the prefix. ! eve$$x_uppercase_token := ""; original_token := eve$$get_token; !message ("original_token = '" + original_token + "'"); ! ! If the token is not symbol characters, then issue a message after ! inhibiting messages during HELP and DEFINE KEY processing. ! if not lse$$x_token_is_symbol then if (eve$$x_state_array {eve$$k_help_active} <> 1) and (eve$$x_state_array {eve$$k_help_active} <> 4) then eve$message (EVE$_UNRECCMD, 0, original_token); endif; return (""); endif; ! ! Get an uppercased version of the original token into current_token ! current_token := original_token; change_case (current_token, UPPER); ! Check to see if token begins with an enabled grammar prefix. ! If so, simply expand this name and don't attempt to ! do any "layering". ! !if lse$$grammar_prefix(current_token, lse$$k_prefix_begins) <> 0 !then ! expand_name_result := 1; ! eve$$x_uppercase_token := current_token; ! expanded_name := expand_name (current_token, procedures); !else ! ! Prefixes are ordered from 'bottom layer ("first")' to ! 'top layer ("last")'. Routines in a higher layer supercede ! those in a lower layer. ! ! lse$$x_prefix_stack always contains at least one prefix. ! expanded_name := ""; ! string, list of matches expand_name_result := 0; ! count of total matches i := get_info (lse$$x_prefix_stack, "first"); ! "bottom layer" prefix loop the_prefix := lse$$x_prefix_stack {i}; ! get next prefix !message ("the_prefix = '" + the_prefix + "'"); ! ! Default to one hit (each loop). The on_error handlers ! for expand_name will change it to zero or many. ! expand_name_result := expand_name_result + 1; ! ! Get the prefix plus the uppercased token into uppercase_token ! eve$$x_uppercase_token := the_prefix + current_token; !message ("eve$$x_uppercase_token = '" + eve$$x_uppercase_token + "'"); match_string := expand_name (eve$$x_uppercase_token, procedures); ! If at least one name was matched, add it to the list. ! Add a padding space to separate this one from future queries. ! if match_string <> "" then expanded_name := expanded_name + match_string + " "; endif; i := get_info (lse$$x_prefix_stack, "next"); exitif i = tpu$k_unspecified; endloop; !endif; ! ! If there are no matches on the expanded symbol, then issue an error message ! after inhibiting HELP and DEFINE KEY messages. ! if expand_name_result = 0 then ! ! No matching commands. ! if (eve$$x_state_array {eve$$k_help_active} <> 1) and (eve$$x_state_array {eve$$k_help_active} <> 4) then if eve$$x_state_array {eve$$k_in_init_file} then eve$message (EVE$_DONUNDERCMDINI, 0, eve$$x_current_init_cmd); else eve$message (EVE$_DONTUNDERCMD, 0, substr (eve$$x_command_line, 1, eve$$x_command_index-1)); endif; endif; return (""); endif; ! ! Place each expand_name result on a line by itself in the choice buffer. Save ! and restore the current buffer around the call. ! this_buffer := current_buffer; eve$expand_to_choices (expanded_name); position (this_buffer); !lse$prompt_string(,,"Debug pause (initial)"); ! ! Initialize local variables used in the parse. ! first_token_flag := TRUE; found_only_one := FALSE; hit_argument := FALSE; completion := ""; found_string := ""; curr_endtoken := ""; curr_subtoken := ""; lse$$x_parser_total_length := 0; ! ! Loop for parsing command token. Before exiting the loop, assign parse_result ! to the partial command. Set hit_argument if next token was already fetched ! in coming up with an unambiguous command. ! loop !message ("current_token = '" + current_token + "'"); ! ! Set up the main pattern used in this loop. ! ! Note: For better performance, use parens () to group ! strings together! ! if first_token_flag then built_pattern := lse$$x_prefix_pattern + current_token; else built_pattern := built_pattern + (span (eve$x_alphanumeric_characters) | "") + ('_' + current_token); endif; ! ! The one is for the _ ! lse$$x_parser_total_length := lse$$x_parser_total_length + (length (current_token)) + 1; ! ! Compute the search pattern ! search_pattern := built_pattern + (span (eve$x_alphanumeric_characters) | ""); ! ! Move the current subtoken/endtoken patterns into the previous variables ! and figure new ones. ! prev_subtoken := curr_subtoken; curr_subtoken := built_pattern + LINE_END; prev_endtoken := curr_endtoken; curr_endtoken := search_pattern + LINE_END; ! ! Strip all non matches out of the choices buffer. Do not do this on the ! first loop through since that first token was already used to form this ! list. ! position (eve$choice_buffer); position (buffer_begin); if first_token_flag then number_of_matches := get_info (eve$choice_buffer, "record_count"); else number_of_matches := 0; loop choice_mark := mark(none); search_range := search_quietly (search_pattern, FORWARD, EXACT); !message ("search_range = '" + str(search_range) + "'"); exitif search_range = 0; beginning_of_range := beginning_of (search_range); position (beginning_of_range); ! ! If match was not at offset zero, then also remove this line. ! if (current_offset = 0) then number_of_matches := number_of_matches + 1; if (beginning_of_range <> choice_mark) then move_vertical (-1); position (line_end); !fooxxx := create_range (choice_mark, mark(none), reverse); !lse$prompt_string(,,"Debug pause (cull zero)"); erase (create_range (choice_mark, mark(none), none)); endif; move_vertical (1); else position (line_end); !fooxxx := create_range (choice_mark, mark(none), reverse); !lse$prompt_string(,,"Debug pause (cull non-zero)"); erase (create_range (choice_mark, mark(none), none)); endif; endloop; if number_of_matches <> 0 then !fooxxx := create_range (choice_mark, mark(none), reverse); !lse$prompt_string(,,"Debug pause (cull final)"); erase (create_range (choice_mark, buffer_end, none)); ! insert line here so there will be a blank at end position (buffer_end); split_line; position (buffer_begin); endif; endif; ! ! If we found no matches, then either leave the loop or return. We will ! leave the loop if we did something like eat an argument. ! if number_of_matches = 0 then ! ! If the value found_only_one is true, then we found a single hit on ! the last go round and ate an argument. ! if found_only_one then hit_argument := TRUE; exitif; endif; ! ! See if none matched because the last token was an argument ! found_string := eve$$enough_tokens (prev_endtoken, prev_subtoken); !message ("no matches"); !message ("enough_tokens 1 returned '" + found_string + "'"); ! ! If we found the string, then we accidentally ate an argument. Set ! the hit and parse result and leave the loop. ! if found_string <> "" then hit_argument := TRUE; parse_result := found_string; exitif; endif; ! ! See if a single root EVE command is ambiguous with synonyms, and if ! so, use the root command and leave the loop. ! ! ! ! !parse_result := eve$$parse_synonym (the_prefix); !if parse_result <> 0 !then ! hit_argument := TRUE; ! exitif; !endif; ! ! We eliminated commands not having all tokens and have checked to make ! sure we didn't eat a parameter. Now display choices and say don't ! understand command. ! !message ("ambiguous 1"); lse$$x_parser_total_length := 0; parse_result := lse$$strip_choices; if parse_result = "" then if (eve$$x_state_array {eve$$k_help_active} <> 4) and (eve$$x_state_array {eve$$k_help_active} <> 1) then if eve$$x_state_array {eve$$k_in_init_file} then eve$message (EVE$_DONUNDERCMDINI, 0, eve$$x_current_init_cmd); else eve$message (EVE$_DONTUNDERCMD, 0, substr (eve$$x_command_line, 1, eve$$x_command_index-1)); endif; endif; position (this_buffer); return (""); else ! Parse is no longer ambiguous. proceed to argument-phase !message ("unambiguous parse F '" + parse_result + "'"); hit_argument := TRUE; ! the extra token we got was an argument exitif; ! break out of this loop, go on to arg-processing endif; endif; ! ! If we matched exactly one, then determine new completion and parse_result ! from the current uppercase token. ! if number_of_matches = 1 then !message ("one match"); current_line_text := current_line; if (index (current_line_text, eve$$x_uppercase_token) <> 1) then completion := ""; else current_line_length := length (current_line_text); uppercase_token_length := length (eve$$x_uppercase_token); if current_line_length = uppercase_token_length then completion := eve$$x_uppercase_token; else underscore_index := index (substr (current_line_text, uppercase_token_length + 1, current_line_length), "_"); if underscore_index = 0 then completion := current_line_text; else completion := substr (current_line_text, 1, uppercase_token_length+underscore_index-1); endif; endif; endif; parse_result := current_line_text; if not first_token_flag then eve$$x_uppercase_token := completion + "_" + current_token; endif; found_only_one := TRUE; !message ("PARSE_RESULT = '" + PARSE_RESULT + "'"); !message ("EVE$$X_UPPERCASE_TOKEN = '" + EVE$$X_UPPERCASE_TOKEN + "'"); endif; first_token_flag := FALSE; ! ! Get the next token. The command is still ambiguous and there are still ! tokens to be examined. ! original_token := eve$$get_token; current_token := original_token; change_case (current_token, UPPER); ! ! If there were no more tokens. ! if current_token = "" then ! ! Leave if we had a hit while processing the last token. ! exitif found_only_one; ! lse$$strip_choices attempts to disambiguate between ! different grammars (i.e., if choices are same except for prefix). ! !message ("ambiguous 2"); parse_result := lse$$strip_choices; if parse_result = "" then if (eve$$x_state_array {eve$$k_help_active} <> 4) then if eve$x_executing_file then ! ! Display Command from file, display message only ! eve$$x_state_array {eve$$k_ambiguous_parse} := TRUE; if eve$$x_state_array {eve$$k_in_init_file} then eve$message (EVE$_AMBCMDINIT, 0, eve$$x_current_init_cmd); else eve$message (EVE$_AMBCMD, 0, substr (eve$$x_command_line, 1, eve$$x_command_index - 1)); endif; else ! Display the choices on the screen ! return lse$$parse_display_choice( this_buffer ); endif; endif; position (this_buffer); return (""); else !message ("unambiguous parse G '" + parse_result + "'"); hit_argument := TRUE; ! the extra token we got was an argument exitif; ! break out of this loop, go on to arg-processing endif; endif; endloop; ! ! Position back to the main buffer. ! position (this_buffer); !message ("position to buffer '" + get_info (current_buffer,"name") + "'"); !message ("looking for arguments, parse_result = '" + parse_result + "'"); ! ! Check for arguments that this command expects. Insert "" or do not pass ! missing arguments. ! ! How many arguments does TPU know about? ! max_args := get_info (PROCEDURES, "maximum_parameters", parse_result); min_args := get_info (PROCEDURES, "minimum_parameters", parse_result); ! ! Get next token (parsing command name may have completed without getting it) ! if not hit_argument then original_token := eve$$get_token; endif; !message ("ORIGINAL_TOKEN = '" + ORIGINAL_TOKEN + "'"); ! ! Handle commands that take no arguments. ! if max_args = 0 then ! ! If we have no current token, then we are done. ! if original_token = "" then !message ("Intercepted Successful parse A (max=0) '" + parse_result + "'"); !return (""); return (parse_result); ! this is the correct line endif; ! ! Complain about too many or too few arguments only when neither ! HELP nor DEFINE KEY are in use. ! if (eve$$x_state_array {eve$$k_help_active} <> 1) and (eve$$x_state_array {eve$$k_help_active} <> 4) then ! ! If we had eaten an argument and the command is ambiguous, ! then the user had entered "FOO A", but the only commands ! were "FOO B" and "FOO C". ! if (hit_argument) and (get_info (eve$choice_buffer, "record_count") > 2) then ! ! Ambiguous parse ! !message ("ambiguous 3"); lse$$x_parser_total_length := 0; parse_result := lse$$strip_choices; if parse_result = "" then eve$$x_state_array {eve$$k_ambiguous_parse} := TRUE; if eve$$x_state_array {eve$$k_in_init_file} then eve$message (EVE$_AMBCMDINIT, 0, eve$$x_current_init_cmd); else eve$message (EVE$_AMBCMD, 0, substr (eve$$x_command_line, 1, eve$$x_command_index - 1)); endif; position (this_buffer); else position (this_buffer); !message ("Intercepted successful parse H '" + parse_result + "'"); !return (""); return (parse_result); endif; else ! ! Too many arguments ! eve$message (EVE$_TAKESNOARGS, 0, lse$$strip_name(parse_result)); endif; endif; return (""); endif; ! ! We do not process parameters for HELP usage ! if (eve$$x_state_array {eve$$k_help_active} = 1) then return parse_result; endif; ! ! Set the number of arguments already processed ! arg_count := 0; ! ! Add an open paren ! parse_result := parse_result + "("; ! ! Loop to handle arguments, in 4 steps: ! ! 1) If last expected argument, check for closing punctuation ! 2) If last token, handle defaults for remaining arguments ! 3) Handle the current argument (string/integer) ! 4) Get the next token (adding "," between args in parse_result) ! loop ! ! If last argument, handle closing punctuation and return ! if arg_count = max_args then ! ! If we have no current token ! if original_token = "" then !message ("Intercepted Successful parse B '" + parse_result + ")'"); !return (""); ! ! Return closed argument list ! return (parse_result + ")"); else ! ! Complain about too many or too few arguments only when neither ! HELP nor DEFINE KEY are in use. ! if (eve$$x_state_array {eve$$k_help_active} <> 1) and (eve$$x_state_array {eve$$k_help_active} <> 4) then eve$message ( EVE$_TAKESONLY, 0, substr ( lse$$strip_name(parse_result), 1, index(lse$$strip_name(parse_result), "(") - 1), max_args); endif; return (""); endif; endif; ! ! No more tokens, add default values and return. ! if original_token = "" then ! ! Fill in the missing arguments. ! loop ! ! Leave this inner loop of adding null strings when we've ! reached the minimum number. ! exitif arg_count >= min_args; ! ! Leave if we have hit the maximum number of arguments ! exitif arg_count = max_args; ! ! Bump the number of processed arguments and add a null string. ! arg_count := arg_count + 1; parse_result := parse_result + '""'; ! ! Do not add a comma if the rest of the arguments are optional ! exitif arg_count = min_args; ! ! Add a comma if there are more arguments ! if arg_count < max_args then parse_result := parse_result + ","; endif; endloop; !message ("Intercepted Successful parse C '" + parse_result + ")'"); !return (""); ! ! Add the closing paren and return ! return (parse_result + ")"); endif; ! ! Increment the argument count and set handled flag ! arg_count := arg_count + 1; ! ! Default to a string or quoted string variable. ! if lse$$x_token_is_quoted then parse_result := parse_result + original_token; else ! ! Add the rest of the line if this is the last and return it ! if arg_count = max_args then !message ("Intercepted Successful parse D '" + ! eve$$add_final_string (parse_result, original_token) + ! "'" ! ); !return (""); return (eve$$add_final_string (parse_result, original_token)); else ! ! add quotes to the arg ! original_token := eve$$double_quotes (original_token); parse_result := parse_result + '"' + original_token + '"'; endif; endif; ! ! Get next token ! original_token := eve$$get_token; ! ! Ignore user entered commas ! if original_token = "," then original_token := eve$$get_token; endif; ! ! We will add a comma if: ! ! 1. We are less than max_args tokens and we have a token ! 2. We are less than min_args and have no token ! if (original_token = "") then if (arg_count < max_args) then parse_result := parse_result + ","; endif; else if (arg_count < max_args) then parse_result := parse_result + ","; endif; endif; endloop; endprocedure; ! eve$$parse procedure eve$$enough_tokens ! Give parser assistance (endtoken, ! pattern for end of token subtoken); ! pattern for sub token ! Determine if one of the procedure names (commands) in the choice ! buffer matches the token_end_pattern; if more than 1 do, then ! see if one matches the token_sub_pattern for the specified ! token count. ! The token_end_pattern is the normal token pattern with "+ LINE_END" ! appended to the end - for tokens that match other comand tokens that are ! sub or super sets of this command (e.g., SET, SET FOO, SET FOO BAR, ! SET FOO BAR BLETCH) ! The token_sub_pattern is the normal token pattern with the ! "+ PATTERN_TOKEN_END" removed - for tokens that are substrings ! of other command tokens (e.g., SET GRID vs SET GRIDS) ! This procedure is called when: ! 1. There are no more tokens to parse in the command line, yet ! the choice buffer contains more than one procedure name. See if ! any of them match the token_end_pattern. If none is found, ! then the ambiguous commands in choice buffer are displayed. ! If more than 1, then see if any of them match the token_sub_pattern. ! The token count has been decremented to match how many tokens ! were actually found. (token # 1 = CIRCLE in command DRAW CIRCLE) ! 2. The last token gotten (via eve$$get_token) is not part of a command, ! yet the choice buffer contains more than one procedure name. ! (The last token may be either an illegal token, or a command ! argument.) See if any of the procedures in the choice buffer ! match the token end pattern for a token count equal to 1 less ! than the last token. If none is found, then the command ! is illegal. If more than 1, then see if any of them match the ! token_sub_pattern. ! Return status ! null if no match, or procedure name matching the specified token end pattern local found_string, search_pattern, search_range, number_found, result; on_error [OTHERWISE]: endon_error; result := ""; search_pattern := endtoken; position (beginning_of (eve$choice_buffer)); loop exitif mark (NONE) = end_of (eve$choice_buffer); search_range := search_quietly (search_pattern, FORWARD, EXACT); exitif search_range = 0; position (search_range); found_string := current_line; number_found := number_found + 1; exitif number_found > 1; ! only 1 match is allowed move_vertical (1); endloop; if number_found = 1 then result := found_string; else if number_found > 1 then search_pattern := subtoken; number_found := 0; position (beginning_of (eve$choice_buffer)); loop exitif mark (NONE) = end_of (eve$choice_buffer); search_range := search_quietly (search_pattern, FORWARD, EXACT); exitif search_range = 0; position (search_range); found_string := current_line; number_found := number_found + 1; exitif number_found > 1; ! only 1 match is allowed move_vertical (1); endloop; if number_found = 1 then result := found_string; endif; endif; endif; return result; endprocedure; ! eve$$enough_tokens ! ! This routine is called when a parse appears to be ambiguous. ! (i.e., assumes at least 2 names in the eve$choice_buffer) ! The remaining possibility is that the same command-name exists ! in multiple namespaces (i.e., they have different prefixes). ! ! This routine resolves prefix-ambiguities. If the result is ! STILL ambiguous, the choices buffer is reformatted as appropriate. ! ! This routine performs the same kind of operation as eve$strip_choices, ! but in addition: ! 1) Strips multiple prefixes (variable length) ! 2) Removes duplicates (same name, different prefixes) ! 3) Alphabetizes the entries properly ! procedure lse$$strip_choices LOCAL pfix_str, ! prefix string loop_str, name_str, ! name string prefix; ! array of prefixes, indexed by stripped names ON_ERROR [TPU$_NOEOBSTR]: ! current_line gives warning at EOB ! This is OK. ! Still, it would be better to insure that the CHOICES ! buffer will always have a single blank line at the ! bottom. Then this warning will never happen. ! [OTHERWISE]: lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$$strip_choices"); ENDON_ERROR; !lse$prompt_string(,,"Debug pause (lse$$strip_choices begin)"); prefix := create_array; position (beginning_of (eve$choice_buffer)); ! Strip off prefix. Use the properties of TPU arrays to ! alphabetize and remove duplicates. Try to strip off ! longer prefixes before the shorter ones (addresses the ! case of one prefix being a substring of another prefix). ! ! Note: for duplicate entries, the most recent prefix ! will "overwrite" any previous prefix. Therefore, the ! last one written is the "top of the stack" ! loop exitif current_line = ""; pfix_str := get_info (lse$$x_prefix_name, "last"); loop exitif pfix_str = tpu$k_unspecified; if index (current_line, pfix_str) = 1 then name_str := current_line - pfix_str; prefix {name_str} := pfix_str; exitif; endif; pfix_str := get_info (lse$$x_prefix_name, "previous"); endloop; move_vertical (1); endloop; ! Do we have an exact match? ! ! See if any of the array indexes is exactly 'lse$$x_parser_total_length'. ! name_str := get_info (prefix, "first"); lse$$x_parser_total_length := lse$$x_parser_total_length - 1; loop exitif name_str = tpu$k_unspecified; if length (name_str) = lse$$x_parser_total_length then !message ("I think it's " + name_str); return prefix {name_str} + name_str; endif; name_str := get_info (prefix, "next"); endloop; ! Determine if any of the commands is a left most substring of ! all the commands. If there is one, use it. ! ! We know they are in alphabetical order and that if there is a left ! most substring that is will be first. on the list. So we only ! have to test it against the rest of the list ! name_str := get_info (prefix, "first"); loop loop_str := get_info (prefix, "next"); exitif loop_str = tpu$k_unspecified; if index( loop_str, name_str ) <> 1 then name_str := ''; exitif; endif; endloop; ! If name_str survived the above loop, it is the left substring ! of all the commands, use it ! if name_str <> '' then return prefix {name_str} + name_str; endif; ! Write out nice sorted list ! erase (eve$choice_buffer); name_str := get_info (prefix, "first"); loop copy_text (name_str); split_line; name_str := get_info (prefix, "next"); exitif name_str = tpu$k_unspecified; endloop; !lse$prompt_string(,,"Debug pause (lse$$strip_choices end)"); return (""); ! The parse really is ambiguous. endprocedure; ! ! This routine checks the argument string against the ! enabled grammar prefixes. A request string specifies ! what relationship is desired. ! ! lse$$x_prefix_name is used because we must attempt to ! match longer strings before shorter strings (e.g., in ! the case where a shorter prefix is a substring of a ! longer prefix!). ! procedure lse$$grammar_prefix(the_string, the_request) LOCAL name_str, count; ON_ERROR lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$$grammar_prefix"); ENDON_ERROR; name_str := get_info (lse$$x_prefix_name, "last"); count := 0; loop case the_request [lse$$k_prefix_begins]: ! Does the_string begin with this prefix? exitif name_str = tpu$k_unspecified; if index (the_string, name_str) = 1 then return lse$$x_prefix_name { name_str }; ! return stack index endif; [lse$$k_prefix_exact]: ! Is the_string exactly equal to the prefix? exitif name_str = tpu$k_unspecified; if the_string = name_str then return lse$$x_prefix_name { name_str }; ! return stack index endif; [lse$$k_prefix_count]: if name_str = tpu$k_unspecified then return count; endif; count := count + 1; [OTHERWISE]: eve$message (lse$_internerr, 0, "lse$$grammar_prefix"); return 0; endcase; name_str := get_info (lse$$x_prefix_name, "previous"); endloop; return 0; ! the_string does not satisfy the request endprocedure; ! ! Build the initial search pattern used by eve$$parse ! to match the enabled prefixes. Note that if there is ! only one prefix, the 'pattern' is really still a STRING. ! either way is OK since this is a parameter to SEARCH. ! ! Implicit input: ! lse$$x_prefix_name: array of prefixes, indexed by string ! ! Implicit output: ! lse$$x_prefix_pattern: pattern used to search ! procedure lse$$build_prefix_pattern LOCAL name_str; ON_ERROR lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$$build_prefix_pattern"); ENDON_ERROR; lse$$x_prefix_pattern := get_info (lse$$x_prefix_name, "last"); loop name_str := get_info (lse$$x_prefix_name, "previous"); exitif name_str = tpu$k_unspecified; lse$$x_prefix_pattern := lse$$x_prefix_pattern | name_str; endloop; endprocedure; ! ! This routine is like lse$$strip_choices, except that it ! operates on a single string. This is only used to reformat ! a procedure name for use in error messages. ! ! input: a string which is a procedure name with a prefix ! output: mapped name with prefix stripped off ! procedure lse$$strip_name(the_string) LOCAL i; ON_ERROR lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$$strip_name"); ENDON_ERROR; ! which prefix is attached to this string? ! i := lse$$grammar_prefix(the_string, lse$$k_prefix_begins); if i <> 0 then the_string := the_string - lse$$x_prefix_stack {i}; ! strip prefix endif; edit (the_string,LOWER); translate (the_string, " ", "_"); return the_string; endprocedure; procedure lse$$parse_display_choice( this_buffer ) LOCAL parse_result; ON_ERROR [OTHERWISE]: lse$$unexpected_error( ERROR, ERROR_TEXT, ERROR_LINE, "lse$$parse_display_choice"); ENDON_ERROR; translate (eve$choice_buffer, " ", "_"); POSITION (BEGINNING_OF (eve$choice_buffer)); IF lse$prompt_list_buffer (eve$choice_buffer, lse$command_window) THEN lse$$x_last_parse_result := GET_INFO (eve$choice_buffer, 'line'); POSITION( this_buffer ); parse_result := eve$$parse( lse$$x_last_parse_result ); eve$$x_state_array {eve$$k_ambiguous_parse} := TRUE; return parse_result; ENDIF; eve$$x_state_array {eve$$k_ambiguous_parse} := TRUE; lse$$x_last_parse_result := ''; POSITION( this_buffer ); RETURN ''; endprocedure; ! ! Define variables used within this module ! variable lse$$x_token_is_symbol; variable lse$$x_token_is_quoted; variable lse$$x_parser_total_length; variable lse$$x_quick_array;