/* Output from p2c 1.21alpha-07.Dec.93, the Pascal-to-C translator */
/* From input file "censor.p" */


#include <p2c/p2c.h>


/* censor: removes code from a program

  Tom Schneider
  National Cancer Institute
  Laboratory of Mathematical Biology
  Frederick, Maryland  21702-1201
  toms@ncifcrf.gov
  http://www-lmmb.ncifcrf.gov/~toms/

  National Cancer Institute
  Laboratory of Mathematical Biology

 */

/* end of program */

/* begin module version */

#define version         1.47
/* of censor.p 1996 January 28
origin 1990 December 19 */
/* end module version */

/* begin module describe.censor */
/*
name
   censor: removes code from a program

synopsis
   censor(input: in, output: out)

files
   input:  input program with private text
   output: output program without private text

description
   The program allows one to maintain a Pascal program for personal use which
   contains features that are not yet to be made public.  The program contains
   special comment marks that delimit the text to be removed.  There are two
   situations.

   The first is the case of sections of text inside comments.  Any text
   surrounded by [[ and ]] will not be copied to the output.  This includes the
   double brackets themselves.

   The second case is sections of normal code.  Letting '@' represent the
   asterisk (so that this description does not run into trouble when it
   is inside a Pascal comment), the text between and including the symbols
   (@[[@) and (@]]@) is not copied to the output.

examples

documentation

see also

author
   Thomas Dana Schneider

bugs

technical notes

*/
/* end module describe.censor */

/* begin module censor.const */

#define maxstring       1500   /* the maximum string */
/* end module censor.const */

#define fillermax       10   /* the size of the filler array for a string */


/* begin module interact.type */

typedef struct string {
  /* a string of characters */
  Char letters[maxstring];   /* the letters in the string */
  long length;   /* the number of characters in the string */
  long current;   /* the letter we are working on */
} string;

/* end module interact.type version = 4.09; (@ of prgmod.p 1990 May 18 */

/* begin module filler.type */
/* the following is an array used to fill a string.
it is convenient to have it much shorter than the maxstring, so that
it is easy to fill the string using procedure fillstring.
the user must declare the value of constant fillermax. */
typedef Char filler[fillermax];
/* end module filler.type version = 4.09; (@ of prgmod.p 1990 May 18 */

/* begin module trigger.type */

typedef struct trigger {
  /* an object to be searched for */
  string seek;   /* the characters looked for */
  long state;   /* how close to triggering we are */
  boolean skip;   /* trigger not found- skip the line */
  /* the trigger was found */
  boolean found;
} trigger;

/* end module trigger.type version = 4.09; (@ of prgmod.p 1990 May 18 */

/* begin module halt */


Static jmp_buf _JL1;


Static Void halt()
{
  /* stop the program.  the procedure performs a goto to the end of the
     program.  you must have a label:
        label 1;
     declared, and also the end of the program must have this label:
        1: end.
     examples are in the module libraries.
     this is the only goto in the delila system. */
  printf(" program halt.\n");
  longjmp(_JL1, 1);
}


/* end module halt version = 4.09; (@ of prgmod.p 1990 May 18 */

/* begin module interact.clearstring */
Static Void clearstring(ribbon)
string *ribbon;
{
  /* empty the string */
  long index;   /* to the ribbon */

  for (index = 0; index < maxstring; index++)
    ribbon->letters[index] = ' ';
  ribbon->length = 0;
  ribbon->current = 0;
}  /* clearstring */


/* end module interact.clearstring version = 4.09; (@ of prgmod.p 1990 May 18 */

/* begin module interact.getstring */
Static Void getstring(afile, buffer, gotten)
_TEXT *afile;
string *buffer;
boolean *gotten;
{
  /* get a string from a file not using string calls.  this lets one
obtain lines from a file without interactive prompts */
  long index = 0;   /* of buffer */

  clearstring(buffer);
  if (BUFEOF(afile->f)) {
    *gotten = false;
    return;
  }
  while (!P_eoln(afile->f) && index < maxstring) {
    index++;
    buffer->letters[index-1] = getc(afile->f);
    if (buffer->letters[index-1] == '\n')
      buffer->letters[index-1] = ' ';
  }

  if (!P_eoln(afile->f)) {
    printf(" getstring: a line exceeds maximum string size (%ld)\n",
	   (long)maxstring);
    halt();
  }

  buffer->length = index;
  buffer->current = 1;
  fscanf(afile->f, "%*[^\n]");
  getc(afile->f);
  *gotten = true;
}  /* getstring */


/* end module interact.getstring version = 4.09; (@ of prgmod.p 1990 May 18 */

/* begin module interact.writestring */
Static Void writestring(tofile, s)
_TEXT *tofile;
string *s;
{
  /* write the string s to file tofile, no writeln */
  long i;   /* index to s */
  long FORLIM;

  FORLIM = s->length;
  for (i = 0; i < FORLIM; i++)
    putc(s->letters[i], tofile->f);
}  /* writestring */


/* end module interact.writestring version = 4.09; (@ of prgmod.p 1990 May 18 */

