#
#
#
#    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:    December 29, 1981
#
#
#
#      *******************************************************
#      *                                                     *
#      *      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                       *
#      *                                                     *
#      *******************************************************
#
#
define(MacroSearch)
include symbols.rat

# getnum - evaluate one line number expression   
integer function getnum(f, lin, i, buf, blen, num, bsfail)
byte lin(1), buf(1), c
integer f, i, blen
biginteger num, pnum
logical bsfail
integer getn
include clist.cmn
include term.cmn
 
getnum = YES
num = 0
c = lin(i)
if (c == '+'  |  c == '-')
  num = dot
repeat {
   if (getn(f, lin, i, pnum, buf, blen, bsfail) == YES)
      num = num + pnum
   else if (c == '+')
      num = num + (scrsiz+1)/2
   else if (c == '-')
      num = num - (scrsiz+1)/2
   else {
      getnum = NO
      break
      }
   c = lin(i)
   } until (c ~= '+' & c ~= '-')
return
end
 
# getn - convert one term to line number    
integer function getn(f, lin, i, pnum, buf, blen, bsfail)
byte lin(1), buf(1), delim
integer f, i, j, blen, mul
biginteger pnum
logical bsfail, makpat
integer scan
biginteger ptscan, backsc
include clist.cmn
include term.cmn
 
getn = YES
mul = +1
if (lin(i) == '-') {
  mul = -1
  i = i+1
  }
else if (lin(i) == '+')
  i = i+1
if (lin(i) == EOS)
   getn = NO
else if (lin(i) == CURLINE) {
   pnum = dot
   i = i+1
   }
else if (lin(i) == OLDDOT) {
   pnum = oldot
   i = i+1
   }
else if (lin(i) == FIRSTLINE) {
   pnum = 1
   i = i+1
   }
else if (lin(i) == LASTLINE) {
   dot = fmax+1
   call posit(f, dot)
   pnum = dot - 1
   i = i+1
   }
else if (lin(i) == TOPSCRVAR) {
   pnum = topscr
   i = i+1
   }
else if (lin(i) == SAVELINE) {
   pnum = savdot
   i = i+1
   }
else if (lin(i) == SEARCHCHAR  |  lin(i) == BACKSEARCH) {
   delim = lin(i)
   if (! makpat(lin, i, delim))			# build the pattern
      getn = ERROR
   else {
      if (delim == SEARCHCHAR) {
         pnum = ptscan(f, buf, blen, fmax)
         if (pnum == EOF)
            pnum = dot
         }
      else {
         pnum = backsc(f, buf, blen)
         if (pnum == EOF) {
            bsfail = .true.
            pnum = 1
            }
         }
      }
   }
else {
   j = scan(lin, '1234567890', i)
   if (i ~= j) {
      decode (j-i, (i<j-i>), lin(i), err=10) pnum
      i = j
      }
   else {
      getn = NO
      }
   }
 
pnum = pnum*mul
return
 
10 continue
getn = ERROR
call err(lin, i, 'Number too large.')
return
end
 
# makpat - make pattern if specified at lin(i)   
logical function makpat(lin, i, delim)
byte lin(1), delim
integer i
logical 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
   if (wpat(lin, i, spcial, srchst, MAXLINE*2))
      snull = .false.
   else {
      call err(lin, i, 'Pattern too long.')
      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, tfmax
integer getinp, wsrch
include clist.cmn
include pat.cmn
 
tfmax = fmax
fmax = mxsrch
ptscan = EOF
call posit(f, dot)
while (getinp(f, buf, blen) ~= EOF)
   if (wsrch(buf, blen, srchst) == 0)
      dot = dot+1
   else {
      ptscan = dot
      break
      }
fmax = tfmax
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)/100)*100 + 1
while (mx > 0) {			# search backwards in 100-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 - 100
   }
if (backsc == EOF)
   dot = 1
else
   dot = backsc
return
end
 
# replac - replace occurrences of "char" in "lin" with "text"
integer function replac(char, text, lin, size, i)
integer size, i, textl, linl
integer length, chscan
byte char(1), text(1), lin(1),
     temp(_arith(2,*,MAXLINE))	# length(lin(i)) <= 2*MAXLINE!
 
replac = YES
linl = length(lin)
textl = length(text)
while (chscan(lin, i, char) == YES) {
  if (textl+linl > size) {
    replac = NO
    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 == YES)
  i = 1
return
end
 
# chscan - scan "lin" for "char", ignoring occurrences within file names
#          and search patterns
integer function chscan(lin, i, char)
integer i
byte lin(1), char, delim
byte cupper
logical litral, inpat
 
chscan = NO
inpat = .false.
litral = .false.
for ( ; lin(i) ~= EOS; i = i+1)
  if (inpat) {
    if (lin(i) == LITERAL)
      if (lin(i+1) != LITERAL)
	litral = ! litral
      else
	i = i+1
    else if (lin(i) == delim & !litral)
      inpat = .false.
    }
  else if (lin(i) == SEARCHCHAR  |  lin(i) == BACKSEARCH) {
    delim = lin(i)
    inpat = .true.
    }
  else if (cupper(lin(i)) == char) {
    chscan = YES
    break
    }
  else if (lin(i) == REDIRECT)
    break
return
end
 
_ifndef(MacroSearch)
#  search has been recoded in macro for speed; see SEARCH.MAC
# search - find a pattern in a line
   integer function search(text, n, pattrn, m, shftab)
   byte text(1), pattrn(1), shftab(-128:127)
   integer n, m, j, i
 
   search = 0
   if (m ~= 0) {
      j = m
      while (j <= n) {
         do i = m,1,-1
            if (text(j-m+i) ~= pattrn(i)) {
               j = j + shftab(text(j))
               next 2
               }
         search = j-m+1
         return
         }
      }
   return
   end
_enddef