include std.def # gcmd - get command line from MCR, TS, or terminal # This routine may be used by programs wishing to receive a # time sharing message (command line) from XEQ, a # command line from MCR, or a command line from the terminal # directly using a prompt. # # By William Wood, Sept 1980 # define(MCR,-2) #$define(MESSAGE,-1) define(TERMINAL,0) define(EOS,0) define(EOF,-10) subroutine gcmd(lun, prompt, buf, len, maxlen, source) byte prompt(1), buf(1) integer lun, len, maxlen, source integer i, j, junk logical first data first/.true./ len = 0 if (first) { first = .false. call getmcr(buf, len) if (len > 0) { source = MCR for (i = 1; i < len; i = i+1) if (buf(i) == ' ') break j = i for (i = i+1; i <= len; i = i+1) buf(i-j) = buf(i) len = len - j } #$ else { #$ call reccml(buf, len) #$ source = MESSAGE #$ } } if (len <= 0) { source = TERMINAL if (lun == 0) len = EOF else { repeat call readpr(lun, prompt, buf, len, maxlen-1, junk) until(len >= 0 | len == EOF) } } buf(max0(1, min0(maxlen, len+1))) = EOS return end # cmdget - get a line with prompt from CMDIN integer function cmdget(buf, prompt, source) character buf(ARB), prompt(ARB) integer nc, source repeat { call gcmd(CMDIN, prompt, buf, nc, MAXLINE-1, source) if (nc < 0 & nc ~= -10) call remark('error reading command line.') else break } if (nc == -10) { cmdget = EOF buf(1) = EOF buf(2) = EOS } else { cmdget = nc+1 buf(cmdget) = NEWLINE buf(cmdget+1) = EOS } return end # gclin -- prompt user for arguments, redirect standard files subroutine gclin(prompt, source) character prompt(ARB) integer cmdget, nc, source include argcom.rat noread = .false. repeat { nc = cmdget(argstr, prompt, source) if (nc == EOF | nc == 1) break call doredr } until (argstr(1) ~= NEWLINE) return end # getarg -- interface to gtarg2 with read if none done already integer function getarg(n, string, size) integer n, size character string(ARB) integer gtarg2 include argcom.rat if (noread) { call gclin('> ', source) } getarg = gtarg2(n, string, size) return end define(min,min0) # gtarg2 -- get the n-th argument and return its length or EOF integer function gtarg2 (n, string, size) integer n, size, source character string (ARB) integer i, j, k, m logical lb include argcom.rat j = 0 i = 1 lb = .false. while (j < n) { while (argstr(i) == ' ' | argstr(i) == TAB | argstr(i) == ',') i = i+1 if (argstr(i) == EOF | argstr(i) == NEWLINE) { string(1) = argstr(i) gtarg2 = EOF return } if (argstr(i) == '/') { string(1) = '/' k = 1 } else k = 0 repeat { k = k+1 m = i+k-1 if (k < size) string(k) = argstr(m) if (argstr(m) == LBRACK) lb = .true. else if (argstr(m) == RBRACK) lb = .false. } until (~lb & (argstr(m) == ' ' | argstr(m) == TAB | argstr(m) == NEWLINE | argstr(m) == ',' | argstr(m) == '/')) string(min(k, size)) = EOS i = m j = j+1 } gtarg2 = min(k, size) if (upflag) call upper(string) return end # delarg - delete the nth argument in the command line subroutine delarg (n) integer i, j, begstr, n logical lb include argcom.rat j = 0 i = 1 lb = .false. while (j < n) { begstr = i while (argstr(i) == ' ' | argstr(i) == TAB | argstr(i) == ',') i = i+1 if (argstr(i) == EOF | argstr(i) == NEWLINE) return repeat { if (argstr(i) == LBRACK) lb = .true. else if (argstr(i) == RBRACK) lb = .false. i = i+1 } until (~lb & (argstr(i) == ' ' | argstr(i) == TAB | argstr(i) == NEWLINE | argstr(i) == ',' | argstr(i) == '/')) j = j+1 } if (begstr == 1 & argstr(i) ~= '/' & argstr(i) ~= NEWLINE) i = i+1 call scopy(argstr, i, argstr, begstr) return end # doredr -- do any redirection of std files required subroutine doredr character buf(MAXLINE), opntyp integer i, k, ier integer gtarg2, index include argcom.rat call scopy(argstr, 1, buf, 1) k = 1 for (i = 1; buf(i) ~= EOS; i = i+1) { if (k > MAXLINE-3) call error('command line overflow in doredr.') if (index('<>?', buf(i)) ~= 0) { argstr(k) = ' ' k = k+1 if ((buf(i) == '>' & buf(i+1) == '>') | (buf(i) == '?' & buf(i+1) == '?')) { argstr(k) = buf(i) k = k+1 i = i+1 } } argstr(k) = buf(i) k = k+1 } argstr(k) = EOS for (i = 1; gtarg2(i, buf, MAXLINE) ~= EOF; ) { if (buf(1) == '<') { call scopy(buf, 2, buf, 1) call opnstd(buf, STDIN, READONLY, 'TI:', FORTRAN) call delarg(i) } else if (buf(1) == '>') { k = 2 opntyp = WRITE if (buf(2) == '>') { k = 3 opntyp = EXTEND } call scopy (buf, k, buf, 1) call opnstd(buf, STDOUT, opntyp, 'TI:', WRITE) call delarg(i) } else if (buf(1) == '?') { k = 2 opntyp = WRITE if (buf(2) == '?') { k = 3 opntyp = EXTEND } call scopy (buf, k, buf, 1) call opnstd(buf, ERROUT, opntyp, 'TI:', WRITE) call delarg (i) } else # no redirection, bump counter i = i + 1 } return end # opnstd - close and reopen standard files subroutine opnstd(buf, unit, access, stdfil, stdacc) character buf(ARB), stdfil(ARB), access, stdacc integer unit, closec, ier include iocom.rat if (closec(unit, SAVEF) ~= ERR) { if (buf(1) == EOS) { # redirect back to standard file call opn(unit, stdfil, stdacc, ier) if (ier ~= 0) { call putlin(stdfil, ERROUT) call error(': can''t open in opnstd.') } else if (unit == STDIN) tiin = .true. # reading from terminal } else { call defnam(buf, 'SY:', 0, 0) call opn(unit, buf, access, ier) if (ier ~= 0) { call opn(unit, stdfil, stdacc, ier) if (ier ~= 0) { call putlin(stdfil, ERROUT) call error(': can''t open in opnstd.') } else if (unit == STDIN) tiin = .true. # reading from terminal call putlin(buf, ERROUT) call remark(': can''t open.') } else if (unit == STDIN) tiin = .false. # not reading from terminal } } return end