#
#
#
#    LIST File Listing Utility
#    =========================
#
#         Author:  William P. Wood, Jr.
#
#         Address: Computer Center
#                  Institute For Cancer Research
#                  7701 Burholme Ave.
#                  Philadelphia, Pa. 19111
#                  (215) 728 2760
#
#         Version: 3.0
#
#         Date:    March 26, 1982
#
#
#
#      *******************************************************
#      *                                                     *
#      *      THIS SOFTWARE WAS DEVELOPED WITH SUPPORT       *
#      *      FROM THE NATIONAL INSTITUTES OF HEALTH:        *
#      *         NIH CA06927                                 *
#      *         NIH CA22780                                 *
#      *                                                     *
#      *      DIRECT INQUIRIES TO:                           *
#      *            COMPUTER CENTER                          *
#      *            THE INSTITUTE FOR CANCER RESEARCH        *
#      *            7701 BURHOLME AVENUE                     *
#      *            PHILADELPHIA, PENNSYLVANIA   19111       *
#      *                                                     *
#      *      NO WARRANTY OR REPRESENTATION, EXPRESS OR      *
#      *      IMPLIED, IS MADE WITH RESPECT TO THE           *
#      *      CORRECTNESS, COMPLETENESS, OR USEFULNESS       *
#      *      OF THIS SOFTWARE, NOR THAT USE OF THIS         *
#      *      SOFTWARE MIGHT NOT INFRINGE PRIVATELY          *
#      *      OWNED RIGHTS.                                  *
#      *                                                     *
#      *      NO LIABILITY IS ASSUMED WITH RESPECT TO        *
#      *      THE USE OF, OR FOR DAMAGES RESULTING FROM      *
#      *      THE USE OF THIS SOFTWARE                       *
#      *                                                     *
#      *******************************************************
#
#
include "symbols.rat"

# getnum - evaluate one line number expression   
  logical function getnum(f, lin, i, buf, blen, num, sstat)
  byte lin(1), buf(1), c
  integer f, i, blen, sstat
  biginteger num, pnum, eofln
  logical getn
  include "clist.cmn"
  include "term.cmn"

  num = 0
  eofln = 0
  sstat = SEARCH$OK
  c = lin(i)
  if (c == '+'  |  c == '-')
    num = dot
  repeat {
    if (getn(f, lin, i, buf, blen, pnum, sstat, eofln))
      num = num + pnum
    else if (c == '+')
      num = num + (scrsiz+1)/2
    else if (c == '-')
      num = num - (scrsiz+1)/2
    else
      return (.false.)
    c = lin(i)
    } until (c != '+' & c != '-')
  if (eofln != 0)			# had a search failure
    num = eofln
  return (.true.)
  end

# getn - convert one term to line number    
  logical function getn(f, lin, i, buf, blen, pnum, sstat, eofln)
  byte lin(1), buf(1), delim,
    cupper
  integer f, i, j, blen, sstat, mul,
    scan, index
  biginteger pnum, eofln,
    ptscan, backsc
  logical makpat
  include "clist.cmn"

  getn = .true.
  mul = +1
  if (lin(i) == '-') {
    mul = -1
    i = i+1
    }
  else if (lin(i) == '+')
    i = i+1

  switch (lin(i)) {

    case EOS:
      getn = .false.

    case DOT:
      pnum = dot
      i = i+1

    case BEGIN_COMMAND_LINE_DOT:
      pnum = bcldot
      i = i+1

    case LASTLINE:
      dot = MAXINT
# only position to $ if necessary
      if (i == 1 | (index('?PpGgFf', lin(i+1)) == 0 & lin(i+1) != EOS))
	call posit(f)
      else if (lin(i-1) != ',')
	call posit(f)
      pnum = dot - 1
      i = i+1

    case TOPSCRVAR:
      pnum = topscr
      i = i+1

    case SAVELINE:
      pnum = savdot
      i = i+1

    case SEARCHCHAR, BACKSEARCH:
      delim = lin(i)
      if (! makpat(lin, i, delim))			# build the pattern
	getn = .false.
      else {
	if (delim == SEARCHCHAR) {
	  pnum = ptscan(f, buf, blen, MAXINT-1)
	  if (pnum == EOF) {
  	    set(sstat, SEARCH$FORWARDFAIL)
	    eofln = dot
	    pnum = eofln
	    }
	  }
	else {
	  pnum = backsc(f, buf, blen)
	  if (pnum == EOF) {
	    set(sstat, SEARCH$BACKFAIL)
	    eofln = 1
	    pnum = eofln
	    }
	  }
	}

    default:
      j = scan(lin, '1234567890', i)
      if (i != j) {
	decode (j-i, (i<j-i>), lin(i), err=10) pnum
	i = j
	}
      else
	getn = .false.
    }

  pnum = pnum*mul
  return

