/*
 *                         X F I E L D
 *
 *  Extract a field (defined by a standard field descriptor) from
 *  a record.
 *
 *  Standard field descriptors have the following form :
 *
 *  <sfd> ::= <constant> | <begin>"|"<end>
 *
 *            A field descriptor may either specify a constant
 *            (text) field or the begining and end points of an
 *            input line.
 *
 *  <constant> ::= <leading-spaces> | <trailing-spaces> | <text>
 *  <leading-spaces> ::= "S" <number>
 *  <trailing-spaces> ::= "T" <number>
 *  <text> ::= "\" <string> "`"
 *
 *            Constants may be either a number of spaces or a
 *            quoted text string
 *
 *  <begin> ::=
 *  <end> ::= {<locator> | <constant>} [<justifier>] {<locator> | <constant>}
 *
 *            Begining and end specifiers have the same basic form
 *            and may contain either commands to locate the "pointer"
 *            or constant fields. The "pointer" starts at zero for
 *            <begin> and at the result of <begin> for <end>.
 *
 *  <justifier> ::= "L" <number> | "R" <number> | "C" <number>
 *
 *          "L", "R" or "C" specifies left right or center
 *          justification. The number is the total width of the field.
 *
 *  <locator> ::= "A" <number> |
 *                "+" <number> |
 *                "-" <number> |
 *                "`" <text> "`" |
 *                "~" <text> "`" |
 *		  ">"		|
 *		  "<"
 *
 *           "A" (absolute) jumps the pointer to a particular place in
 *           the input record. "+" and "-" add and subtract the number
 *           from the pointer. "`" searches for the next occurence of
 *           <text> after pointer and sets pointer to the first character
 *           after <text>. "~" searches for the first non-occurence of
 *           <text> after pointer and positions the pointer after it.
 *	     ">" sets search direction right (default at start, NOT re-
 *	     defaulted at "|") "<" sets search direction left.
 *
 */

/*
 *	BUGS
 *
 *	we need a better command lingo (before we look like teco)
 *
 *	at least we need an escapement (or stropping?)
 *
 *	re-code for optimum use of 0 and '\0' values (particularly
 *	in IFs).
 *
 */

/*	EDIT HISTORY

?	M0	perpetrated by M*A*J*O*R
22Sep84	PF1	problem: |+1 gives first TWO characters of line
		intuitively I believe it should give ONE character
		I.E. we start pointer on 1st char (ordinated 0?)
		and we output all chars from BEGIN to END-1
		So we change: while <=efield to while <efield
		and we initialise efield to point just past end of input line
20Dec84 PF2	problem: I want to search backwards. Further, I want
		not-search backwards also.
		elect:	use ">" "<" to set search direction MODEs (ecch)
			set direction mode only at begin of xfield, not @ |
		invent 'direction' variable
		also make sure that we land at start or end of string
		according to direction (this kludge should be in 1 not
		two places!)
*/

#include <stdio.h>
#include <algol68.h>

xfield(fd,line,warnp,fatalp,ofs,dot,sfwrnp,sfftlp,errp)

char *fd;			/* Field descriptor */
char *line;			/* Record containing field */
bool warnp;			/* Tell user if he does something wrong */
bool fatalp;			/* Fall over if he does something wrong */
int ofs;			/* Offset 1 if line[0] is column 1 */
int dot;			/* Position of "cursor" upon call */
bool sfwrnp;			/* Tell user if a search fails */
bool sfftlp;			/* Fall over if a search fails */
bool *errp;			/* Return error flag to user */

BEGIN

  char *bfield;			/* Begining of field (in input) */
  char *efield;			/* End of field (in input) */
  int nleadsp;			/* Number of leading spaces */
  int ntrailsp;			/* Number of trailing spaces */
  int just;			/* Justification code ('n','l','r' or 'c') */
  int olen;			/* Output field length */
  int jlen;			/* Justify field length */
  char *bstring;		/* Begining of constant string */
  char *estring;		/* End of constant string */
  bool hadstringp;		/* True if we have seen a \t` command */

  char **begend;		/* TEMP: Begining or end of field */
  char *fdp;			/* TEMP: Pointer into field desc pointer */
  char *tp,*ip;			/* TEMP: General purpose pointers */
  int len;			/* TEMP: Length of field */

  char *ans;			/* Module to return */
  char *b4j;			/* Copy of output before justification */

  int	direction;		/* +1: search forwards -1:backwards	*/
				/*$PF2*/

/***** PUT IN DEFAULTS *****/

  direction = 1;		/*$PF2*/
  bfield=dot;
	/* Default begining of output is position of cursor */
  for (efield=line; *efield!='\0'; efield++) {};
	/*$PF1  efield=efield-1;	*/
	/* Default end of output is end of input */
  nleadsp=ntrailsp=0;
	/* Default leading and trailing spaces is none */
  just='n'; jlen=0;
	/* Default justification is none */
  bstring=""; estring=bstring-1;
  hadstringp=FALSE;
	/* Default string to print is none */
  *errp=FALSE;
	/* No errors yet (this is fixable) */