/* begin module filler.fillstring */
Static Void fillstring(s, a)
string *s;
Char *a;
{
  /* this procedure makes it reasonably easy to fill the string s with
characters.  one calls the procedure as: */
  /*                           1         2         3         4         5 */
  /*                  12345678901234567890123456789012345678901234567890 */
  /*   fillstring(s, 'this-is-the-string                                ');
the two comments make it easy to line the characters up. also, for this
example, it was assumed that the length of filler as defined by the
constant fillermax was 50. */
  long length = fillermax;   /* of the string without trailing blanks */
  long index;   /* of s */

  clearstring(s);
  while (length > 1 && a[length-1] == ' ')
    length--;
  if (length == 1 && a[length-1] == ' ') {
    printf("fillstring: the string is empty\n");
    halt();
  }

  for (index = 0; index < length; index++)
    s->letters[index] = a[index];
  s->length = length;
  s->current = 1;
}  /* fillstring */


/* end module filler.fillstring version = 4.09; (@ of prgmod.p 1990 May 18 */

/* begin module filler.filltrigger */
Static Void filltrigger(t, a)
trigger *t;
Char *a;
{
  /* fill the trigger t */
  fillstring(&t->seek, a);
}  /* fillstring */


/* end module filler.filltrigger version = 4.09; (@ of prgmod.p 1990 May 18 */

/* begin module trigger.proc */
/* this module allows one to scan a series of characters, as from
an array or a file, and to "trigger" or detect a simple string
in the series.  the advantage of the trigger is that several triggers
can "observe" a stream of characters at once, each looking for a
different thing.
some other modules required: interact.const, interact.type */

Static Void resettrigger(t)
trigger *t;
{
  /* reset the trigger to ground state */
  t->state = 0;
  t->skip = false;
  t->found = false;
}  /* resettrigger */


Static Void testfortrigger(ch, t)
Char ch;
trigger *t;
{
  /* look at the character ch.
     if it is part of the trigger (at the current trigger state),
         then the trigger state goes higher.
     if it is not part of the trigger then the trigger state is reset,
        skip is true and one should skip onward to find the trigger.
     if the trigger is found, found is true. */
  t->state++;
  /*         if debugging then begin
              writestring(list,seek);
              writeln(list,'testfortrigger seek.letters[',state:1,']:',
                             seek.letters[state],' ch:',ch);
           end;*/
  if (t->seek.letters[t->state - 1] == ch) {
    t->skip = false;
    if (t->state == t->seek.length)
      t->found = true;
    else
      t->found = false;
    return;
  }
  t->state = 0;
  t->skip = true;
  t->found = false;
  /* reset trigger */
}  /* testfortrigger */


/* end module trigger.proc version = 4.09; (@ of prgmod.p 1990 May 18 */

/* begin module censor.tocharacter */
Static Char tocharacter(n)
long n;
{
  /* convert the integer n to a character */
  return ((Char)(n + '0'));
}


/* end module censor.tocharacter */

/* begin module censor.writeedit */
Static Void writeedit(tofile, state, s, e)
_TEXT *tofile;
long state;
string s, e;
{
  /* write the string s to file tofile, with writeln.  Edit out the portions
of s for which e is '2','3','5', or '6' */
  boolean doreturn = false;
  /* if there were any printed characters, be sure to
    produce a carriage return for the line. */
  long i;   /* index to s */
  boolean printing;   /* if true, print */

  if (s.length > 0) {
    for (i = 0; i < s.length; i++) {
      printing = (e.letters[i] == '4' || e.letters[i] == '1' ||
		  e.letters[i] == '0');
      if (printing) {
	putc(s.letters[i], tofile->f);
	doreturn = true;
      } else
	doreturn = false;
    }
  } else
    doreturn = (state == 0 || state == 1 || state == 4);

  /* if we are at the end of the line, and the state is to print,
     put a carriage return */
  if (doreturn)
    putc('\n', tofile->f);
}  /* writeedit */


/* Local variables for themain: */
struct LOC_themain {
  _TEXT *outfile;
  boolean debugging;   /* set to true if debugging */
  string idline;   /* identifier line for the states */
  long state;
  /* state of the program.
     state = 0; scan and copy, outside comments
               when     '(@' is found, move to state 1             t0a
               when      '{' is found, move to state 4             t0b

     state = 1; scan and copy, copy program comments
               when     '@)' is found, move to state 0             t1a
               when     '[[' is found, move to state 2             t1b
     state = 2; scan and delete comment text (including comments)
               when '(@[[@)' is found, move to state 3             t2a
               when     ']]' is found, move to state 1             t2b
     state = 3; scan and delete program text (including comments)
               when '(@]]@)' is found, move to state 0             t3a

     state = 4; scan and copy, copy program comments
               when      '}' is found, move to state 0             t4a
               when     '[[' is found, move to state 5             t4b
     state = 5; scan and delete comment text (including comments)
               when     ']]' is found, move to state 4             t5a
               when   '{[[}' is found, move to state 6             t5b
     state = 6; scan and delete program text (including comments)
               when   '{]]}' is found, move to state 0             t6a
  */
  long readpoint;   /* the point we are 'reading' in the buffer */
} ;

