program auto implicit none c c A program to help the user to generate a DCL command c this program allow the user to complete a commandline c using the CLD tables including the disallows. c c On most places the user can type a TAB to complete the current c verb/qualifier/keyword/value c The program also checks the CLD table for c 1. foreign commands (if they have a CLD table in the image) c 2. @command (upto 8 parameters and a /LOG qualifier) c On most places you get a list of possible items by typing PF2/HELP c c the following keys are supported c c TAB : Select the next possible verb/qual/keyword/value c ^H or F12 : Select the previous possible verb/qual/keyword/value c ^L or F8 : Display a list of valid tokens c PF2/HELP : Display help c Space : Next parameter (if there is one) c / : The next qualifier (if there is one) c Return/Enter : complete the line c ^Z of F10 : abort the input c LF/F12 : Delete last token c <-, -> : Position in token c Delete : Delete character at cursor c ^A, F14 : Toggle insert/overstrike c F10,^Z : Abort input c ^F,F11 : override the type for strings to f.e. outfile c ^R,^W : repaint screen after boadcast c include 'auto.inc' c record /auto_info/ auto_info c logical doit,verbone character*1 terminator character*255 line character*(max_line_length) result integer*4 istat,ptr_command,nkar,nk_result c integer*4 table_init c integer*4 symbols_init integer*4 symbols_exit c integer*4 terminal_init integer*4 terminal_exit c integer*4 auto_get_verb integer*4 terminal_start c integer*4 token_init integer*4 token_exit c integer*4 auto_help_help c logical auto_parse logical cli$present c doit = .false. call lib$get_foreign(line,,nkar) istat = 1 if(.not. auto_parse('auto '//line(1:nkar))) goto 99 c if(cli$present('help')) then istat = auto_help_help('auto',' ','#',0,0) goto 99 endif c auto_info.execute = cli$present('execute') auto_info.info = cli$present('info') auto_info.override = cli$present('override') verbone = cli$present('verbone') c c Init the terminal c istat = terminal_init(auto_info.ptr_terminal_info,'Auto>') if(.not. istat) goto 99 c c Since the terminal_init will use cld parsing, we must reparse the c command line c call auto_parse('auto '//line(1:nkar)) c c init the table info c istat = table_init(auto_info.ptr_table_info,verbone) if(.not. istat) goto 90 c c Init the symbols c istat = symbols_init(auto_info.ptr_symbol_info, 1 auto_info.ptr_table_info, 1 auto_info.ptr_terminal_info, 1 auto_info.do_symbols, 1 auto_info.do_logicals) if(.not. istat) goto 90 c istat = token_init(auto_info.ptr_token_info) if(.not. istat) goto 50 c c c Now get the verb c 10 istat = auto_get_verb(auto_info,terminator,ptr_command) if(.not. istat) goto 40 call terminal_debug(auto_info.ptr_terminal_info,'Back in main', 1 0,dbg_flag_rou) c c Returns c kar_return c kar_space c kar_slash c kar_abort, exit c if(terminator .eq. kar_abort ) goto 40 c c 35 call terminal_get(auto_info.ptr_terminal_info,result,nk_result) c c Clear possible message c call terminal_message(auto_info.ptr_terminal_info,' ') c if(auto_info.execute) then doit = .true. else call terminal_message(auto_info.ptr_terminal_info, 1 'Should execute '//result(1:nk_result)) c c Reinit the line c istat = terminal_start(auto_info.ptr_terminal_info) if(istat) goto 10 endif c 40 call token_exit(auto_info.ptr_token_info) c c Abort wanted c 50 call symbols_exit(auto_info.ptr_symbol_info, 1 auto_info.ptr_terminal_info) c call table_exit(auto_info.ptr_table_info) c 90 call terminal_exit(auto_info.ptr_terminal_info) c 99 if(doit) then if(auto_info.execute) then line(nkar+1:) = '/EXECUTE' nkar = nkar + 8 endif call lib$do_command('pipe '//result(1:nk_result)// 1 ' ; auto'//line(1:nkar)//'/skip') endif call sys$exit(%val(istat)) end c c function auto_get_verb(auto_info,terminator,ptr_command) implicit none c c Get the verb c this can be c 1. a normal dcl-tables verb c 2. a symbol that executes a dcl_command (@) c 3. a symbol that executes a foreign command ($) c 4. a symbol that executes MC(R) , this well revert to case 2 c 5. a symbol that translates to a normal verb (reverts to case 1) c include 'auto.inc' c record /auto_info/ auto_info !:i: terminal block character*1 terminator !:o: terminating char integer*4 ptr_command !:o: ptr to command block (the verb) integer*4 auto_get_verb !:f: functio result c# integer*4 nk_save,tabpos,k,istat,nk_line,idx,nk_beg integer*4 nk_result,ipos,level integer*4 nk_invchar logical match_symbol,special,exact character*(max_line_length) line_save,line character*255 result,invchar c record /command_info/ command_info c integer*4 get_len integer*4 terminal_read integer*4 auto_debug integer*4 terminal_insert integer*4 terminal_replace integer*4 auto_msg integer*4 symbols_match integer*4 table_match_verb integer*4 table_set_image integer*4 table_close_image logical*4 auto_check_printable integer*4 str$find_first_in_set c integer*4 auto_help_add integer*4 auto_help_display integer*4 auto_help_help integer*4 auto_get_command c external auto_msg_ambigv external auto_msg_invverb external auto_msg_invchar external auto_msg_swimag c c nk_beg contains the mark point to the beginning c this is either the begining of the line c or the first verb after the foreign command c e.g. "uaf create" has either 0 or 4 c nk_beg = 0 level = 1 call auto_debug_enter(auto_info,'get_verb',0, 1 .true.,level) c c Restart for all except for tab (expand) and help c 10 tabpos = 0 call terminal_get(auto_info.ptr_terminal_info,line_save,nk_save) c c Restart for expand/expand_prev c 20 istat = terminal_read(auto_info.ptr_terminal_info,terminator,nk_beg, 1 auto_info.ptr_table_info, 1 auto_info.execute) if(.not. istat) goto 90 if(terminator .eq. kar_debug) then istat = auto_debug(auto_info) if(.not. istat) goto 90 goto 20 endif call terminal_get(auto_info.ptr_terminal_info,line,nk_line) c c Process the terminators c 21 if(terminator .eq. kar_expand .or. 1 terminator .eq. kar_expand_prev) then c c Expand(-prev) c if(terminator .eq. kar_expand) then tabpos = tabpos + 1 else if(tabpos .eq. 1) goto 22 !to tabpos 0 (original line) if(tabpos .eq. 0) goto 10 !ignore tabpos = tabpos - 1 endif c c NNow try to find the 'tabpos'th possible symbol/verb c If nk_beg >0, only verbs can be used (since the first part was the c image, and symbols do not expand in the image) c match_symbol = .false. k = tabpos if(nk_beg .eq. 0) then call symbols_rewind(auto_info.ptr_symbol_info, 1 auto_info.ptr_terminal_info) do while(symbols_match(auto_info.ptr_symbol_info, 1 line_save(nk_beg+1:nk_save), 1 auto_info.verb,auto_info.nk_verb, 1 exact,1, 1 auto_info.ptr_terminal_info,.false.)) k = k - 1 if(k .eq. 0) then c c Got the tabpos'th match, go display c line(nk_beg+1:) = result(1:nk_result) nk_line = nk_beg + nk_result match_symbol = .true. goto 23 endif end do endif c c the symbols did not satisfy the query, now try the verbs c these are either the normal DCL verbs, or the verbs in the image c (after a foreign command) c idx = 1 do while(table_match_verb(auto_info.ptr_table_info, 1 line_save(nk_beg+1:nk_save), 1 auto_info.verb,auto_info.nk_verb, 1 idx,ptr_command,exact)) k = k - 1 if(k .eq. 0) then c c Match, go display c line(nk_beg+1:) = auto_info.verb(1:auto_info.nk_verb) nk_line = nk_beg + auto_info.nk_verb match_symbol = .false. goto 23 endif end do c c Not found, so restore original line c 22 istat = terminal_replace(auto_info.ptr_terminal_info, 1 line_save(1:nk_save),.false.) if(.not. istat) goto 90 goto 10 c c Found a match, adapt the display c 23 istat = terminal_replace(auto_info.ptr_terminal_info, 1 auto_info.verb(1:auto_info.nk_verb), 1 .false.) if(.not. istat) goto 90 goto 20 c elseif(terminator .eq. kar_help) then c c User wants help, see if the current match is a symbol c auto_info.image = ' ' if(match_symbol) then c c Get the symbol value, and see if it is an image or a foreign command c call symbols_get_value(auto_info.ptr_symbol_info, 1 result,nk_result) if(result(1:1) .eq. '$') then auto_info.image = result(2:nk_result) elseif(result(1:1) .eq. '@') then auto_info.image = '@' endif endif istat = auto_help_help(auto_info.verb(1:auto_info.nk_verb),' ', 1 auto_info.image,0, 1 auto_info.ptr_terminal_info) if(.not. istat) goto 90 goto 20 !do not destroy expand/prev expa contents c elseif(terminator .eq. kar_back) then c c We got a delete on the first pos c either beginning of line (ignore) c or the beginning of the verb of the foreign command c (skip the foreign command and return to normal verb) c if(nk_beg .gt. 0) then c c We had a symbol translation, go to the first verb c istat = table_close_image(auto_info.ptr_table_info) if(.not. istat) goto 90 c c Set mark point to the beginning, and execute a delete c nk_beg = 0 terminator = kar_delete goto 21 endif goto 10 elseif(terminator .eq. kar_list) then call auto_help_init(auto_info.ptr_terminal_info) if(nk_beg .eq. 0) then call symbols_rewind(auto_info.ptr_symbol_info, 1 auto_info.ptr_terminal_info) do while(symbols_match(auto_info.ptr_symbol_info, 1 line(nk_beg+1:nk_line), 1 result,nk_result,exact,1, 1 auto_info.ptr_terminal_info,.false.)) if(.not. auto_help_add(auto_info.ptr_terminal_info, 1 result(1:nk_result))) goto 34 end do endif c idx = 1 do while(table_match_verb(auto_info.ptr_table_info, 1 line(nk_beg+1:nk_line), 1 auto_info.verb,auto_info.nk_verb, 1 idx,ptr_command,exact)) if(.not. auto_help_add(auto_info.ptr_terminal_info, 1 auto_info.verb(1:auto_info.nk_verb))) goto 34 end do 34 istat = auto_help_display(auto_info.ptr_terminal_info,'Verb') c elseif(terminator .eq. kar_return .or. 1 terminator .eq. ' ' .or. 1 terminator .eq. '/') then c c Now execute the command c c See how many matches we have c k = 0 match_symbol = .false. if(nk_beg .eq. 0) then call symbols_rewind(auto_info.ptr_symbol_info, 1 auto_info.ptr_terminal_info) do while(symbols_match(auto_info.ptr_symbol_info, 1 line(nk_beg+1:nk_line), 1 result,nk_result,exact,1, 1 auto_info.ptr_terminal_info,.false.)) k = k + 1 match_symbol = .true. if(exact) goto 45 end do end if c idx = 1 do while(table_match_verb(auto_info.ptr_table_info, 1 line(nk_beg+1:nk_line), 1 auto_info.verb,auto_info.nk_verb, 1 idx,ptr_command,exact)) match_symbol = .false. k = k + 1 if(exact) goto 45 end do exact = k .eq. 1 c 45 if(exact) then c c Only one match, c this comes from c a. the symbol table c b. a real verb c auto_info.image = ' ' !assume in dcl verb c if(match_symbol) then c c It was from the symbol table c now take the verb part of the symbol c and let it set the pointer to the command block c call symbols_get_value(auto_info.ptr_symbol_info, 1 line,nk_line) c c The first char discriminates for 3 cases c c 1. $ foreign command c 2. @ Command procedure c 3. MCR image c 4. rest, must be a valid verb c 54 if(line(1:1) .eq. '$') then c c Now read the file in memory and return a pointer to the command block c auto_info.image = line(2:nk_line) c istat = table_set_image(auto_info.ptr_table_info, 1 line(2:nk_line),auto_info.ptr_terminal_info, 1 special,auto_info.verb, 1 auto_info.ptr_symbol_info,result(1:nk_result)) if(.not. istat) goto 90 c istat = auto_msg(auto_info.ptr_terminal_info,auto_msg_swimag, 1 line(2:nk_line)) if(.not. istat) goto 90 c c Now some images have only one verb defined. c they parse the command line and insert the (only) verb themselves, and c this verb must not be on the command line. c So the default action here the assume that an image with only one c verb does not need the verb in front of the command. c If the user specified /verbone on the command line for this program c the verb must be entered here c if(special) then c c Image has only one verb, and user did not specify /verbone c now we set the ptr_command to the only verb and exit c idx = 1 auto_info.nk_verb = get_len(auto_info.verb) call table_match_verb(auto_info.ptr_table_info, 1 auto_info.verb(1:auto_info.nk_verb), 1 line,nk_line,idx,ptr_command,exact) c else c c Either the image has more than one verb c or the user specified verbone c istat = terminal_insert(auto_info.ptr_terminal_info,' ') if(.not. istat) goto 90 c call terminal_get_nkar(auto_info.ptr_terminal_info,nk_beg) c goto 10 endif elseif(line(1:1) .eq. '@') then c c Now build a cli table for a @ procedure, and return the pointer to the command block c call table_set_command_proc(auto_info.ptr_table_info, 1 auto_info.ptr_symbol_info, 1 auto_info.ptr_terminal_info, 1 result(1:nk_result)) auto_info.verb = '@' auto_info.nk_verb = 1 idx = 1 call table_match_verb(auto_info.ptr_table_info, 1 auto_info.verb(1:auto_info.nk_verb), 1 line,nk_line,idx,ptr_command,exact) c c Now for the help , set image the @ and the verb to the procedure name c auto_info.verb = result(1:nk_result) auto_info.nk_verb = nk_result c auto_info.image = '@' elseif(line(1:2) .eq. 'MC') then c c Symbols line MCR AUTHORIZE c ipos = index(line,' ') line = '$'//line(ipos+1:) nk_line = get_len(line) goto 54 else c c Adapted verbs, like COPY:=COPY/CONFIRM c auto_info.nk_verb = str$find_first_in_set(line,' /')-1 auto_info.verb = line(1:auto_info.nk_verb) istat = terminal_replace(auto_info.ptr_terminal_info, 1 line(1:auto_info.nk_verb), 1 .false.) if(.not. istat) goto 90 ipos = auto_info.nk_verb + 1 !now points to / or " " c c Skip leading blanks c if(line(ipos:nk_line) .ne. ' ') then do while(line(ipos:ipos) .eq. ' ') ipos = ipos + 1 end do end if c c The first char either a / c if(line(ipos:ipos) .eq. '/') then c c Return terminator / and skip the / c terminator = '/' ipos = ipos + 1 else c c Or something else, return terminator= space c and do not skip c terminator = ' ' endif c c Push the rest of the line as typeahead (if not blank) c if(line(ipos:nk_line) .ne. ' ') then call terminal_set_typeahd(auto_info.ptr_terminal_info, 1 line(ipos:nk_line)) endif c c And now set the pointer for the verb c idx = 1 call table_match_verb(auto_info.ptr_table_info, 1 auto_info.verb(1:auto_info.nk_verb), 1 line,nk_line, 1 idx,ptr_command,exact) endif else c c Is was from the verb table c the ptr_command is already set by table_match_verb c c Make the display correct c line(nk_beg+1:) = auto_info.verb(1:auto_info.nk_verb) nk_line = nk_beg + auto_info.nk_verb istat = terminal_replace(auto_info.ptr_terminal_info, 1 line(1:nk_line),.false.) endif goto 50 endif c c Now the command is ambiguous c if(k .eq. 0) then istat = auto_msg(auto_info.ptr_terminal_info,auto_msg_invverb, 1 line(1:nk_line)) else istat = auto_msg(auto_info.ptr_terminal_info,auto_msg_ambigv, 1 line(1:nk_line)) endif elseif(terminator .eq. kar_abort) then goto 90 elseif(auto_check_printable(terminator,.false.) .or. 1 terminator .eq. kar_delete) then c c Insert or delete char, see if valid verb/symbol, must be low ascci c k = 0 match_symbol = .false. call terminal_try(auto_info.ptr_terminal_info,terminator, 1 line,nk_line) if(nk_beg .eq. 0) then call symbols_rewind(auto_info.ptr_symbol_info, 1 auto_info.ptr_terminal_info) do while(symbols_match(auto_info.ptr_symbol_info, 1 line(nk_beg+1:nk_line), 1 auto_info.verb,auto_info.nk_verb, 1 exact,1, 1 auto_info.ptr_terminal_info,.false.)) k = k + 1 match_symbol = .true. goto 47 end do endif c idx = 1 do while(table_match_verb(auto_info.ptr_table_info, 1 line(nk_beg+1:nk_line), 1 auto_info.verb,auto_info.nk_verb, 1 idx,ptr_command,exact)) k = k + 1 match_symbol = .false. goto 47 end do if(k .eq. 0) then istat = auto_msg(auto_info.ptr_terminal_info,auto_msg_invverb, 1 line(nk_beg+1:nk_line)) if(.not. istat) goto 90 goto 10 endif c c Still valid verb c 47 istat = terminal_insert(auto_info.ptr_terminal_info,terminator) else call terminal_kar_conv(terminator,nk_invchar,invchar) istat = auto_msg(auto_info.ptr_terminal_info,auto_msg_invchar, 1 invchar(1:nk_invchar)) endif if(istat) goto 10 goto 90 c c Now we have a valid verb, go get the rest of the command c Now we have a command block, so process it c 50 auto_info.all_oke = .false. auto_info.n_par = 0 c command_info.npar_min = 0 command_info.npar_max = 0 command_info.par_addr = 0 c c c istat = auto_get_command(auto_info,ptr_command,terminator,2,0, 1 command_info) if(.not. istat) goto 90 c c Returns c kar_delete, back to verb c kar_abort, exit c if(terminator .eq. kar_back .or. 1 terminator .eq. kar_replay) then if(terminator .eq. kar_replay) terminator = kar_back nk_beg = 1 goto 21 endif c 90 auto_get_verb = istat call auto_debug_leave(auto_info,'get_verb',0, 1 .true.,level,terminator) return end c options /recursive function auto_get_command(auto_info, 1 ptr_command,terminator,level, 1 n_prev_items,command_info_i) implicit none c c Process a command c this comes from the main verb table or from a syntax switch c include 'auto.inc' record /auto_info/ auto_info !:io: terminal block integer*4 ptr_command !:i: pointer to command block character*1 terminator !:io: the terminator integer*4 level !:i: depth level integer*4 n_prev_items !:i: #items in previous commands record /command_info/ command_info_i !:i: input command pars integer*4 auto_get_command !:f: function result c character*(max_line_length) line integer*4 nk_line,istat,nk_beg,tot_nk_beg integer*4 nk logical*4 cqual_present c record /command_info/ command_info c integer*4 terminal_read integer*4 terminal_insert integer*4 terminal_delete integer*4 terminal_start_replay c logical*4 table_check_cqual_init logical*4 table_check_cqual c integer*4 auto_debug integer*4 auto_get_qualifier integer*4 auto_get_parameter c integer*4 auto_msg external auto_msg_noquals external auto_msg_needpar external auto_msg_nomorpar external auto_msg_synswitch external auto_msg_ignored c integer*4 n_items integer*4 item_bpos(max_items),items_npar(max_items) c character*(max_token_length) entity_name integer*4 nk_entity_name c call auto_debug_enter(auto_info,'get_command',ptr_command, 1 .true.,level) c istat = 1 if(n_prev_items .gt. 1) then istat = auto_msg(auto_info.ptr_terminal_info,auto_msg_ignored) if(.not. istat) goto 90 endif c if(level .gt. 0) then call table_command_name(ptr_command,entity_name,nk_entity_name) if(auto_info.info) then call auto_msg(auto_info.ptr_terminal_info,auto_msg_synswitch, 1 entity_name(1:nk_entity_name)) endif endif c call terminal_get(auto_info.ptr_terminal_info,line,nk_line) nk_beg = nk_line tot_nk_beg = nk_beg c c Take the parameters from the previous level c command_info = command_info_i c c Check if parameter/qualifier present, update the command_info c call table_get_command_data(auto_info.ptr_table_info,ptr_command, 1 command_info) c n_items = 0 !count of quals and params c c when using cqual routines, not all combinations valid with the c cld tables are also accepted within cqual. c f.e. dir/modified will be accepted in cld tables, but the cqual routines c will check for the presence of the /since or /before. c We do not know in the verb/image uses cqual routines, but we can guess c if all cqual qualifiers are present (/bef/sinc/cre/mod/exp/back) c we assume cqual will be used, and some combinations (as the one c described above) are not valid. c c So now check if all cqual qualifiers are present c cqual_present = table_check_cqual_init(auto_info.ptr_table_info, 1 auto_info.ptr_terminal_info,ptr_command, 1 command_info.qual_addr) c c e came here with terminator filled, so skip the first read c goto 20 c 10 istat = terminal_read(auto_info.ptr_terminal_info,terminator,nk_beg, 1 auto_info.ptr_table_info, 1 auto_info.execute) if(.not. istat) goto 90 if(terminator .eq. kar_debug) then istat = auto_debug(auto_info) if(.not. istat) goto 90 goto 10 endif c c Process character c 20 if(terminator .eq. kar_back) then c c Now look for previous terminator c goto 60 elseif(terminator .eq. kar_return) then c c USer wanted a return, check for min_param c if(auto_info.all_oke) goto 90 !already set c if(auto_info.n_par .lt. command_info.npar_min) then istat = auto_msg(auto_info.ptr_terminal_info,auto_msg_needpar, 1 %val(command_info.npar_min)) if(.not. istat) goto 90 c c Make it easy for the user, insert a space, and act as if he typed it c terminator = ' ' else c c USer wanted return, check for cqual qualifiers c if this is a possible cqual-using verb, do some additional c checks for validity (see the comment above) c if(cqual_present) then istat = table_check_cqual(auto_info.ptr_table_info, 1 auto_info.ptr_token_info, 1 command_info.ptr_command) if(istat .ne. 1) then istat = auto_msg(auto_info.ptr_terminal_info,%val(istat)) goto 10 endif endif c c no objections, so go c auto_info.all_oke = .true. goto 90 endif elseif(terminator .eq. kar_abort) then goto 90 endif c c Now we have a character c allowed is c space : start a new parameter c / : start a new qualifier c All others are ignored c if(terminator .eq. '/') then c if(command_info.n_qual .eq. 0) then istat = auto_msg(auto_info.ptr_terminal_info,auto_msg_noquals) terminator = kar_delete else c c New parameter is allowed, display the / c istat = terminal_insert(auto_info.ptr_terminal_info,terminator) if(.not. istat) goto 90 c c Remember starting pos and #params upto now c n_items = n_items + 1 call terminal_get_nkar(auto_info.ptr_terminal_info, 1 item_bpos(n_items)) items_npar(n_items) = auto_info.n_par c call auto_debug_call(auto_info,'get_qual from get_command', 1 ptr_command, 1 .true.,level) c c And go get the qualifier c istat = auto_get_qualifier(auto_info,ptr_command,terminator, 1 level+1, 1 n_items,command_info) if(.not. istat) goto 90 c call auto_debug_back(auto_info,'get_command from get_qual', 1 ptr_command, 1 .true.,level,terminator) c c If the user deleted the whole new qualifier, we need to replay this one c if(terminator .eq. kar_replay) goto 60 endif c c We have a terminator, so GO process it c goto 20 elseif(terminator .eq. ' ') then c c User wants a new parameter c if(auto_info.n_par .eq. command_info.npar_max) then istat = auto_msg(auto_info.ptr_terminal_info,auto_msg_nomorpar) terminator = kar_delete else c c One more alllowed c istat = terminal_insert(auto_info.ptr_terminal_info,terminator) if(.not. istat) goto 90 c c Remember starting pos and #params upto now c n_items = n_items + 1 call terminal_get_nkar(auto_info.ptr_terminal_info, 1 item_bpos(n_items)) items_npar(n_items) = auto_info.n_par c auto_info.n_par = auto_info.n_par + 1 call auto_debug_call(auto_info,'get_param from get_command', 1 ptr_command, 1 .true.,level) c c Get the next parameter c istat = auto_get_parameter(auto_info,ptr_command,terminator, 1 level+1, 1 n_items,command_info) if(.not. istat) goto 90 call auto_debug_back(auto_info,'get_command from get_param', 1 ptr_command,.true.,level,terminator) c c USer deleted the whole parameter, replay from the previous qual/par c if(terminator .eq. kar_replay) goto 60 endif c c We have a terminator, so GO process it c goto 20 else c c Unkown char, so ignore c endif c c Ask for the next char c goto 10 c c We want to backspace over one item c We have one of the following case c 1: on screen is /qual c We expected the user to enter a / or a " " for the next qual/par c but he entered a DEL, this is transformed to a KAR_BACK c We came here from the test if terminator=kar_back c Terminator = KAR_BACK c We need to replay the last qualifier/parameter c c 2: On screen is / c The user has completely erased the qualifier/parameter c and hits the DEL to remove the / or the " ". c We come here from the return of the get_qual/get_param c Terminator = KAR_REPLAY c We need to replay the last qualifier/parameter c c 3: on screen is /qual=val c And the user entered a DEL to remove the l c We came here from the return of the get_qual/get_param c Terminator = KAR_REPLAY c We need to replay the last qualifier/parameter c 60 call terminal_get_nkar(auto_info.ptr_terminal_info,nk) c if(terminator .eq. kar_replay) then c c Case 2,3 c if(nk .eq. item_bpos(n_items)) then c c We are at the / or the " " of the qual/par and want to c delete it. c 1. Delete the char, and decrease the item depth c istat = terminal_delete(auto_info.ptr_terminal_info) if(.not. istat) goto 90 n_items = n_items - 1 endif endif c if(n_items .gt. 0) then c c We still have items left, replay from the start c istat = terminal_start_replay(auto_info.ptr_terminal_info, 1 item_bpos(n_items)) if(.not. istat) goto 90 c c nk_beg = item_bpos(n_items) auto_info.n_par = items_npar(n_items) c c Now decrease the depth, the first char read(=replayed) will be the / or " " c and that will increase the depth again c n_items = n_items - 1 goto 10 endif c c Exit from this routine with a kar_replay, so an upper level knows what we want c terminator = kar_replay goto 90 c 90 auto_get_command = istat call auto_debug_leave(auto_info,'get_command',ptr_command, 1 .true.,level,terminator) c c Restore old bpos c return end c options /recursive function auto_get_qualifier(auto_info, 1 ptr_command,terminator, 1 level,n_items, 1 command_info) implicit none c c Process a qualifier c include 'auto.inc' record /auto_info/ auto_info !:i: terminal info integer*4 ptr_command !:i: the pointer to the comand block character*1 terminator !:o: terminator integer*4 level !:i: depth level integer*4 n_items !:i: #items (par and qual) for this command record /command_info/ command_info !:i: info about command integer*4 auto_get_qualifier !:f: the function result c integer*4 nk_beg,istat,nk_save,nk_qual_name,nk_invchar integer*4 tabpos,nk_qual,k,nk_line,ptr_command1 integer*4 ptr_entity logical*4 negated integer*4 nk_entity_name character*(max_token_length) entity_name,qual_name,invchar character*(max_line_length) line_save,qual,line c integer*4 terminal_read integer*4 table_list_command_qual integer*4 terminal_replace integer*4 terminal_insert integer*4 terminal_delete integer*4 auto_debug integer*4 auto_msg integer*4 auto_get_values integer*4 auto_get_command logical*4 table_check_disallow logical*4 auto_check_printable c integer*4 token_add integer*4 token_remove c logical auto_help_add logical auto_help_display integer*4 auto_help_help logical*4 table_entity_valreq logical*4 table_entity_value integer*4 table_entity_syntax c external auto_msg_valreq external auto_msg_ambigq external auto_msg_valnot external auto_msg_invqual external auto_msg_invchar c call auto_debug_enter(auto_info,'get_qual',ptr_command,.true.,level) c c call terminal_get_nkar(auto_info.ptr_terminal_info,nk_beg) c 10 tabpos = 0 call terminal_get(auto_info.ptr_terminal_info,line_save,nk_save) c 20 call terminal_get(auto_info.ptr_terminal_info,line,nk_line) c 21 istat = terminal_read(auto_info.ptr_terminal_info,terminator,nk_beg, 1 auto_info.ptr_table_info, 1 auto_info.execute) if(terminator .eq. kar_debug) then istat = auto_debug(auto_info) if(.not. istat) goto 90 goto 21 endif if(.not. istat) goto 90 if(terminator .eq. kar_expand .or. 1 terminator .eq. kar_expand_prev) then if(terminator .eq. kar_expand) then tabpos = tabpos + 1 else if(tabpos .eq. 1) goto 22 !to tabpos 0 (original line) if(tabpos .eq. 0) goto 10 !ignore tabpos = tabpos - 1 endif c c Try to find the 'tabpos'th possible qualifier c k = tabpos ptr_entity = 0 do while(table_list_command_qual(auto_info.ptr_table_info, 1 auto_info.ptr_terminal_info, 1 ptr_command, 1 line_save(nk_beg+1:nk_save), 1 qual,nk_qual,ptr_entity,negated, 1 command_info.qual_addr)) if(table_check_disallow(auto_info.ptr_terminal_info, 1 auto_info.ptr_table_info, 1 auto_info.ptr_token_info, 1 command_info.ptr_disallow, 1 ptr_entity,command_info.ptr_command)) then k = k - 1 if(k .eq. 0) then line(nk_beg+1:) = qual(1:nk_qual) nk_line = nk_beg + nk_qual goto 23 endif endif end do c c Not found, so restore original line c 22 istat = terminal_replace(auto_info.ptr_terminal_info, 1 line_save(1:nk_save),.false.) if(.not. istat) goto 90 goto 10 c c Found a match c 23 istat = terminal_replace(auto_info.ptr_terminal_info, 1 line(1:nk_line),.false.) if(.not. istat) goto 90 goto 20 c elseif(terminator .eq. kar_help) then istat = auto_help_help(auto_info.verb(1:auto_info.nk_verb), 1 line(nk_beg:nk_line),auto_info.image,0, 1 auto_info.ptr_terminal_info) if(.not. istat) goto 90 goto 21 elseif(terminator .eq. kar_list) then c c Display all allowed qualifiers c call auto_help_init(auto_info.ptr_terminal_info) ptr_entity = 0 !signal first do while(table_list_command_qual(auto_info.ptr_table_info, 1 auto_info.ptr_terminal_info, 1 ptr_command, 1 line(nk_beg+1:nk_line), 1 qual,nk_qual, 1 ptr_entity,negated, 1 command_info.qual_addr)) if(table_check_disallow(auto_info.ptr_terminal_info, 1 auto_info.ptr_table_info, 1 auto_info.ptr_token_info, 1 command_info.ptr_disallow, 1 ptr_entity,command_info.ptr_command)) then if(.not. auto_help_add(auto_info.ptr_terminal_info, 1 qual(1:nk_qual))) goto 34 endif end do 34 istat = auto_help_display(auto_info.ptr_terminal_info,'Qualifier') elseif(index('/= '//kar_return,terminator) .ne. 0) then c c Now try to execute the command c Now check if command unambiguous c k = 0 ptr_entity = 0 !signal first do while(table_list_command_qual(auto_info.ptr_table_info, 1 auto_info.ptr_terminal_info, 1 ptr_command, 1 line(nk_beg+1:nk_line), 1 qual,nk_qual, 1 ptr_entity,negated, 1 command_info.qual_addr)) if(table_check_disallow(auto_info.ptr_terminal_info, 1 auto_info.ptr_table_info, 1 auto_info.ptr_token_info, 1 command_info.ptr_disallow, 1 ptr_entity,command_info.ptr_command)) then qual_name = qual(1:nk_qual) nk_qual_name = nk_qual k = k + 1 endif end do c c Now check if we found only one c if(k .gt. 1) then istat = auto_msg(auto_info.ptr_terminal_info,auto_msg_ambigq, 1 line(nk_beg+1:nk_line)) if(.not. istat) goto 90 goto 10 endif c line(nk_beg+1:) = qual_name(1:nk_qual_name) nk_line = nk_beg + nk_qual_name istat = terminal_replace(auto_info.ptr_terminal_info, 1 line(1:nk_line),.false.) if(.not. istat) goto 90 c c Yes we found only one, check for values c ptr_command1 = table_entity_syntax(auto_info.ptr_table_info, 1 ptr_entity) c if(table_entity_valreq(ptr_entity,negated)) then c c We need a value (an = sign) c if(terminator .ne. '=') then istat = auto_msg(auto_info.ptr_terminal_info,auto_msg_valreq) if(.not. istat) goto 90 goto 10 endif endif c c CHeck for the = c if(terminator .eq. '=') then c c We have an = sign, check if the entity allows values c if(.not. table_entity_value(ptr_entity,negated)) then istat = auto_msg(auto_info.ptr_terminal_info,auto_msg_valnot) if(.not. istat) goto 90 goto 10 endif endif c c Al checks are oke, now either c return (no values wanted/alllowed) c get_values c call table_entity_name(ptr_entity,entity_name,nk_entity_name) k = 1 if(negated) k = 3 istat = token_add(auto_info.ptr_token_info, 1 entity_name(k:nk_entity_name), 1 auto_info.ptr_terminal_info, 1 negated,command_info.ptr_command) if(.not. istat) goto 90 c if(terminator .eq. '=') then c c Echo the character c istat = terminal_insert(auto_info.ptr_terminal_info,terminator) if(.not. istat) goto 90 c call auto_debug_call(auto_info,'get_values from get_qual', 1 ptr_command, 1 .true.,level) c istat = auto_get_values(auto_info, 1 ptr_entity,terminator,.true., 1 entity_name(1:nk_entity_name), 1 level+1,n_items,.false., 1 command_info, 1 '/'//entity_name(1:nk_entity_name)) c if(.not. istat) goto 90 call auto_debug_back(auto_info,'get_qual from get_values', 1 ptr_command, 1 .true.,level,terminator) c if(terminator .eq. kar_back .or. 1 terminator .eq. kar_replay) then call terminal_delete(auto_info.ptr_terminal_info) !remove the = istat = token_remove(auto_info.ptr_token_info, 1 entity_name(k:nk_entity_name), 1 auto_info.ptr_terminal_info, 1 command_info.ptr_command) if(.not. istat) goto 90 endif endif c if(ptr_command1 .ne. 0) then c c We have a syntax change, now process the command c istat = auto_get_command(auto_info,ptr_command1,terminator,level+1, 1 n_items,command_info) endif goto 90 elseif(terminator .eq. kar_back .or. 1 terminator .eq. kar_replay .or. 1 terminator .eq. kar_abort) then if(terminator .eq. kar_back) terminator = kar_replay goto 90 elseif(auto_check_printable(terminator,.false.) .or. 1 terminator .eq. kar_delete) then c c Try to insert or delete the character c ptr_entity = 0 call terminal_try(auto_info.ptr_terminal_info,terminator, 1 line,nk_line) 56 istat = table_list_command_qual(auto_info.ptr_table_info, 1 auto_info.ptr_terminal_info, 1 ptr_command, 1 line(nk_beg+1:nk_line), 1 qual,nk_qual, 1 ptr_entity,negated, 1 command_info.qual_addr) if(istat) then if(.not. table_check_disallow(auto_info.ptr_terminal_info, 1 auto_info.ptr_table_info, 1 auto_info.ptr_token_info, 1 command_info.ptr_disallow, 1 ptr_entity,command_info.ptr_command)) goto 56 endif if(istat) then istat = terminal_insert(auto_info.ptr_terminal_info,terminator) else istat = auto_msg(auto_info.ptr_terminal_info,auto_msg_invqual, 1 line(nk_beg+1:nk_line)) endif else call terminal_kar_conv(terminator,nk_invchar,invchar) istat = auto_msg(auto_info.ptr_terminal_info,auto_msg_invchar, 1 invchar(1:nk_invchar)) endif if(istat) goto 10 goto 90 c c Restore c c 90 call auto_debug_leave(auto_info,'get_qual',ptr_command, 1 .true.,level,terminator) c auto_get_qualifier = istat return end c options /recursive function auto_get_values(auto_info, 1 ptr_entity,terminator,from_qualifier, 1 base_entity_name,level, 1 n_items,skip_blanks, 1 command_info,token) c c Get value(s) c implicit none include 'auto.inc' record /auto_info/ auto_info !:io: terminal block integer*4 ptr_entity !:i: ptr to entiry character*1 terminator !:o: terminator logical*4 from_qualifier !:i: From qualifier? character*(*) base_entity_name !:i: base_entity integer*4 level !:i: depth integer*4 n_items !:i: # items in currenc command (qual/parm) logical skip_blanks !:i: allow leading blanks? record /command_info/ command_info !:i: info about command character*(*) token !:i: token info integer*4 auto_get_values !:f: function result c c integer*4 istat,nk_end,ptr_command1,ptr_entity1 integer*4 n_value,nk_line integer*4 override logical*4 need_brackets,is_list,sav_pos character*(max_token_length) line c integer*4 terminal_read integer*4 terminal_insert integer*4 terminal_delete integer*4 terminal_start_replay integer*4 auto_msg integer*4 auto_debug integer*4 auto_get_command integer*4 auto_get_value c external auto_msg_valnot external auto_msg_invchar external auto_msg_expbrko external auto_msg_switch logical*4 table_check_override logical*4 table_entity_list integer*4 table_entity_syntax c integer*4 item_bpos(max_items) c c Get the entity flags c call auto_debug_enter(auto_info,'get_values',ptr_entity,.false.,level) c ptr_command1 = table_entity_syntax(auto_info.ptr_table_info,ptr_entity) c call terminal_get_nkar(auto_info.ptr_terminal_info,nk_end) c c If type=string, user may adjust type c if(table_check_override(auto_info.override,ptr_entity,override)) then call auto_msg(auto_info.ptr_terminal_info,auto_msg_switch) endif c c We want a value, check if allowed c Get the value(s). If a list insert the ( c is_list = table_entity_list(ptr_entity,.false.) need_brackets = is_list .and. from_qualifier c if(need_brackets) then istat = terminal_insert(auto_info.ptr_terminal_info,'(') if(.not. istat) goto 90 endif c n_value = 0 10 n_value = n_value + 1 call terminal_get_nkar(auto_info.ptr_terminal_info,item_bpos(n_value)) c 20 call auto_debug_call(auto_info,'get_value from get_values', 1 ptr_entity, 1 .false.,level) c istat = auto_get_value(auto_info,ptr_entity,terminator, 1 base_entity_name,level+1, 1 ptr_entity1,n_items,item_bpos(n_value),override, 1 skip_blanks,command_info,token) if(.not. istat) goto 90 c if(terminator .eq. kar_back) then terminator = kar_replay ptr_entity1 = 0 endif c call auto_debug_back(auto_info,'get_values from get_value', 1 ptr_entity, 1 .false.,level,terminator) c c Check if result value has a syntax change c if(ptr_entity1 .ne. 0) then ptr_command1 = table_entity_syntax(auto_info.ptr_table_info, 1 ptr_entity1) c c if(ptr_command1 .ne. 0) then c c We have a syntax change, now process the command c call auto_debug_call(auto_info,'get_command from get_values', 1 ptr_entity1,.false.,level) istat = auto_get_command(auto_info,ptr_command1,terminator,level+1, 1 n_items,command_info) call auto_debug_back(auto_info,'get_values from get_command', 1 ptr_entity1,.false.,level,terminator) goto 90 endif endif c if(terminator .eq. kar_replay) then n_value = n_value - 1 if(n_value .eq. 0) then if(need_brackets) then !remove ( istat = terminal_delete(auto_info.ptr_terminal_info) endif goto 90 endif c c Now remove , c istat = terminal_delete(auto_info.ptr_terminal_info) !remove , c c And start replaying from the start point of the previous parameter c istat = terminal_start_replay(auto_info.ptr_terminal_info, 1 item_bpos(n_value)+1) if(.not. istat) goto 90 goto 20 endif c c Get_value returned, this returns in terminator c a , or space or ) or / or enter or = or delete or abort c c If , or ) can be taken if this get_values is a list c if not return to the upper level, since there may be a c get_values with a list in the call stack c if(terminator .eq. kar_abort .or. 1 terminator .eq. kar_back .or. 1 terminator .eq. kar_replay) then goto 90 endif if(is_list) then c c We have a list c now we can absorp the , and the ) c All others are not oke c if(terminator .eq. ',') then c istat = terminal_insert(auto_info.ptr_terminal_info,terminator) if(istat) goto 10 !more wanted? c elseif(terminator .eq. ')') then c c This ends the current get_values, now we need a new c terminator to give to the upper level c istat = terminal_insert(auto_info.ptr_terminal_info,terminator) if(.not. istat) goto 90 c call terminal_get_nkar(auto_info.ptr_terminal_info,sav_pos) 38 istat = terminal_read(auto_info.ptr_terminal_info, 1 terminator,sav_pos, 1 auto_info.ptr_table_info, 1 auto_info.execute) if(.not. istat) goto 90 if(terminator .eq. kar_debug) then istat = auto_debug(auto_info) if(.not. istat) goto 90 goto 38 endif if(terminator .eq. kar_back) then istat = terminal_delete(auto_info.ptr_terminal_info) terminator = kar_replay endif else c c All others illegal if brackets wanted c if(need_brackets) then call terminal_kar_conv(terminator,nk_line,line) istat = auto_msg(auto_info.ptr_terminal_info,auto_msg_expbrko, 1 line(1:nk_line)) c c Start Replay c terminator = kar_replay endif endif endif c 90 auto_get_values = istat call auto_debug_leave(auto_info,'get_values',ptr_entity, 1 .false.,level,terminator) c return end c options /recursive function auto_get_parameter(auto_info, 1 ptr_command,terminator, 1 level,n_items, 1 command_info) implicit none c c Get a parameter, c include 'auto.inc' c record /auto_info/ auto_info !:io: terminal boock integer*4 ptr_command !:i: ptr to command block character*1 terminator !:o: terminator integer*4 level !:i: depth level integer*4 n_items !:i: #items (par and qual) for this command record /command_info/ command_info !:i: info about command integer*4 auto_get_parameter !:f: function result c# integer*4 istat,ptr_entity integer*4 nk_entity_name character*(max_token_length) entity_name character kar c integer*4 table_set_command_param integer*4 auto_get_values integer*4 token_add integer*4 token_remove integer*4 table_check_disallow integer*4 auto_msg external auto_msg_disallow c c Now get the entity block for the 'N-Par'th parameter c kar = char(auto_info.n_par + ichar('0')) call auto_debug_enter(auto_info,'get_parameter '//kar,ptr_command, 1 .true.,level) c istat = table_set_command_param(auto_info.ptr_table_info, 1 auto_info.ptr_terminal_info, 1 ptr_command, 1 auto_info.n_par,ptr_entity, 1 command_info.par_addr) if(.not. istat) goto 90 c if(.not. table_check_disallow(auto_info.ptr_terminal_info, 1 auto_info.ptr_table_info, 1 auto_info.ptr_token_info, 1 command_info.ptr_disallow, 1 ptr_entity,command_info.ptr_command)) then call table_entity_name(ptr_entity,entity_name,nk_entity_name) istat = auto_msg(auto_info.ptr_terminal_info,auto_msg_disallow, 1 entity_name(1:nk_entity_name)) goto 90 endif c call table_entity_name(ptr_entity,entity_name,nk_entity_name) c istat = token_add(auto_info.ptr_token_info, 1 entity_name(1:nk_entity_name), 1 auto_info.ptr_terminal_info, 1 .false.,command_info.ptr_command) if(.not. istat) goto 90 c call auto_debug_call(auto_info,'get_values from get_command', 1 ptr_command,.true.,level) c c And go get values c istat = auto_get_values(auto_info, 1 ptr_entity,terminator,.false., 1 entity_name(1:nk_entity_name), 1 level+1,n_items,.true., 1 command_info,'Parameter') c if(terminator .eq. kar_back .or. 1 terminator .eq. kar_delete .or. 1 terminator .eq. kar_replay) then istat = token_remove(auto_info.ptr_token_info, 1 entity_name(1:nk_entity_name), 1 auto_info.ptr_terminal_info, 1 command_info.ptr_command) endif c if(.not. istat) goto 90 call auto_debug_back(auto_info,'get_values from get_command', 1 ptr_command,.true.,level,terminator) c 90 auto_get_parameter = istat call auto_debug_leave(auto_info,'get_parameter',ptr_command, 1 .true.,level,terminator) return end options /recursive function auto_get_value(auto_info, 1 ptr_entity,terminator, 1 base_entity_name,level, 1 ptr_entity1,n_items,nk_beg,override, 1 skip_blanks, 1 command_info,token) implicit none c include 'auto.inc' c record /auto_info/ auto_info !:io: terminal info block character*1 terminator !:o: terminator integer*4 ptr_entity !:i: ptr to entity block character*(*) base_entity_name !:i: parent name integer*4 level !:i: level integer*4 ptr_entity1 !:i: ptr to entity result block integer*4 n_items !:i: # items in currenc command (qual/parm) integer*4 nk_beg !:i: the limit in the input line integer*4 override !:i: override type logical*4 skip_blanks !:i: skip leading blanks? record /command_info/ command_info !:i: info about command character*(*) token !:i: help token integer*4 auto_get_value !:f: function result c integer*4 istat,nk_line,tabpos,nk_save,nk_value,nk_start integer*4 nk_invchar,pos,nk_name,k logical*4 negated,is_rest_of_line character*(max_line_length) line,line_save character*255 value,invchar character*(max_token_length) name c integer*4 terminal_read integer*4 terminal_replace integer*4 terminal_insert c logical*4 table_is_rest_of_line logical*4 table_entity_valreq logical*4 table_entity_value c integer*4 auto_debug integer*4 auto_get_values integer*4 auto_check_value integer*4 auto_help_help integer*4 auto_msg integer*4 token_add integer*4 token_remove c external auto_msg_overmsg external auto_msg_invover external auto_msg_invchar external auto_msg_invval external auto_msg_valnot external auto_msg_valreq c call auto_debug_enter(auto_info,'get_value',ptr_entity,.false.,level) c is_rest_of_line = table_is_rest_of_line(ptr_entity,override) c ptr_entity1 = 0 call terminal_get_nkar(auto_info.ptr_terminal_info,nk_start) c 10 tabpos = 0 call terminal_get(auto_info.ptr_terminal_info,line_save,nk_save) c 20 call terminal_get(auto_info.ptr_terminal_info,line,nk_line) c 21 istat = terminal_read(auto_info.ptr_terminal_info,terminator,nk_beg, 1 auto_info.ptr_table_info, 1 auto_info.execute) if(.not. istat) goto 90 c c If blank and at the begin and skip_blanks, skip it c if(terminator .eq. ' ' .and. skip_blanks .and. 1 nk_line .eq. nk_start) goto 21 c if(terminator .eq. kar_debug) then istat = auto_debug(auto_info) if(.not. istat) goto 90 goto 21 endif c if(terminator .eq. kar_expand .or. 1 terminator .eq. kar_expand_prev) then c c Next/previous match c if(terminator .eq. kar_expand) then tabpos = tabpos + 1 else tabpos = tabpos - 1 if(tabpos .eq. 1) goto 50 !back to the original endif c c See if string 'idx' matches c call terminal_get_pos(auto_info.ptr_terminal_info,nk_beg,pos) istat = auto_check_value(auto_info, 1 line_save(nk_beg+1:nk_save), 1 char(0), 1 ptr_entity,'Expa', 1 tabpos,value,nk_value, 1 ptr_entity1,override,pos, 1 terminator .eq. kar_expand,negated) c c If Not found, so restore original line c if(nk_value .lt. 0) goto 50 c c Found a match c line(nk_beg+1:) = value(1:nk_value) nk_line = nk_beg + nk_value istat = terminal_replace(auto_info.ptr_terminal_info, 1 line(1:nk_line),pos.lt.0) if(.not. istat) goto 90 if(pos .lt. 0) then call terminal_get(auto_info.ptr_terminal_info,line_save,nk_save) endif goto 20 elseif(terminator .eq. kar_override) then if(override .ge. 0) then call table_override(override) call table_get_type_name(override,name,k) istat = auto_msg(auto_info.ptr_terminal_info,auto_msg_overmsg, 1 name(1:k)) else istat = auto_msg(auto_info.ptr_terminal_info,auto_msg_invover) endif goto 10 elseif(terminator .eq. kar_back) then goto 90 elseif(terminator .eq. kar_replay .or. 1 terminator .eq. kar_abort) then ptr_entity1 = 0 goto 90 elseif(terminator .eq. kar_help) then istat = auto_help_help(auto_info.verb(1:auto_info.nk_verb), 1 token,auto_info.image,auto_info.n_par, 1 auto_info.ptr_terminal_info) if(.not. istat) goto 90 goto 10 elseif(terminator .eq. kar_list) then call terminal_get_pos(auto_info.ptr_terminal_info,nk_beg,pos) call auto_help_init(auto_info.ptr_terminal_info) istat = auto_check_value(auto_info,line(nk_beg+1:nk_line), 1 char(0), 1 ptr_entity,'List', 1 tabpos+1,value,nk_value, 1 ptr_entity1,override,pos,.true.,negated) goto 10 elseif(terminator .eq. kar_return) then if(is_rest_of_line) then istat = 1 auto_info.all_oke = .true. goto 90 endif c goto 67 endif c c Now we do not have special character, try to insert it in the c buffer (or a delete) c call terminal_try(auto_info.ptr_terminal_info,terminator,line,nk_line) call terminal_get_pos(auto_info.ptr_terminal_info,nk_beg,pos) istat = auto_check_value(auto_info,line(nk_beg+1:nk_line), 1 terminator, 1 ptr_entity,'Part', 1 tabpos,value,nk_value, 1 ptr_entity1,override,pos,.true.,negated) c c If nk_value>0, the string (line(nk_beg+1:nk_line) is still valid c if nk_value=-1, the string is not valid, and terminator may be terminator c if nk_value=-2, the string ... is not valid, and terminator cannot be terminator c if(nk_value .eq. -2) goto 80 !totally invalid c if(nk_value .ge. 0) then c c Valid, insert the character c istat =terminal_insert(auto_info.ptr_terminal_info,terminator) if(.not. istat) goto 90 goto 10 endif c c Not a valid string anymore, but maybe a terminator c Return the line without the new character c call terminal_get(auto_info.ptr_terminal_info,line,nk_line) c c See if special char (if not : illegal character) c if( index(', )/=',terminator) .eq. 0) goto 80 c c Seems to be a terminator c now check if the expession in oke c 67 call terminal_get_pos(auto_info.ptr_terminal_info,nk_beg,pos) istat = auto_check_value(auto_info,line(nk_beg+1:nk_line), 1 char(0), 1 ptr_entity,'Full', 1 tabpos,value,nk_value, 1 ptr_entity1,override,pos,.true., 1 negated) if(.not.istat) goto 90 if(nk_value .lt. 0) goto 10 c c Now completely valid c line(nk_beg+1:) = value(1:nk_value) nk_line = nk_beg + nk_value istat = terminal_replace(auto_info.ptr_terminal_info, 1 line(1:nk_line),.false.) if(.not. istat) goto 90 c c Valid value, check if this has a new value c if(ptr_entity1 .ne. 0) then c c Yes it has, get the new entity flag c c Check for value c if(table_entity_valreq(ptr_entity1,negated)) then c c We again need a value (an = sign) c if(terminator .ne. '=') then istat = auto_msg(auto_info.ptr_terminal_info,auto_msg_valreq) if(.not. istat) goto 90 goto 10 endif endif c c CHeck for the =, if so call get_values again c if(terminator .eq. '=') then c c We have an = sign, check if the entity allows values c if(.not. table_entity_value(ptr_entity1,negated)) then istat = auto_msg(auto_info.ptr_terminal_info,auto_msg_valnot) if(.not. istat) goto 90 goto 10 else c c Echo the = c istat = terminal_insert(auto_info.ptr_terminal_info,terminator) if(.not. istat) goto 90 c c Add a new entity base.new c k = 1 if(negated) k = 3 call table_entity_name(ptr_entity1,name,nk_name) istat = token_add(auto_info.ptr_token_info, 1 base_entity_name//'.'//name(k:nk_name), 1 auto_info.ptr_terminal_info,negated, 1 command_info.ptr_command) if(.not. istat) goto 90 c c And get the value(s) c c call auto_debug_call(auto_info,'get_values from get_value', 1 ptr_entity,.false.,level) c istat = auto_get_values(auto_info, 1 ptr_entity1,terminator,.true., 1 base_entity_name//'.'//name(1:nk_name), 1 level+1,n_items,skip_blanks, 1 command_info,token) c if(.not. istat) goto 90 c if(terminator .eq. kar_back .or. 1 terminator .eq. kar_delete .or. 1 terminator .eq. kar_replay) then istat = token_remove(auto_info.ptr_token_info, 1 base_entity_name//'.'//name(1:nk_name), 1 auto_info.ptr_terminal_info, 1 command_info.ptr_command) endif c call auto_debug_back(auto_info,'get_value from get_values', 1 ptr_entity,.false.,level,terminator) endif endif endif c if(terminator .eq. '=') goto 80 goto 90 c c The tab/bs has hit the wall, replace with original string c 50 istat = terminal_replace(auto_info.ptr_terminal_info, 1 line_save(1:nk_save),.false.) if(istat) goto 10 goto 90 c c Invalid char c 80 call terminal_kar_conv(terminator,nk_invchar,invchar) istat = auto_msg(auto_info.ptr_terminal_info,auto_msg_invchar, 1 invchar(1:nk_invchar)) if(.not. istat) goto 90 goto 10 c c 90 auto_get_value = istat call auto_debug_leave(auto_info,'get_value',ptr_entity,.false., 1 level,terminator) return end function auto_msg(ptr_terminal_info,msgcode, 1 arg1,arg2,arg3,arg4,arg5,arg6) implicit none c include 'auto.inc' c c Display a message c integer*4 ptr_terminal_info integer*4 msgcode integer*4 arg1 integer*4 arg2 integer*4 arg3 integer*4 arg4 integer*4 arg5 integer*4 arg6 integer*4 auto_msg c character*(max_line_length) line,line1 c integer*4 n,args(10),nk,nk1,istat integer*4 terminal_message c logical*4 terminal_replay c if(.not. terminal_replay(ptr_terminal_info)) then n = iargcount() if(n .gt. 2) args(1) = %loc(arg1) if(n .gt. 3) args(2) = %loc(arg2) if(n .gt. 4) args(3) = %loc(arg3) if(n .gt. 5) args(4) = %loc(arg4) if(n .gt. 6) args(5) = %loc(arg5) if(n .gt. 7) args(6) = %loc(arg6) call sys$getmsg(msgcode,nk,line,,) call sys$faol(line(1:nk),nk1,line1,args) istat = terminal_message(ptr_terminal_info,line1(1:nk1)) else istat = 1 endif auto_msg = istat return end function auto_debug_enter(auto_info,name,ptr,command,level) implicit none c c Signal a debug message for leaving a routine c include 'auto.inc' record /auto_info/ auto_info !:i: control block character*(*) name !:i: name of routine integer*4 ptr !:i: ptr tp entity or command logical*4 command !:i: is ptr to a command? integer*4 level !:i: level for message integer*4 auto_debug_enter !:f: function result c integer*4 istat c integer*4 terminal_debug c character*(max_token_length) entity_name integer*4 nk_entity_name c if(ptr .eq. 0) then entity_name = name nk_entity_name = len(name) else if(command) then call table_command_name(ptr,entity_name,nk_entity_name) else call table_entity_name(ptr,entity_name,nk_entity_name) endif endif istat = terminal_debug(auto_info.ptr_terminal_info, 1 'Start of '//name// 1 ' for '//entity_name(1:nk_entity_name), 1 level,dbg_flag_rou) c auto_info.level = auto_info.level + 1 auto_info.debug(auto_info.level).name = name auto_info.debug(auto_info.level).enti = entity_name(1:nk_entity_name) call terminal_get_nkar(auto_info.ptr_terminal_info, 1 auto_info.debug(auto_info.level).bpos) auto_info.debug(auto_info.level).level = level auto_debug_enter = istat return end function auto_debug_leave(auto_info,name,ptr,command, 1 level,terminator) implicit none c c Signal a debug message for leaving a routine c include 'auto.inc' record /auto_info/ auto_info !:i: control block character*(*) name !:i: name of routine integer*4 ptr !:i: ptr tp entity/command logical*4 command !:i: is ptr to a command? integer*4 level !:i: level for message character*(*) terminator !:i: terminator integer*4 auto_debug_leave !:f: function result c integer*4 istat character*(max_token_length) entity_name integer*4 nk_entity_name c integer*4 terminal_debug integer*4 terminal_kdebug c c if(command) then call table_command_name(ptr,entity_name,nk_entity_name) else call table_entity_name(ptr,entity_name,nk_entity_name) endif c istat = terminal_debug(auto_info.ptr_terminal_info, 1 'End of '//name// 1 ' for '//entity_name(1:nk_entity_name), 1 level,dbg_flag_rou) if(istat) istat = terminal_kdebug(auto_info.ptr_terminal_info, 1 'terminator :',terminator, 1 level+2,dbg_flag_rou) auto_info.level = auto_info.level - 1 auto_debug_leave = istat return end function auto_debug_call(auto_info,name,ptr,command,level) implicit none c c Signal a debug message for calling a routine c include 'auto.inc' record /auto_info/ auto_info !:i: control block character*(*) name !:i: name of routine integer*4 ptr !:i: ptr tp entity or command logical*4 command !:i: is ptr to a command? integer*4 level !:i: level for message integer*4 auto_debug_call !:f: function result c integer*4 istat c integer*4 terminal_debug c character*(max_token_length) entity_name integer*4 nk_entity_name c if(command) then call table_command_name(ptr,entity_name,nk_entity_name) else call table_entity_name(ptr,entity_name,nk_entity_name) endif istat = terminal_debug(auto_info.ptr_terminal_info, 1 'call '//name// 1 ' for '//entity_name(1:nk_entity_name), 1 level,dbg_flag_rou) c auto_info.level = auto_info.level + 1 auto_info.debug(auto_info.level).name = name auto_info.debug(auto_info.level).enti = entity_name(1:nk_entity_name) call terminal_get_nkar(auto_info.ptr_terminal_info, 1 auto_info.debug(auto_info.level).bpos) c auto_info.debug(auto_info.level).level = level auto_debug_call = istat return end function auto_debug_back(auto_info,name,ptr,command, 1 level,terminator) implicit none c c Signal a debug message for leaving a routine c include 'auto.inc' record /auto_info/ auto_info !:i: control block character*(*) name !:i: name of routine integer*4 ptr !:i: ptr tp entity/command logical*4 command !:i: is ptr to a command? integer*4 level !:i: level for message character*(*) terminator !:i: terminator integer*4 auto_debug_back !:f: function result c integer*4 istat character*(max_token_length) entity_name integer*4 nk_entity_name c integer*4 terminal_debug integer*4 terminal_kdebug c c if(command) then call table_command_name(ptr,entity_name,nk_entity_name) else call table_entity_name(ptr,entity_name,nk_entity_name) endif c istat = terminal_debug(auto_info.ptr_terminal_info, 1 'Back from '//name// 1 ' for '//entity_name(1:nk_entity_name), 1 level,dbg_flag_rou) if(istat) istat = terminal_kdebug(auto_info.ptr_terminal_info, 1 'terminator :',terminator, 1 level+2,dbg_flag_rou) auto_info.level = auto_info.level - 1 auto_debug_back = istat return end function auto_debug(auto_info) implicit none c include 'auto.inc' record /auto_info/ auto_info integer*4 auto_debug c integer*4 k,nk,istat character*80 line c integer*4 terminal_debug c istat = 1 do k=1,auto_info.level call sys$fao( 1 'DBG:Lev !3UL Nam !AS ent !AS bpos !3UL Lev !3UL', 1 nk,line,%val(k), 1 auto_info.debug(k).name, 1 auto_info.debug(k).enti, 1 %val(auto_info.debug(k).bpos), 1 %val(auto_info.debug(k).level)) call terminal_debug(auto_info.ptr_terminal_info,line(1:nk),0,-1) if(.not. istat) goto 90 end do 90 auto_debug = istat return end