/***** SCAN FIELD DESCRIPTOR *****/

  begend=&bfield;	/* Scan for begining of field first */

  for (fdp=fd; *fdp!='\0' && !*errp; fdp++) DO
    switch (tolower(*fdp))
    BEGIN
      case '<' :  direction = -1;
		  break;
      case '>' :  direction =  1;
		  break;
      case 'a' :  /* Process an 'absolute' command */
		  /* An - n is the new (relative) pointer position */
		  *begend=line+XFgn(&fdp)-ofs;
		  break;
      case '+' :  /* Process a 'plus' command */
		  /* +n - n is added to the pointer position */
		  *begend=*begend + XFgn(&fdp);
		  break;
      case '-' :  /* Process a 'minus' command */
		  /* -n - n is subtracted from the pointer position */
		  *begend=*begend - XFgn(&fdp);
		  break;
      case 'r' :
      case 'l' :
      case 'c' :  /* Process justification commands */
		  /* Xn - Where X is type of justification and */
		  /*      n is field width */
		  IF (just != 'n')
		  THEN
		    *errp=XFerr(warnp,fatalp,line,fd,
				"Only one justification allowed");
		  ELSE
		    just=tolower(*fdp);
		    jlen=XFgn(&fdp);
		  FI;
		  break;
      case '|' :  /* Process a vertical bar */
		  /* change from specifying input to specifying output */
		  IF (begend == &efield)
		  THEN
		    *errp=XFerr(warnp,fatalp,line,fd,"Only one '|' allowed");
		  ELSE
		    efield=bfield;
		    begend=&efield;
		  FI;
		  break;
      case 's' :  /* Process a leading spaces command */
		  /* Sn - Insert n spaces at begining of output */
		  IF (nleadsp != 0)
		  THEN
		    *errp=XFerr(warnp,fatalp,line,fd,"Only one 'S' allowed");
		  ELSE
		    nleadsp=XFgn(&fdp);
		  FI;
		  break;
      case 't' :  /* Process a trailing spaces command */
		  /* Tn - Insert n spaces at end of output */
		  IF (ntrailsp != 0)
		  THEN
		    *errp=XFerr(warnp,fatalp,line,fd,"Only one 'T' allowed");
		  ELSE
		    ntrailsp=XFgn(&fdp);
		  FI;
		  break;
      case '\\' : /* Process a 'print' command */
		  /* \t` - Include text t in output */
		  IF (hadstringp)
                  THEN
		    *errp=XFerr(warnp,fatalp,line,fd,"Only one '\\' allowed");
		  ELSE
		    hadstringp=TRUE;
  		    bstring=fdp+1;
		    FOR (estring=bstring;
		         *estring!='`' && estring!='\0';
		         estring++) {};
		    IF (*estring=='\0')
		    THEN
		      *errp=XFerr(warnp,fatalp,line,fd,"Unterminated string");
		    ELSE
		      fdp=estring;
		      estring=estring-1;
		    FI;
		  FI;
		  break;
      case '`' :  /* Process a 'search' command */
		  /* `t` - position after next occurence of t */
		  FOR (tp=fdp+1; *tp!='`' && *tp!='\0'; tp++) {};
		  IF (*tp=='\0')
		  THEN
		    *errp=XFerr(warnp,fatalp,line,fd,
				"unterminated search string");
		  ELSE
		    WHILE (  ( (direction>0) ? (**begend!='\0') : (*begend>=line) )
                          && !XFmatchp(fdp+1,*begend)
                          ) DO
		      *begend += direction;
		    OD;
		    IF (**begend!='\0' && *begend>=line)
		    THEN
		      IF (direction>0)
                      THEN len=tp-fdp-1;
		           *begend=*begend+len;
                      FI;
		    ELSE
		      *tp='\0';
		      *errp=XFerr(sfwrnp,sfftlp,line,fd,
				"Search for '%s' fails",fdp+1);
		      *tp='`';
                      IF (*begend<line)
                      THEN *begend = line;
                      FI;
		    FI;
		    fdp = tp;
		  FI;
		  break;
      case '~' :  /* Process a 'compsearch' command */
		  /* ~t` - position before first thing other than t */
		  FOR (tp=fdp+1; *tp!='`' && *tp!='\0'; tp++) {};
		  IF (*tp=='\0')
		  THEN
		    *errp=XFerr(warnp,fatalp,line,fd,
				"unterminated search string");
		  ELSE
		    WHILE ( ( (direction>0) ? (**begend!='\0') : (*begend>=line) )
                          && XFmatchp(fdp+1,*begend)
                          ) DO
		      *begend += direction;
		    OD;
		    IF (**begend=='\0' || *begend<line)
		    THEN
		      *tp='\0';
		      *errp=XFerr(sfwrnp,sfftlp,line,fd,
				"Compsearch for '%s' fails",fdp+1);
		      *tp='`';
		      IF (*begend<line)
		      THEN
                        *begend = line;
		      FI;
                    ELSE
                      IF (direction>0)
                      THEN len = tp-fdp-1;
                           *begend += len;
                      FI;
		    FI;
		    fdp = tp;
		  FI;
		  break;
      default:    /* I don't know what that character does */
		  *errp=XFerr(warnp,fatalp,line,fd,
			"Invalid character '%c' in field descriptor",*fdp);
		  break;
    END;
    IF (*errp)
    THEN
      FOR (; *fdp!='\0'; fdp++) {};
    FI;
  END;

  /*$PF1
	bfield ->	1st char if any
	efield	->  1+	last char if any
  */

  /* If we have had an error before this create a null */
  /* string and return it */

  IF (*errp)
  THEN
    ans = malloc(1);
    IF (ans==0)
    THEN
      fprintf(stderr,"XFIELD: Out of memory -- fatal\n");
      exit();
    FI;
    *ans='\0';
  ELSE
    /* Calculate the total length of the output so far specified */

	IF	(efield<bfield)
	THEN	efield = bfield;
	FI;

    olen=nleadsp+(estring-bstring+1)+(efield-bfield/*$PF1 +1 */)+ntrailsp;

