#-h- chsym            120 asc 07-may-80 12:08:54
 ## symbol definitions for ch tool
 # put on a file named 'chsym'
 # Used only by the 'ch' tool
  
 define(DITTO,(-3)) 
#-h- findsym          479 asc 07-may-80 12:08:55
 ## definitions for the FIND tool
 # put on a file named 'findsym'
 # Used by the find, ch, and tr tools
 
  define(ANY,QMARK) 
  define(BOL,PERCENT) 
  define(CCL,LBRACK) 
  define(CCLEND,RBRACK) 
  define(CHAR,LETA) 
  define(CLOSIZE,4) 
  define(CLOSURE,STAR) 
  define(COUNT,1) 
  define(EOL,DOLLAR) 
  define(MAXARG,128)
  define(MAXPAT,128) 
  define(NCCL,LETN) 
  define(PREVCL,2) 
  define(START,3) 
  define(NEXPR,10)	# maximum number of expressions allowed on cmd line
#-h- ch.r            4554 asc 07-may-80 12:08:58
#-h- main             309 asc 07-may-80 12:08:32
 #---------------------------------------------------------------------
 # include symbol definitions
 #        include symbols
 	  include findsym
	  include chsym
 #---------------------------------------------------------------------
##	ch -- main program
 
 
#	call initr4
#	call ch
#	call endr4
#	end
# 
#-h- chs             2504 asc 07-may-80 12:08:34
 ## ch - change 'string1'  into  'string2' 
#  subroutine ch 
 subroutine main
    character lin(MAXLINE), new(MAXLINE), pat(MAXPAT,NEXPR)
    character arg(MAXARG), from(MAXPAT), to(MAXPAT)
    integer addset, amatch, getarg, getlin, getpat, getsub 
    integer i, junk, k, lastm, m , index
    integer except, andpat, narg, frarg, toarg, npat, itoc, status, gmatch
  
 except = NO
 andpat = NO
 narg = 0
 for (i=1; getarg(i, arg, MAXARG) != EOF; i=i+1)
    if (arg(1) == QMARK & arg(2) == EOS)
	call cherr
    else if (arg(1) == MINUS)
	{
	call scopy(arg, 1, lin, 1)
	call fold(lin)
	if (index(lin, LETA) > 0)
	    andpat = YES
	if (index(lin, LETX) > 0)
	    except = YES
	call delarg(i)
	i = i - 1
	}
    else
	narg = narg + 1
 if (narg == 0)
    call cherr
 else if (narg == 1 | narg == 2)
    {
    frarg = 1
    toarg = 2
    npat = 1
    }
 else
    {
    toarg = narg
    frarg = narg - 1
    npat = narg - 2
    }
 if (npat > NEXPR)
    {
    call putlin("Maximum number of expressions permitted is ", ERROUT)
    i = itoc(NEXPR, arg, MAXARG)
    call error(arg)
    }
 junk = getarg(frarg, arg, MAXARG)
 if (getpat(arg, from) == ERR)
    call error("illegal fromexpr pattern.")
 if (getarg(toarg, arg, MAXARG) == EOF)
    arg(1) = EOS
 if (getsub(arg, to) == ERR)
    call error("illegal toexpr.")
 for (i=1; i <= npat; i=i+1)
    {
    junk = getarg(i, arg, MAXARG)
    if (getpat(arg, pat(1,i)) == ERR)
	{
	call putlin("illegal pattern: ", ERROUT)
	call error(arg)
	}
    }
 while (getlin(lin, STDIN) != EOF) 
    {
    status = gmatch(lin, pat, npat, andpat)
    if ((status == YES & except == NO) | (status == NO & except == YES))
	{
       k = 1 
       lastm = 0 
       for ( i =1; lin(i) != EOS; ) { 
          m = amatch(lin, i, from) 
          if (m > 0 & lastm != m) {   # replace matched text 
             call catsub(lin, i, m, to, new, k, MAXLINE) 
             lastm = m 
             } 
          if (m == 0 | m == i) {   # no match or null match 
             junk = addset(lin(i), new, k, MAXLINE) 
             i = i + 1 
             } 
          else            # skip matched text 
             i = m 
          } 
       if (addset(EOS, new, k, MAXLINE) == NO) { 
          k = MAXLINE 
          junk = addset(EOS, new, k, MAXLINE) 
          call remark('line truncated:.') 
          call putlin(new, ERROUT) 
          call putch(NEWLINE, ERROUT) 
          } 
       call putlin(new, STDOUT) 
       } 
    else
	call putlin(lin, STDOUT)
    }
  return 
    end 
#-h- catsub           484 asc 07-may-80 12:08:37
 ## catsub - add replacement text to end of  new. 
    subroutine catsub(lin, from, to, sub, new, k, maxnew) 
    integer addset 
    integer from, i, j, junk, k, maxnew, to 
    character lin(MAXLINE), new(maxnew), sub(MAXPAT) 
  
    for (i = 1; sub(i) != EOS; i = i + 1) 
       if (sub(i) == DITTO) 
          for (j = from; j < to; j = j + 1) 
             junk = addset(lin(j), new, k, maxnew) 
       else 
          junk = addset(sub(i), new, k, maxnew) 
    return 
    end 
#-h- getsub           223 asc 07-may-80 12:08:38
 ## getsub - get substitution pattern into sub (/*/sor/chr) 
    integer function getsub(arg, sub) 
    character arg(MAXARG), sub(MAXPAT) 
    integer maksub 
  
    getsub = maksub(arg, 1, EOS, sub) 
    return 
    end 
#-h- maksub           648 asc 07-may-80 12:08:39
 ## maksub - make substitution string in sub (/*/sor/chr) 
    integer function maksub(arg, from, delim, sub) 
    character esc 
    character arg(MAXARG), delim, sub(MAXPAT) 
    integer addset 
    integer from, i, j, junk 
  
    j = 1 
    for (i = from; arg(i) != delim & arg(i) != EOS; i = i + 1) 
       if (arg(i) == AND) 
          junk = addset(DITTO, sub, j, MAXPAT) 
       else 
          junk = addset(esc(arg, i), sub, j, MAXPAT) 
    if (arg(i) != delim)   # missing delimiter 
       maksub = ERR 
    else if (addset(EOS, sub, j, MAXPAT) == NO)   # no room 
       maksub = ERR 
    else 
       maksub = i 
    return 
    end 
#-h- cherr             92 asc 07-may-80 12:08:40
 subroutine cherr

 call error("usage:  ch [-ax] [expression ...] from [to]")

 return
 end