Local Void fillback(back, LINK)
long back;
struct LOC_themain *LINK;
{
  /* fill the buffer back several spots up to the current spot */
  long spot;   /* a point on the buffer */
  long FORLIM;

  if (LINK->debugging) {
    writestring(LINK->outfile, &LINK->idline);
    fprintf(LINK->outfile->f, "|\n");
  }
  FORLIM = LINK->readpoint;
  for (spot = LINK->readpoint - back - 1; spot < FORLIM; spot++)
    LINK->idline.letters[spot] = tocharacter(LINK->state);
}


/* end module censor.writeedit */

/* begin module censor.themain */
Static Void themain(infile, outfile_)
_TEXT *infile, *outfile_;
{
  /* the main procedure of the program.  NOTE: '@' represents '*' in comments
below. */
  struct LOC_themain V;
  string buffer;   /* buffer of a line from infile */
  Char c;   /* a character from the buffer */
  boolean gotten;   /* if true, a line was obtained */
  trigger t0a, t0b, t1a, t1b, t2a, t2b, t3a, t4a, t4b, t5a, t5b, t6a;
      /* triggers for each state */

  V.outfile = outfile_;
  V.debugging = false;   /* set to true if debugging */
  V.state = 0;
  /*    123456789- */

  filltrigger(&t0a, "(*        ");
  filltrigger(&t0b, "{         ");
  filltrigger(&t1a, "*)        ");
  filltrigger(&t1b, "[[        ");
  filltrigger(&t2a, "(*[[*)    ");
  filltrigger(&t2b, "]]        ");
  filltrigger(&t3a, "(*]]*)    ");
  filltrigger(&t4a, "}         ");
  filltrigger(&t4b, "[[        ");
  filltrigger(&t5a, "]]        ");
  filltrigger(&t5b, "{[[}      ");
  filltrigger(&t6a, "{]]}      ");

  while (!BUFEOF(infile->f)) {
    getstring(infile, &buffer, &gotten);
    if (!gotten)
      continue;
    if (V.debugging) {
      writestring(V.outfile, &buffer);
      putc('\n', V.outfile->f);
    }
    clearstring(&V.idline);

    resettrigger(&t0a);
    resettrigger(&t0b);
    resettrigger(&t1a);
    resettrigger(&t1b);
    resettrigger(&t2a);
    resettrigger(&t2b);
    resettrigger(&t3a);
    resettrigger(&t4a);
    resettrigger(&t4b);
    resettrigger(&t5a);
    resettrigger(&t5b);
    resettrigger(&t6a);

    V.idline.length = buffer.length;
    for (V.readpoint = 1; V.readpoint <= buffer.length; V.readpoint++) {
      V.idline.letters[V.readpoint-1] = tocharacter(V.state);
      c = buffer.letters[V.readpoint-1];

      testfortrigger(c, &t0a);
      testfortrigger(c, &t0b);
      testfortrigger(c, &t1a);
      testfortrigger(c, &t1b);
      testfortrigger(c, &t2a);
      testfortrigger(c, &t2b);
      testfortrigger(c, &t3a);
      testfortrigger(c, &t4a);
      testfortrigger(c, &t4b);
      testfortrigger(c, &t5a);
      testfortrigger(c, &t5b);
      testfortrigger(c, &t6a);

      switch (V.state) {

      case 0:
	if (t0a.found) {
	  V.state = 1;
	  fillback(1L, &V);
	} else if (t0b.found) {
	  V.state = 4;
	  fillback(0L, &V);
	}
	break;

      case 1:
	if (t1a.found)
	  V.state = 0;
	else if (t1b.found) {
	  V.state = 2;
	  fillback(1L, &V);
	}
	break;

      case 2:
	if (t2a.found) {
	  V.state = 3;
	  fillback(5L, &V);
	} else if (t2b.found)
	  V.state = 1;
	break;

      case 3:
	if (t3a.found)
	  V.state = 0;
	break;

      case 4:
	if (t4a.found)
	  V.state = 0;
	else if (t4b.found) {
	  V.state = 5;
	  fillback(1L, &V);
	}
	break;

      case 5:
	if (t5a.found)
	  V.state = 4;
	else if (t5b.found) {
	  V.state = 6;
	  fillback(3L, &V);
	}
	break;

      case 6:
	if (t6a.found)
	  V.state = 0;
	break;
      }

    }
    if (V.debugging) {
      writestring(V.outfile, &V.idline);
      fprintf(V.outfile->f, "|\n");
    }
    writeedit(V.outfile, V.state, buffer, V.idline);
  }
}


/* end module censor.themain */

main(argc, argv)
int argc;
Char *argv[];
{
  _TEXT TEMP, TEMP1;

  PASCAL_MAIN(argc, argv);
  if (setjmp(_JL1))
    goto _L1;
  TEMP.f = stdin;
  *TEMP.name = '\0';
  TEMP1.f = stdout;
  *TEMP1.name = '\0';
  themain(&TEMP, &TEMP1);
_L1:
  exit(EXIT_SUCCESS);
}



/* End. */