/*
	IF	(olen<0)
	THEN	XFerr(TRUE,TRUE,line,fd,"endcol=%d. begcol=%d.",efield,bfield);
		exit();
	FI;
*/

    /* Create memory module (extra byte is for the null at the end) */

    ans=malloc(olen+1);
    IF (ans==0)
    THEN
      fprintf(stderr,"XFIELD: Out of memory -- fatal\n");
      exit();
    FI;
    tp=ans;

    /* Pile data into memory module */

    FOR (; nleadsp>=1; nleadsp--) DO
      *tp++=' ';
    OD;
    WHILE (bstring<=estring) DO
      *tp++=*bstring++;
    OD;
    WHILE (bfield< /*$PF1 = */ efield) DO
      *tp++=*bfield++;
    OD;
    FOR (; ntrailsp>=1; ntrailsp--) DO
      *tp++=' ';
    OD;
    *tp='\0';

    /* Justification processing */

    IF (just!='n')
    THEN
      /* First the easy case - String is too long - truncate */

      IF (olen>=jlen)
      THEN
	ans[jlen]='\0';
      ELSE
	/* I didn't think it was going to be that easy */
        /* Make a copy of output and create new buffer */
	b4j=ans;
	ans=malloc(jlen+1);
        IF (ans==0)
        THEN
          fprintf(stderr,"XFIELD: Out of memory -- fatal\n");
          exit();
        FI;
	/* Calculate spacings */
        nleadsp=ntrailsp=0;
	switch (just)
	BEGIN
	  case 'r' : nleadsp=jlen-olen; break;
	  case 'l' : ntrailsp=jlen-olen; break;
	  case 'c' : nleadsp=(jlen-olen)/2;
		     ntrailsp = jlen-olen-nleadsp; break;
	END;

        /* Pile data into memory module */

	tp=ans;

	FOR (; nleadsp>=1; nleadsp--) DO
	  *tp++=' ';
	OD;
        ip=b4j;
	WHILE (*ip!='\0') DO
	  *tp++=*ip++;
	OD;
	FOR (; ntrailsp>=1; ntrailsp--) DO
	  *tp++=' ';
	OD;
	*tp='\0';

        /* Throw away unjustified output */

        mfree(b4j);

      FI;
    FI;
  FI;
  return(ans);
END

/*
 * ERR : Process an error
 */

XFerr(warnp,fatalp,rec,fld,msg,x1,x2)

char *msg;			/* Message to tell user what happened */
bool warnp;			/* True if we want to tell user */
bool fatalp;			/* True if we want to stop on error */
char *rec;			/* the record done it */
char *fld;			/* the field descriptor done it */
union  {			/* Define to include all types used */
  int i; char c;		/* ... only types we know */
  } *x1,*x2;			/* ... Arguements for printf */

BEGIN

  IF (warnp)
  THEN
    fprintf(stderr,"XFIELD : ");
    fprintf(stderr,msg,x1,x2);
    fprintf(stderr," -- %s\n",fatalp?"FATAL":"CONTINUING");
    fprintf(stderr,"         field='%s', record='%s'\n",fld,rec);
  FI;
  IF (fatalp)
  THEN
    exit();
  FI;
  return(TRUE);
END

/*
 * GN : Get a number out of the string
 */

XFgn(ip)

char **ip;			/* Input pointer */

BEGIN

  int n;			/* Number being generated */

  n=0;
  *ip=*ip+1;
  FOR(; **ip>='0' && **ip<='9'; *ip=*ip+1) DO
    n=n*10+(**ip-'0');
  OD;
  *ip=*ip-1;

 return(n);

END

/*
 * MATCHP : Returns TRUE if target=try up to the length of try
 *          Try ends with a "`"
 */

XFmatchp(target,try)

char *target;			/* String to look for */
char *try;			/* String to look in */

BEGIN

  WHILE (*target==*try && *target!='`')
  BEGIN
    target++;
    try++;
  END;
  return(*target=='`');

END