%sbttl 'Introduction' MODULE aux_command( ! IDENT = '2' ) = BEGIN ! ! COPYRIGHT (c) 1983 BY ! Project Software & Development, Inc. ! ! This software is furnished under a license and may be used and copied ! only in accordance with the terms of such license and with the ! inclusion of the above copyright notice. This software or any other ! copies thereof may not be provided or otherwise made available to any ! other person. No title to and ownership of the software is hereby ! transferred. ! ! The information in this software is subject to change without notice ! and should not be construed as a commitment by PROJECT SOFTWARE ! AND DEVELOPMENT, INC. ! ! PROJECT SOFTWARE assumes no responsibility for the use or reliability ! of its software on equipment which is not supplied by PROJECT SOFTWARE. ! !++ ! FACILITY: AUXiliary Keypad DCL ! ! ABSTRACT: This module contains routine used to decode internal AUX commands. ! ! ! ENVIRONMENT: VMS Native mode ! ! AUTHOR: M. Erik Husby, CREATION DATE: March 1983 ! ! MODIFIED BY: ! ! MEH, 13-Sep-1983, : VERSION 2 ! 01 - Added Set Statistics command ! 01 - Added Set Default command. !-- ! ! TABLE OF CONTENTS: ! FORWARD ROUTINE aux_commands, aux_clear_screen, define_key, define_symbol, show_key, show_symbol, flipwidth, read_key_with_prompt, show_key_value : Novalue, Set_Statistics, Set_Default ; ! ! ! INCLUDE FILES: ! Library 'SYS$LIBRARY:STARLET'; Require 'SYS$LIBRARY:PSDI'; Library 'SYS$LIBRARY:TPAMAC'; Library 'AUXLIB'; ! ! MACROS: ! ! ! EQUATED SYMBOLS: ! ! ! OWN STORAGE: ! global aux_l_editflags : long, aux_l_cp : long, aux_tables : ref vector[5], aux_result : ref block[,byte], aux_result_display : ref block[,byte] ; own null_string : dynamic_descriptor, tparse_block : block[tpa$k_length0,byte] initial(long(tpa$k_count0,tpa$m_abbrev)) ! We allow abbreviations. ; ! ! EXTERNAL REFERENCES: ! External Literal aux_m_previous, aux_m_whole, aux_invesc, aux_symbol, aux_keynotdef, aux_keyname, aux_keydisplay, aux_nosuchsym, lib$_nosuchsym, aux_unwind ! If this error is signaled, then the stack will ! Get unwound by someone higher up. ; ! ! EXTERNAL REFERENCES: ! External aux_l_statistics : long, new_line : block[,byte], blank : block[,byte], top_stuff : block[,byte], region2_23 : block[,byte], region2_24 : block[,byte], line23 : block[,byte], scroll : block[,byte], line24 : block[,byte], bold_on : block[,byte], reverse : block[,byte], save_cursor : block[,byte], bold_off : block[,byte], cursor_up : block[,byte], clear_line : block[,byte], AUX_mode : block[,byte], AUX_mode_off : block[,byte], wrap_on : block[,byte], wrap_off : block[,byte], restore_cursor : block[,byte] ; External aux_mode_buf : block[,byte], aux_old_mode_buf : block[,byte], aux_tt_chan : word ; EXTERNAL ROUTINE aux_top_line : addressing_mode(general), aux_echo_line : addressing_mode(general), aux_read : addressing_mode(general), aux_search_table : addressing_mode(general), aux_help_keypad : addressing_mode(general), aux_help_keys : addressing_mode(general), aux_set_alarm : addressing_mode(general), aux_get_last : addressing_mode(general), aux_delete_character: addressing_mode(general), aux_delete_line : addressing_mode(general), aux_delete_word : addressing_mode(general), aux_undelete_character: addressing_mode(general), aux_undelete_line : addressing_mode(general), aux_undelete_word : addressing_mode(general), aux_move_character : addressing_mode(general), aux_move_line : addressing_mode(general), aux_move_word : addressing_mode(general), ! sdsub : addressing_mode(general) fortran_sub, str$upcase : addressing_mode(general), lib$get_symbol : addressing_mode(general), lib$set_symbol : addressing_mode(general), lib$delete_symbol : addressing_mode(general), lib$tparse : addressing_mode(general) ; ! %sbttl 'Tparse State Table' $init_state(aux_cmds,aux_keys); $state(, ('$$') ); $state(, ('CLEAR',tpa$_exit,aux_clear_screen), ('DEFINE',define_state), ('DELETE',delete_state), ('FLIPWIDTH',tpa$_exit,flipwidth), ('HELP',help_state), ('LASTCOMMAND',tpa$_exit,aux_get_last), ('MOVE',move_state), ('SHOW',show_state), ('SET',set_state), ('UNDELETE',undelete_state), ); ! ! $$ DEFINE KEY ! Aux will prompt for KEY, Value, and Display value ! ! $$ DEFINE SYMBOL [symbol] [value] ! Aux will associate the symbol (globally) with the value. ! If symbol is not present, it will be prompted for. ! If value is not present, it will be prompted for. ! $state(define_state, ('KEY',tpa$_exit,define_key), ('SYMBOL',tpa$_exit,define_symbol) ); ! ! $$ DELETE [PREVIOUS] WORD ! Delete the [previous] word from the current command. ! ! $$ DELETE [PREVIOUS] CHARACTER ! Delete the [previous] character from the current command. ! ! $$ DELETE LINE ! $$ DELETE TO_START_OF LINE ! $$ DELETE TO_END_OF LINE ! $state(delete_state, ('LINE',delete_line_state,,aux_m_whole,aux_l_editflags), ('PREVIOUS',,,aux_m_previous,aux_l_editflags), ('TO_START_OF',line_state,,aux_m_previous,aux_l_editflags), ('TO_END_OF',line_state), (tpa$_lambda) ); $state(, ('WORD',tpa$_exit,aux_delete_word), ('CHARACTER',tpa$_exit,aux_delete_character) ); $state(line_state, ('LINE',tpa$_exit,aux_delete_line) ); $state(delete_line_state, (tpa$_lambda,tpa$_exit,aux_delete_line) ); ! ! $$ HELP KEYPAD [DETAILED] ! $$ HELP CONTROL_KEYS ! Aux will display either a keypad diagram or a screen full of ! control key definitions. $state(help_state, ('KEYPAD'), ('CONTROL_KEYS',tpa$_exit,aux_help_keys,,,1) ); $state(, ('DETAILED',tpa$_exit,aux_help_keys,,,0), (tpa$_lambda,tpa$_exit,aux_help_keypad) ); ! ! $$ MOVE [BACKWARDS] CHARACTER ! Moves current edit position [backwards] one character. ! ! $$ MOVE To_Start_Of LINE ! $$ MOVE To_End_Of LINE ! Moves current edit position to the end or beginning of the line. ! ! $$ MOVE [BACKWARDS] WORD ! Moves current edit position [backwards] one word. ! $state(move_state, ('BACKWARDS',,,aux_m_previous,aux_l_editflags), ('TO_END_OF'), ('TO_START_OF',,,aux_m_previous,aux_l_editflags), (tpa$_lambda) ); $state(, ('CHARACTER',tpa$_exit,aux_move_character), ('LINE',tpa$_exit,aux_move_line), ('WORD',tpa$_exit,aux_move_word), ); ! ! $$ SHOW KEY ! Aux will prompt for the key to be shown. ! ! $$ SHOW SYMBOL [ symbol_name ] ! Aux will prompt if the symbol name is missing. ! $state(show_state, ('KEY',tpa$_exit,show_key), ('SYMBOL',show_symbol_state) ); $state(show_symbol_state, (tpa$_symbol,tpa$_exit,show_symbol), ! Use supplied symbol name (tpa$_eos,tpa$_exit,show_symbol,,,1) ! Prompt for symbol ); ! ! $$ SET Alarm - Causes the symbol AUX_ALARM to be defined so that the next ! time AUX starts, it rings the bell ! $$ SET DEFAULT - Prompts for an SD2 string and calls SDSUB to change ! default directory. ! $$ SET Statistics {ON|OFF} - Causes the symbol AUX_Statistics to be defined ! or deleted. Also sets the AUX_L_STATISTICS flag. $state(set_state, ('ALARM',tpa$_exit,aux_set_alarm), ('DEFAULT',tpa$_exit,set_default), ('STATISTICS') ); $state(, ('OFF',tpa$_exit,Set_Statistics,,,0), ('ON',tpa$_exit,Set_Statistics,,,1) ); ! ! $$ UNDELETE CHARACTER ! Inserts previously deleted character at current edit position. ! ! $$ UNDELETE LINE ! Inserts previously deleted line at current edit position. ! ! $$ UNDELETE WORD ! Inserts previously deleted word at current edit position. ! $state(undelete_state, ('CHARACTER',tpa$_exit,aux_undelete_character), ('LINE',tpa$_exit,aux_undelete_line), ('WORD',tpa$_exit,aux_undelete_word) ); ! ! Redefine the own and global psects ! psect own=$own$; psect global=$global$; %sbttl 'Aux_commands' Global ROUTINE Aux_commands ( cmd_value : ref block[,byte], cmd_display : ref block[,byte], result : ref block[,byte], result_display: ref block[,byte], keys : ref vector[] ) = ! !++ ! FUNCTIONAL DESCRIPTION: ! This routine is called to parse and execute an Internal AUX command. ! Any errors are signaled. If successfull, we signal AUX_UNWIND so ! that recursive calls are handled properly. ! ! FORMAL PARAMETERS: ! ! cmd_value : address of a descriptor pointing at the command to ! be parsed. ! cmd_display : address of a descriptor pointing at the display value ! of the command. ! ! result : address of a descriptor pointing at the resulting ! DCL command - possibly modified by internal commands. ! result_display : address of a descriptor pointing at the displayable ! resulting DCL command - possibly modified by internal ! commmands. ! ! keys : address of a vector which points to the symbol tables ! to be used when defining keys and showing keys. ! [ 0 ] : address of keypad keys ! [ 1 ] : address of control keys ! [ 2 ] : address of gold keypad keys ! [ 3 ] : address of gold control keys ! [ 4 ] : address of read terminators ! During AUX_command processing, this address is stored ! in the variable KEY_TABLES. ! ! IMPLICIT INPUTS: ! ! NONE ! ! IMPLICIT OUTPUTS: ! ! NONE ! ! ROUTINE VALUE: ! COMPLETION CODES: ! ! NONE ! ! SIDE EFFECTS: ! ! NONE ! !-- BEGIN external literal aux_syntax ; local status, syntax_error : vector[2], save_result : ref block[,byte], save_result_display : ref block[,byte], save_aux_tables : ref vector[5], save_tparse_block : block[tpa$k_length0,byte] ; ! ! Make a local copy of the current OWN variables in case we are called ! recursivly save_result = .aux_result; save_result_display = .aux_result_display; save_aux_tables = .aux_tables; ch$move(tpa$k_length0,tparse_block,save_tparse_block); ! ! Save address of key tables aux_tables = .keys; aux_result = .result; aux_result_display = .result_display; ! ! Then Upcase it, except values inside quotes begin local c : byte, in_quote : initial(0), p ; p = ch$ptr(.cmd_value[dsc$a_pointer]); incr i from 1 to .cmd_value[dsc$w_length] do begin c = ch$rchar(.p); if .c eql %c'"' then in_quote = not .in_quote else if not .in_quote then begin if (.c geq %c'a' ) and (.c leq %c'z') then ch$wchar((.c -%c'a' + %c'A'),.p); end; p = ch$plus(.p,1); end; end; ! ! Now parse and execute the command tparse_block[tpa$l_stringcnt] = .cmd_value[dsc$w_length]; tparse_block[tpa$l_stringptr] = .cmd_value[dsc$a_pointer]; status = lib$tparse(tparse_block,aux_cmds,aux_keys); syntax_error[0] = .tparse_block[tpa$l_stringcnt]; syntax_error[1] = .tparse_block[tpa$l_stringptr]; ! ! Restore saved values. aux_result = .save_result; aux_result_display = .save_result_display; aux_tables = .save_aux_tables; ch$move(tpa$k_length0,save_tparse_block,tparse_block); ! ! If we got a syntax error then say so and unwind the stack if not .status then begin signal(aux_syntax,1,syntax_error); return 0; end else return 1; END; !End of Aux_commands %sbttl 'AUX_Clear_screen' Global ROUTINE AUX_Clear_screen = ! !++ ! FUNCTIONAL DESCRIPTION: ! This tparse action routine clears the screen (Lines 2-24). ! ! FORMAL PARAMETERS: ! ! NONE ! ! IMPLICIT INPUTS: ! ! NONE ! ! IMPLICIT OUTPUTS: ! ! NONE ! ! ROUTINE VALUE: ! COMPLETION CODES: ! ! NONE ! ! SIDE EFFECTS: ! ! NONE ! !-- BEGIN ! ! Clear the screen from lines 2-24 bind clear_2_to_24 = static_descriptor( %char(escape),'[2;1H', ! Goto Row 2, Col 1 %char(escape),'[J', ! Clear screen. %char(escape),'=' ! Set KEYPAD mode ) : block[,byte]; ! ! Zap the screen perform($qio( chan = .aux_tt_chan, func = (io$_writelblk or io$m_noformat), efn = write_flag, p1 = .clear_2_to_24[dsc$a_pointer], p2 = .clear_2_to_24[dsc$w_length] )); Return 1; END; !End of Clear_screen %sbttl 'Define_Key' ROUTINE Define_Key = ! !++ ! FUNCTIONAL DESCRIPTION: ! This routine will define a key. ! ! FORMAL PARAMETERS: ! ! NONE ! ! IMPLICIT INPUTS: ! ! NONE ! ! IMPLICIT OUTPUTS: ! ! NONE ! ! ROUTINE VALUE: ! COMPLETION CODES: ! ! NONE ! ! SIDE EFFECTS: ! ! NONE ! !-- BEGIN bind colon = $descriptor(': '), global_table = uplit(2) ; local key_prompt : dynamic_descriptor, value_prompt : dynamic_descriptor, temp : dynamic_descriptor, result : dynamic_descriptor, result_display : dynamic_descriptor, table_addr : ref symbol_table, index ; concat((key_prompt,line24,reverse,clear_line, $Descriptor('Type key to be defined:'),bold_off,bold_on,aux_mode)); ! ! Prompt for the key to be defined ! If we get a key, then prompt for the key value if read_key_with_prompt(key_prompt,.aux_tables,table_addr,index) then begin ! ! Define the key value bind key_name = .table_addr[.index,sym_a_keyname] : block[,byte], symbol_name = .table_addr[.index,sym_a_command] : block[,byte], symbol_display = .table_addr[.index,sym_a_display] : block[,byte] ; concat((value_prompt,line24,reverse,wrap_on, $Descriptor('Enter definition for key '), key_name,colon,bold_off,bold_on,aux_mode)); ! ! See if we can get some value, if not just return if not aux_read(value_prompt,result,result_display,.aux_tables) then return 1; ! ! Echo the definition concat((temp,result,scroll)); aux_echo_line(value_prompt,temp); ! ! Now define the key perform(lib$set_symbol(symbol_name,result,global_table)); ! ! Now get a display definition, if not given, then delete the symbol free1_dx((result)); free1_dx((result_display)); concat((value_prompt,line24,reverse,wrap_on, $Descriptor('Enter value to be displayed for key '), key_name,colon,bold_off,bold_on,aux_mode)); if aux_read(value_prompt,result,result_display,.aux_tables) then begin ! ! Echo the definition concat((temp,result_display,scroll)); aux_echo_line(value_prompt,temp); ! ! And define the display perform(lib$set_symbol(symbol_display,result_display, global_table)); end else begin local status; if not (status = lib$delete_symbol(symbol_display,global_table)) then if .status neq lib$_nosuchsym then signal(.status); end; end; free1_dx((result)); free1_dx((result_display)); free1_dx((temp)); free1_dx((key_prompt)); free1_dx((value_prompt)); return 1; END; !End of Define_Key %sbttl 'Define_symbol' ROUTINE Define_symbol = ! !++ ! FUNCTIONAL DESCRIPTION: ! Defines an arbitrary DCL symbol - globally. ! ! FORMAL PARAMETERS: ! ! NONE ! ! IMPLICIT INPUTS: ! ! NONE ! ! IMPLICIT OUTPUTS: ! ! NONE ! ! ROUTINE VALUE: ! COMPLETION CODES: ! ! NONE ! ! SIDE EFFECTS: ! ! NONE ! !-- BEGIN external literal aux_notYet; signal(aux_notYet,1,$descriptor('Define Symbol')); return 1; END; !End of Define_symbol %sbttl 'Flipwidth' ROUTINE Flipwidth = ! !++ ! FUNCTIONAL DESCRIPTION: ! This module flips the VT100 width from 80 to 132 to 80. ! ! FORMAL PARAMETERS: ! ! NONE ! ! IMPLICIT INPUTS: ! ! aux_mode_buf,aux_tt_chan ! ! IMPLICIT OUTPUTS: ! ! NONE ! ! ROUTINE VALUE: ! COMPLETION CODES: ! ! 1 ! ! SIDE EFFECTS: ! ! NONE ! !-- BEGIN bind To132 = static_descriptor(%char(escape),'[?3h'), To80 = static_descriptor(%char(escape),'[?3l') ; LOCAL to_ptr : ref block[,byte], new_width ; ! ! ! Based on current width, choose new width. if .aux_mode_buf[d_pw] eql 80 then begin to_ptr = to132; new_width = 132; end else begin to_ptr = to80; new_width = 80; end; ! ! Zap the terminal perform($qio( chan = .aux_tt_chan, func = (io$_writelblk or io$m_noformat), efn = write_flag, p1 = .to_ptr[dsc$a_pointer], p2 = .to_ptr[dsc$w_length] )); ! ! Now tell TTdriver aux_mode_buf[d_pw] = .new_width; perform($qiow( chan = .aux_tt_chan, func = io$_setmode, efn = write_flag, p1 = aux_mode_buf, p2 = 12 )); ! ! And display the top line again. aux_top_line(); return 1; END; !End of Flipwidth %sbttl 'Show_key' ROUTINE Show_key = ! !++ ! FUNCTIONAL DESCRIPTION: ! Shows a key definition. Prompts for key. ! ! FORMAL PARAMETERS: ! ! NONE ! ! IMPLICIT INPUTS: ! ! NONE ! ! IMPLICIT OUTPUTS: ! ! NONE ! ! ROUTINE VALUE: ! COMPLETION CODES: ! ! NONE ! ! SIDE EFFECTS: ! ! NONE ! !-- BEGIN local table_addr : ref symbol_table, index, key_prompt : dynamic_descriptor ; ! ! Yes prompt for input concat((key_prompt,line24,reverse, $Descriptor('Type key to be Shown:'),bold_off,bold_on,aux_mode)); if read_key_with_prompt(key_prompt,.aux_tables,table_addr,index) then show_key_value(.index,.table_addr); free1_dx((key_prompt)); return 1; END; !End of Show_key %sbttl 'Show_symbol' ROUTINE Show_symbol = ! !++ ! FUNCTIONAL DESCRIPTION: ! Shows a symbol definition. ! ! FORMAL PARAMETERS: ! ! TPA$L_PARAM =0, then take symbol name from TPA$L_TOKENCNT and ! TPA$L_TOKENPTR ! TPA$L_PARAM =1, Prompt for symbol name. ! ! IMPLICIT INPUTS: ! ! NONE ! ! IMPLICIT OUTPUTS: ! ! NONE ! ! ROUTINE VALUE: ! COMPLETION CODES: ! ! NONE ! ! SIDE EFFECTS: ! ! NONE ! !-- BEGIN tparse_args; local status, symbol_value : dynamic_descriptor, symbol_name : dynamic_descriptor, prompt : dynamic_descriptor, symbol_display : dynamic_descriptor ; ! ! If param is 0 then symbol has been supplied via TPA$L_TOKENCNT, TOKENPTR if .ap[tpa$l_param] eql 0 then begin ! ! Get the symbol name bind token = ap[tpa$l_tokencnt] : block[,byte] ; copy_dx((symbol_name,token)); end else begin ! ! Need to prompt for it concat((prompt,line24,reverse,wrap_on, $Descriptor('Enter symbol name:'), bold_off,bold_on,aux_mode)); if aux_read(prompt,symbol_name,symbol_display, .aux_tables) then begin append((symbol_display,scroll)); aux_echo_line(prompt,symbol_display); free1_dx((prompt)); free1_dx((symbol_display)); end else copy_dx((symbol_name,null_string)); end; ! ! Now display the symbol name if .symbol_name[dsc$w_length] gtr 0 then begin if (status = lib$get_symbol(symbol_name,symbol_value) ) then signal(aux_symbol,2,symbol_name,symbol_value) else if .status eql lib$_nosuchsym then signal(aux_nosuchsym,1,symbol_name); end; ! ! Free up the dynamic strings. free1_dx((symbol_name)); free1_dx((symbol_value)); return 1; END; !End of Show_symbol %sbttl 'Read_key_with_prompt' ROUTINE Read_key_with_prompt ( prompt : ref block[,byte], tables : ref vector[5], table_addr, index ) = ! !++ ! FUNCTIONAL DESCRIPTION: ! This routine will issue a read with prompt for at most 4 characters, ! which will read all the escape sequences. If the result is ! in one of the key tables, then table_addr and index are valid. ! If input is not found in one of the tables, then returns 0. ! ! FORMAL PARAMETERS: ! ! prompt : address of a prompt to be used. ! tables : address of a vector containing the addess of the ! different symbol tables and terminators. ! table_addr : address of a place to return the table address. ! index : address of a place to return the table index. ! ! IMPLICIT INPUTS: ! ! aux_tables, aux_tt_chan ! ! IMPLICIT OUTPUTS: ! ! NONE ! ! ROUTINE VALUE: ! COMPLETION CODES: ! ! 0 if input not found in tables, 1 if found. ! ! SIDE EFFECTS: ! ! NONE ! !-- BEGIN local io_status : vector[4,word], buffer : vector[4,byte], gold_table : vector[5] ; bind terminator = io_status[2] : word, terminator_size = io_status[3] : word, escape_table = .tables[0] : symbol_table, control_table = .tables[1] : symbol_table, gold_escape_table=.tables[2] : symbol_table, gold_control_table=.tables[3] : symbol_table, terminators = .tables[4] : block[] ; ! ! Ok get some input. perform($qiow( func = (io$_readprompt or io$m_trmnoecho or io$m_Nofiltr), efn = read_flag, chan = .aux_tt_chan, iosb = io_status, p1 = buffer, p2 = 4, p4 = terminators, p6 = .prompt[dsc$w_length], p5 = .prompt[dsc$a_pointer] ) ); ! ! Result of routine depends on the terminator return (selectone .terminator of set [ escape ] : begin local result ; ! ! Got an escape sequence, see if one we recognize selectone .buffer[1] of set [ %c'O',%c'[' ] : begin ! ! If PF1 (gold), then need to do another read using other tables if .buffer[2] eql %c'P' then begin ! ! Call ourselves again to do the second read gold_table[0] = gold_table[2] = .tables[2]; gold_table[1] = gold_table[3] = .tables[3]; gold_table[4] = .tables[4]; result = read_key_with_prompt(null_string,gold_table, .table_addr,.index); end else begin ! ! Search ordinary escape table if ( .index = aux_search_table( .buffer[2] , escape_table) ) neq -1 then .table_addr = escape_table else .table_addr = -1; result = (..index neq -1); end; end; [ escape ] : result = 0; ! Ignore escape,escape [ otherwise ] : begin signal(aux_invesc,1,.buffer[1]); result = 0; end; tes; .result ! Value to be returned. end; [ cr,ctrl_z ] : 0 ; ! Control-z and CR are ignored [ 1 to ctrl_z ] : begin ! ! Search control table if (.index = aux_search_table(.buffer[0],control_table)) neq -1 then .table_addr = control_table else .table_addr = -1 ; (..index neq -1) end; [ otherwise ] : 0 ; ! Any other terminators are ignored tes); END; !End of Read_key_with_prompt %sbttl 'Show_key_value' ROUTINE Show_key_value( index, table_addr : ref symbol_table ) :NOVALUE = ! !++ ! FUNCTIONAL DESCRIPTION: ! This routine will display the value associated with a key given its ! symbol table and index. ! ! FORMAL PARAMETERS: ! ! index : Index of key into the table. ! table_addr : Address of the the table. ! ! IMPLICIT INPUTS: ! ! NONE ! ! IMPLICIT OUTPUTS: ! ! NONE ! ! ROUTINE VALUE: ! COMPLETION CODES: ! ! NONE ! ! SIDE EFFECTS: ! ! NONE ! !-- BEGIN local symbol_value : dynamic_descriptor, status ; bind key_name = .table_addr[.index,sym_a_keyname] : block[,byte], symbol_name = .table_addr[.index,sym_a_command] : block[,byte], symbol_display = .table_addr[.index,sym_a_display] : block[,byte] ; if (status = lib$get_symbol(symbol_name,symbol_value) ) then begin signal(aux_keyname,2,key_name,symbol_value); if lib$get_symbol(symbol_display,symbol_value) then signal(aux_keydisplay,2,key_name,symbol_value); end else if .status eql lib$_nosuchsym then signal(aux_keynotdef,1,symbol_name) else signal(.status); free1_dx((symbol_value)); return; END; !End of Show_key_value %sbttl 'Set_Statistics' ROUTINE Set_Statistics = ! !++ ! FUNCTIONAL DESCRIPTION: ! This tparse routine sets the Aux_L_Statistics flag. ! ! FORMAL PARAMETERS: ! ! Tparse_Block via AP ! ! IMPLICIT INPUTS: ! ! Aux_L_Statistics ! ! IMPLICIT OUTPUTS: ! ! Aux_L_Statistics ! ! ROUTINE VALUE: ! COMPLETION CODES: ! ! 1 ! ! SIDE EFFECTS: ! ! NONE ! !-- BEGIN Tparse_Args; Bind Statistics_Sym = $Descriptor('AUX_STATISTICS') ; ! ! Set the flag depending of tparse parameter. Aux_L_Statistics = .Ap[Tpa$l_Param]; ! ! Now either define or delete the symbol. if .Aux_L_Statistics then ! ! Define the symbol perform(lib$set_symbol(Statistics_sym,$descriptor('Yes'),%ref(2))) else ! ! Delete the symbol perform(lib$Delete_Symbol(Statistics_sym,%ref(2))); Return 1; END; !End of Set_Statistics %sbttl 'Set_Default' ROUTINE Set_Default = ! !++ ! FUNCTIONAL DESCRIPTION: ! Prompts for an SD2 string and calls SDSUB to change the default ! directory. ! ! FORMAL PARAMETERS: ! ! NONE ! ! IMPLICIT INPUTS: ! ! NONE ! ! IMPLICIT OUTPUTS: ! ! NONE ! ! ROUTINE VALUE: ! COMPLETION CODES: ! ! NONE ! ! SIDE EFFECTS: ! ! NONE ! !-- BEGIN bind colon = $descriptor(': ') ; own length, value_prompt : dynamic_descriptor, result : dynamic_descriptor, result_display : dynamic_descriptor, temp : dynamic_descriptor, index ; concat((value_prompt,line24,reverse,clear_line, $Descriptor('$$ Set Default '),bold_off,bold_on,aux_mode)); ! See if we can get some value, if not just return if not aux_read(value_prompt,result,result_display,.aux_tables) then return 1; ! ! Echo the definition concat((temp,result,scroll)); aux_echo_line(value_prompt,temp); ! ! Now change the default and the top line perform(str$Upcase(result,result)); length = .result[dsc$w_length]; ! sdsub(result,length); begin External Literal Aux_NotYet; Signal(Aux_NotYet,1,$Descriptor('Set Default')); aux_top_line(); End; return 1; END; !End of Set_Default END !End of module ELUDOM