#-h- rat4sym 1388 asc 07-may-80 15:39:54 ## definitions for the preprocessor (hashed version from Dave Hanson) # put on a file named 'rat4sym' # Used by ratfor preprocessor, macro, and form tools define(BUFSIZE,300) #pushback buffer for ngetch and putbak define(DEFTYPE,-4) define(LEXBREAK,-8) define(LEXDIGITS,-9) define(LEXDO,-10) define(LEXELSE,-11) define(LEXFOR,-16) define(LEXIF,-12) define(LEXLITERAL,-19) define(LEXNEXT,-13) define(LEXOTHER,-14) define(LEXREPEAT,-17) define(LEXRETURN,-20) define(LEXUNTIL,-18) define(LEXWHILE,-15) define(MAXCHARS,10) # characters for outnum # (should be compatible with "putdec") define(MAXDEF,200) #max chars in a definition define(MAXFILE,6) #max files which can be open at a time define(MAXFNAMES,60) define(MAXFORSTK,200) #max space for for reinit clauses define(MAXNAME,30) #file name size in gettok define(MAXPTR,625) #number of defines in lookup define(MAXSTACK,100) #max stack depth for parser define(MAXTBL,6250) #max chars in all definitions define(MAXTOK,100) #max chars in a token define(NFILES,3) #max depth of file inclusion #(should be max nbr open files allowed - 3) define(TOGGLE,PERCENT) #literal toggle flag define(NHASHPTR,37) # number of pointer listheads (should be a prime) #-h- cdefio 279 asc 07-may-80 15:39:55 ## preprocessor common block to hold input characters # Put on a file called 'cdefio' # Used by ratfor preprocessor, macro, form, and shell tools common /cdefio/ bp, buf(BUFSIZE) integer bp # next available character; init = 0 character buf # pushed-back characters #-h- cform 407 asc 07-may-80 15:39:55 ## cform common block for formletter tool # put on a file named 'cform' # Used only by form common /cform/ outty, char1, char2, pstr(MAXLINE) integer outty #internal ID for writing to user's terminal character char1 #character to indicate beginning of prompt; #init = LESS character char2 #character to terminate prompt; #init = GREATER character pstr # prompt to use in guser #-h- form.r 4116 asc 07-may-80 15:39:57 #-h- main 235 asc 07-may-80 15:39:36 ## main calling program for form tool include rat4sym define(MAXFILES,10) #number files allowed on command line define(MAXREPLY,5000) #maximum characters available in user's response # call initr4 # call form # call endr4 # end #-h- forms 1217 asc 07-may-80 15:39:36 ## form - replace all instances of '<...>' in file with input from user # subroutine form subroutine main character line(MAXLINE) integer getarg, open, tty integer i, nfiles character fnames(FILENAMESIZE, MAXFILES) include cform include cdefio data char1 /LESS/ data char2 /GREATER/ #initialize input linefer pointer data bp /0/ if (tty(STDIN) == YES) { call trmout(line) outty = open(line, WRITE) #open user's terminal for writing if (outty == ERR) call cant(line) } call tbinit # initialize lookup and instal block nfiles = 0 for (i=1; getarg(i, line, MAXLINE) != EOF; i=i+1) { if (line(1) == QMARK & line(2) == EOS) #user needs help call error ('usage: form file ...') else if (line(1) == MINUS & line(2) != EOS) char1 = line(2) else if (line(1) == PLUS) char2 = line(2) else { nfiles = nfiles + 1 if (nfiles > MAXFILES) call error ('too many file names') call scopy(line, 1, fnames(1, nfiles), 1) } } for (i=1; i<=nfiles; i=i+1) #loop through all files { int = open(fnames(1,i), READ) if (int == ERR) call cant(line) call forml(int) call close(int) } if (i == 1) #no input file call error ('usage: form file ...') return end #-h- forml 626 asc 07-may-80 15:39:38 ##forml - replace prompts with user input on file 'int' subroutine forml(int) integer int, tog integer ftok, guser, lookup character token(MAXLINE), defn(MAXREPLY) include cform tog = NO while (ftok(token, int, tog) != EOF) { if (tog == YES) #inside prompt { if (token(1) == char2) { tog = NO next } if (lookup(token, defn) == NO) { call puser(token) if (guser(defn) == EOF) break call instal(token, defn) } call putlin(defn, STDOUT) next } else if (token(1) == char1) { tog = YES next } call putlin(token, STDOUT) #output normal text } return end #-h- puser 440 asc 07-may-80 15:39:38 ##puser - produce form letter prompt subroutine puser(pr) character pr(ARB) integer index integer i, istart include cform istart = 1 repeat { i = index(pr(istart), NEWLINE) if (i == 0) #no more internal lines to output break for ( i=istart + i - 1; istart <= i; istart = istart + 1) call putch(pr(istart), outty) } call scopy(pr, istart, pstr, 1) i = length(pstr) pstr(i+1) = BLANK pstr(i+2) =EOS return end #-h- ftok 561 asc 07-may-80 15:39:39 ## ftok - pick up token for form letter integer function ftok(token, int, prflag) character token(ARB) integer int, prflag character ngetch include cform for (i=1; i< MAXREPLY; i=i+1) { ftok = ngetch(token(i), int) if (ftok == EOF | (prflag == NO & ftok == NEWLINE) | (i == 1 & ftok == char1) | (i == 1 & ftok == char2) ) break if (ftok == char1 | ftok == char2) #beginning of next token { call putbak(ftok) i = i - 1 break } } if (i >=MAXREPLY) call error ("token too long.") token(i+1) = EOS return end #-h- guser 743 asc 07-may-80 15:39:40 ##guser - get form letter replacement text from user integer function guser(repl) character repl(ARB) integer getlin, prompt integer lth include cform lth = 0 repeat { if (lth == 0) i = prompt(pstr, repl(lth+1), STDIN) else i = getlin(repl(lth+1), STDIN) if (i == EOF) break lth = lth + i if (lth >= MAXREPLY) #oops--too long { call remark ('truncating response') break } if (repl(lth) == NEWLINE & repl(lth-1) != ESCAPE) break #no more lth = lth - 1 repl(lth) = NEWLINE #remove the escape #and continue } if (repl(lth) == NEWLINE) #remove last NEWLINE lth = lth - 1 repl(lth+1) = EOS if (i == EOF) guser = EOF else guser = lth return end