10 continue
  call err(lin, i, 'Number too large.')
  return (.false.)
  end

# makpat - make pattern if specified at lin(i)   
  logical function makpat(lin, i, delim)
  byte lin(1), delim
  integer i,
    wpstat,
    wpat
  include "pat.cmn"
  string spcial ' *?|&~%$^"`@@#<>,'
  data snull/.true./

  i = i+1
  if (lin(i) == EOS | lin(i) == delim) {		# use previous pattern
    if (lin(i) == delim)
      i = i + 1
    if (snull) {
      call err(lin, i-1, 'Current search string is null.')
      lin(i) = ERROR
      }
    }
  else {
    spcial(1) = delim
    wpstat = wpat(lin, i, spcial, srchst, MAXLINE*2)
    if (wpstat == 1)
      snull = .false.
    else {
      if (wpstat == 2)
	call err(lin, i, 'Pattern too long.')
      else
	call err(lin, i, 'Bad column range.')
      snull = .true.
      }
    }
  return (! snull)
  end

# ptscan - scan for next occurrence of pattern   
  biginteger function ptscan(f, buf, blen, mxsrch)
  byte buf(1)
  integer f, blen
  biginteger mxsrch
  integer getinp, wsrch
  include "clist.cmn"
  include "pat.cmn"

  ptscan = EOF
  call posit(f)
  for ( ; dot <= mxsrch; dot = dot+1)
    if (getinp(f, buf, blen) == EOF)
      break
    else if (wsrch(buf, blen, srchst) != 0) {
      ptscan = dot
      break
      }
  return
  end

# backsc - search backwards for pattern
  biginteger function backsc(f, buf, blen)
  byte buf(1)
  integer f, blen
  biginteger mx, sdot, num
  biginteger ptscan
  include "clist.cmn"

  backsc = EOF
  mx = dot - 1
  sdot = ((mx - 1)/mrkint)*mrkint + 1
  while (mx > 0) {	# search backwards in "mark interval" line chunks
    dot = sdot
    num = EOF
    repeat {
      backsc = num
      num = ptscan(f, buf, blen, mx)
      dot = dot + 1
      } until (num == EOF)
    if (backsc != EOF)
      break
    mx = sdot - 1
    sdot = sdot - mrkint
    }
  if (backsc == EOF)
    dot = 1
  else
    dot = backsc
  return
  end

# replac - replace occurrences of "char" in "lin" with "text"
  logical function replac(char, text, lin, size, i)
  integer size, i, textl, linl
  integer length
  byte char(1), text(1), lin(1),
       temp(_arith(2,*,MAXLINE))	# length(lin(i)) <= 2*MAXLINE!
  logical chscan

  replac = .true.
  linl = length(lin)
  textl = length(text)
  while (chscan(lin, i, char)) {
    if (textl+linl > size) {
      replac = .false.
      break
      }
    linl = linl+textl-1
    call scopy(lin, i+1, temp, 1)
    call scopy(text, 1, lin, i)
    i = i+textl
    call scopy(temp, 1, lin, i)
    }
  if (replac)
    i = 1
  return
  end

# chscan - scan "lin" for "char", ignoring occurrences within file names,
#          double quoted strings, and search patterns
  logical function chscan(lin, i, char)
  integer i,
    nuqcp
  byte lin(1), char, delim,
    cupper
  logical inpat

  chscan = .false.
  inpat = .false.
  for (i = nuqcp(lin, i); lin(i) != EOS; i = nuqcp(lin, i+1))
    if (inpat) {
      if (lin(i) == delim & lin(i-1) != '^')
	inpat = .false.
      }
    else if (lin(i) == SEARCHCHAR  |  lin(i) == BACKSEARCH) {
      delim = lin(i)
      inpat = .true.
      }
    else if (cupper(lin(i)) == char) {
      chscan = .true.
      break
      }
    else if (lin(i) == REDIRECT)
      break
  return
  end

# findrp - find matching right paren
  logical function findrp(comand, cp, rp)
  byte comand(1)
  integer cp, rp,
    lp
  logical chscan

  for ([rp = cp; lp = rp+1]; ; [rp = rp+1; lp = lp+1]) {
    if (! chscan(comand, rp, ')'))
      return(.false.)
    if (! chscan(comand, lp, '('))
      return(.true.)
    if (lp > rp)
      return(.true.)
    }
  end