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


#include <p2c/p2c.h>


/* htmlink: insert html links to program references in a file

  Dr. Thomas D. Schneider
  National Cancer Institute
  Laboratory of Experimental and Computational Biology
  Frederick, Maryland  21702-1201
  toms@ncifcrf.gov
  permanent email: toms@alum.mit.edu (use only if first address fails)
  http://www.lecb.ncifcrf.gov/~toms/

 */

/* end of program */

/* begin module version */

#define version         1.51
/* of htmlink.p 2004 Jul 29
2004 Jul 29: 1.48: update url for gpc
2004 Jul 29: 1.47: use strong
1.46; 2000 Oct 24: implement ftp://
1.40; 2000 Jul 16: implement links for images: .gif and .jpg
1.39; 2000 Jul 15: "see also" only recognized at start of line!!
1.36; 2000 Jun 20: make {} comment marks go away on the html page.
1.35; 2000 Jan 10: fix bug in final pointer at page bottom
1.28; 2000 Jan  3: upgrade to recognize http links, clean up and do {}.
1.27; 1998 Mar 30: previous changes
origin 1995 March 10 */
/* end module version */

/* begin module describe.htmlink */
/*
name

   htmlink: insert html links to program references in a file

synopsis

   htmlink(input: in, htmlinkp: in, list: out, output: out)

files

   input:  a delila module or other file containing references
      to programs in the form *.p and references to other files between
      the key words "see also" and "author".

      Comments: the material contained within curlie brackets, "{" and "}",
      will not be processed into hyper links.  To create one of these
      characters, put a backslash "\" in front of it.

      The key words "see also" and "author" MUST be at the beginning of the
      line.  This allows one to say "see also" in the middle of other
      descriptions.  This is not a harsh restriction, since everything is
      indented as a standard anyway!

   htmlinkp:  A parameter file that defines:

      first line:  the ARCHIVE where files other
         than programs should be linked to.

      second line:  font size for the output.

   list: a list of the files being linked to.

   output: the same file with the *.p converted to references to *.html, and
      the other references converted to hypertext links to
      ARCHIVE/reference.  To prevent weird links from being made, this only
      occurs between the lines 'see also' and 'author', when these key words
      are at the start of the line.

      New as of 2000 Jan 3: names that begin with http:// are presented as
      straight html links.

      New as of 2000 Oct 24: names that begin with ftp:// are presented as
      straight html links.

description

   This program allows one to convert the delila manual pages to hypertext
   linked objects.

   The program copies the input to the output, and only modifies the region
   between key words 'see also' and 'author' when these are left justified on
   the line.  This defines the standard place that Delila documentation
   points to other files.

   Pascal programs ending in ".p" are made into the form:

   [A HREF ="doodle.html"]doodle.p[/A]

   (where the program is 'doodle.p and I have replaced "less than" with "["
   and "greater than" with "]" to prevent the browser from interpreting
   this as a link.) so that they will point to other programs
   in the same directory, while other files are made into the form:

   [A HREF ="ARCHIVE/xyplop"]xyplop[/A]

   where ARCHIVE is a string read in from the htmlinkp parameter file and the
   file is "xyplop".

   The program is used by the shell script "dth" (delila to html).

examples

   Below is the material in the "see also" section.  After processing, you
   will see that the text looks the same except that things outside the
   curlie braces are hyperlinked.

{\{ left curlie}
{ \{ left curlie}
{ { left curlie}
{\} right curlie}
{ \} right curlie}
{ \} right curlie}
{ \ escape}
{ \\ escape}
{ \\\ escape}

   {Some programs that use this processing:}
   alist.p
   delila.p

   {A general hyperlink is demonstrated by my home page which is
   at} http://www.lecb.ncifcrf.gov/~toms/

   {The mechanism even allows images!}
   http://www.lecb.ncifcrf.gov/~toms/icons/tinygumball.gif

   {An ftp hyperlink to the a script for running the Gnu Pascal Compiler:}
   ftp://ftp.ncifcrf.gov/pub/delila/gpcc
   {(The GNU Pascal Compiler is at}
   http://www.gnu-pascal.de/gpc/h-index.html{)}

documentation

see also
   dth

   {Here is the processing of the examples above.}
{\{ left curlie}
{ \{ left curlie}
{ { left curlie}
{\} right curlie}
{ \} right curlie}
{ \} right curlie}
{ \ escape}
{ \\ escape}
{ \\\ escape}

   {Some programs that use this processing:}
   alist.p
   delila.p

   {A general hyperlink is demonstrated by my home page which is
   at} http://www.lecb.ncifcrf.gov/~toms/

   {The mechanism even allows images!}
   http://www.lecb.ncifcrf.gov/~toms/icons/tinygumball.gif

   {An ftp hyperlink to the a script for running the Gnu Pascal Compiler:}
   ftp://ftp.ncifcrf.gov/pub/delila/gpcc
   {(The GNU Pascal Compiler is at}
   http://www.gnu-pascal.de/gpc/h-index.html{)}

author
   Thomas Dana Schneider

bugs

   The triggers "see also" and "author" and their positions on the line
   should be generalized to allow the program to process any text.  This
   would not be hard since it would only require new parameters being read
   in.

technical notes

  Note:  this program surrounds the file with [PRE] and [/PRE].

*/
/* end module describe.htmlink */

/* more constants */

#define maxline         100   /* longest line allowed */
#define fontsize        2   /* size of fonts */

/* begin module interact.const */
#define maxstring       150   /* the maximum string */
/* end module interact.const version = 4.15; (@ of prgmod.p 1994 November 12 */

/* begin module filler.const */
#define fillermax       50   /* the size of the filler array for a string */


/* end module filler.const version = 4.15; (@ of prgmod.p 1994 November 12 */


/* 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.15; (@ of prgmod.p 1994 November 12 */

/* 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.15; (@ of prgmod.p 1994 November 12 */

/* 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.15; (@ of prgmod.p 1994 November 12 */


/* begin module const.htmlink */
Static _TEXT htmlinkp;   /* parameters to control the program */
Static _TEXT list;   /* list of files linked to */


Static jmp_buf _JL1;


/* end module const.htmlink */

/* begin module halt */
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.15; (@ of prgmod.p 1994 November 12 */

/* 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.15; (@ of prgmod.p 1994 November 12 */

/* 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.15; (@ of prgmod.p 1994 November 12 */

/* 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.15; (@ of prgmod.p 1994 November 12 */
/* 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.15; (@ of prgmod.p 1994 November 12 */

/* 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.15; (@ of prgmod.p 1994 November 12 */

/* 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.15; (@ of prgmod.p 1994 November 12 */

/* begin module htmlink.writealine */
Static Void writealine(fout, aline, start, stop, escape)
_TEXT *fout;
string aline;
long start, stop;
Char escape;
{
  /* write the aline string to fout from start to stop.  Do not show
escape symbols. */
  Char c = ' ';   /* a character in aline */
  long i;   /* index to aline */
  Char p;   /* the character before c */

  for (i = start - 1; i < stop; i++) {
    p = c;
    c = aline.letters[i];
    if (p == escape)
      putc(c, fout->f);
    else if (c != escape && p != escape) {
      putc(c, fout->f);
      /*
           if (c <> escape) and (p <> escape)
           then write(fout,c);
      */
    }
  }
}


#define escape          '\\'
    /* the character that prevents processing of { or } */


/* end module htmlink.writealine */

/* begin module htmlink.themain */
Static Void themain(htmlinkp, list)
_TEXT *htmlinkp, *list;
{
  /* the main procedure of the program */
  string ARCHIVE;   /* the location of other files */
  string aline;   /* a line of text */
  Char c;   /* a character being processed */
  boolean comment = false;   /* true when inside a comment */
  boolean insidecomment;
  /* previous stuff put us inside a comment,
     so if we see a \{ or \} these should be SHOWN. */
  Char cprevious;   /* the character before c */
  boolean done;   /* done parsing a link? */
  long l;   /* current position in the buffer, and its length */
  long fontsize_;   /* html font size */
  boolean gotten;   /* was htmlinkp readable? */
  long follow;   /* index to b that follows behind i */
  long i;   /* index to b */
  boolean image;   /* true when the link should be an image */
  boolean linkprocess = false;
      /* true only when we want to process a link */
  long seealsocount = 0;
  /* count of 'see also's to prevent more than
     the first in the file from being used */
  boolean potentiate = false;
  /* becomes true when we want to process a link.
     We don't want to process on the same line that "see also" is because
     then "see also" becomes part of the html rather than the copied
     material.  So we hold off (by using this variable) one line
     before turning linkproces on. */
  boolean pureurl;   /* is this a pure url and not an archive link? */

  trigger seealso;   /* trigger for "see also" */
  trigger author;   /* trigger for "author" */
  trigger http;   /* trigger for "http" */
  trigger ftp;   /* trigger for "ftp" */
  trigger gif;   /* trigger for ".gif" */
  trigger jpg;   /* trigger for ".jpg" */
  _TEXT TEMP;

  /* set up the triggers */
  /*                             1         2         3         4         5 */
  /*                    12345678901234567890123456789012345678901234567890 */
  filltrigger(&seealso, "see also                                          ");
  filltrigger(&author, "author                                            ");
  filltrigger(&http, "http://                                           ");
  filltrigger(&ftp, "ftp://                                            ");
  filltrigger(&gif, ".gif                                              ");
  filltrigger(&jpg, ".jpg                                              ");

  if (*htmlinkp->name != '\0') {
    if (htmlinkp->f != NULL)
      htmlinkp->f = freopen(htmlinkp->name, "r", htmlinkp->f);
    else
      htmlinkp->f = fopen(htmlinkp->name, "r");
  } else
    rewind(htmlinkp->f);
  if (htmlinkp->f == NULL)
    _EscIO2(FileNotFound, htmlinkp->name);
  RESETBUF(htmlinkp->f, Char);
  getstring(htmlinkp, &ARCHIVE, &gotten);
  /*
     if not gotten then begin
        writeln(output,'ARCHIVE pointer is empty because htmlinkp is empty');
        halt
     end;
  */
  fscanf(htmlinkp->f, "%ld%*[^\n]", &fontsize_);
  getc(htmlinkp->f);

  if (*list->name != '\0') {
    if (list->f != NULL)
      list->f = freopen(list->name, "w", list->f);
    else
      list->f = fopen(list->name, "w");
  } else {
    if (list->f != NULL)
      rewind(list->f);
    else
      list->f = tmpfile();
  }
  if (list->f == NULL)
    _EscIO2(FileNotFound, list->name);
  SETUPBUF(list->f, Char);
  printf("<!-- htmlink %4.2f -->\n", version);
  printf("<font size = %ld>\n", fontsize_);
  printf("<strong>\n");
  printf("<PRE>\n");

  clearstring(&aline);
  while (!P_eof(stdin)) {
    TEMP.f = stdin;
    *TEMP.name = '\0';
    /* read in a line of text */
    getstring(&TEMP, &aline, &gotten);
    if (!gotten) {
      printf("htmlink: program error?\n");
      halt();
    }

    resettrigger(&seealso);
    resettrigger(&author);
    for (l = 1; l <= aline.length; l++) {
      c = aline.letters[l-1];

      testfortrigger(c, &seealso);
      if (l == 8) {  /* "see also" is 8 characters long */
	if (seealso.found) {
	  seealsocount++;
	  if (seealsocount == 1)
	    potentiate = true;
	}
      }

      testfortrigger(c, &author);
      if (l == 6) {  /* "author" is 8 characters long */
	if (author.found) {
	  linkprocess = false;
	  potentiate = false;
	}
      }
    }

    if (linkprocess) {  /* process the link section */
      /* parse out the named objects on one line */
      follow = 1;

      pureurl = false;
      c = ' ';
      while (follow <= aline.length) {
	/*
writeln(output,'l=',follow:1);
*/
	cprevious = c;
	c = aline.letters[follow-1];
	insidecomment = (comment == true);
	if (c == '{')
	  comment = true;
	if (cprevious != escape && c == '}')
	  comment = false;
	if (c == ' ')
	  putchar(' ');
	if (c == ' ')
	  putc(' ', list->f);
	if (insidecomment && cprevious == escape) {
	  /*
	              if cprevious = escape then begin
	  */
	  if (c == '{')
	    putchar('{');
	  if (c == '{')
	    putc('{', list->f);
	  if (c == '}')
	    putchar('}');
	  if (c == '}')
	    putc('}', list->f);
	}

	if (c != ' ' && c != ',' && c != '{' && c != '}') {
	  /* parse */
	  resettrigger(&http);
	  resettrigger(&ftp);
	  resettrigger(&gif);
	  resettrigger(&jpg);
	  image = false;
	  l = follow;
	  /*
writeln(output); write(output,'parsed string: "');
*/
	  done = false;
	  while (!done) {
	    testfortrigger(aline.letters[l-1], &http);
	    if (http.found)
	      pureurl = true;

	    testfortrigger(aline.letters[l-1], &ftp);
	    if (ftp.found)
	      pureurl = true;

	    testfortrigger(aline.letters[l-1], &gif);
	    if (gif.found)
	      image = true;

	    testfortrigger(aline.letters[l-1], &jpg);
	    if (jpg.found)
	      image = true;

	    /*
write(output,aline.letters[l]);
*/

	    if (l == aline.length) {
	      done = true;
	      break;
	    }
	    l++;
	    if (aline.letters[l-1] == ' ' || aline.letters[l-1] == ',' ||
		aline.letters[l-1] == '}' || aline.letters[l-1] == '{') {
	      done = true;
	      l--;   /* don't include that */
	    }
	  }
	  /*
writeln(output,'"');
*/

	  if (comment) {
	    TEMP.f = stdout;
	    *TEMP.name = '\0';
	    writealine(&TEMP, aline, follow, l, escape);
	    writealine(list, aline, follow, l, escape);
	  } else {
	    /* if we just found *.p, write it out as HTML */
	    if (aline.letters[l-2] == '.' && aline.letters[l-1] == 'p') {
	      printf("<A HREF =\"");
	      for (i = follow - 1; i <= l - 2; i++)
		putchar(aline.letters[i]);
	      printf("html\">");   /* replaces .p with .html */
	      for (i = follow - 1; i < l; i++)
		putchar(aline.letters[i]);
	      printf("</A>");
	      for (i = follow - 1; i < l; i++)
		putc(aline.letters[i], list->f);
	    }

	    else {
	      if (image)
		printf("<IMG SRC =\"");
	      else
		printf("<A HREF =\"");

	      if (!pureurl) {
		TEMP.f = stdout;
		*TEMP.name = '\0';
		writestring(&TEMP, &ARCHIVE);
	      }
	      for (i = follow - 1; i < l; i++)
		putchar(aline.letters[i]);
	      printf("\">");

	      if (!image) {
		/* complete the link by giving it again: */
		for (i = follow - 1; i < l; i++)
		  putchar(aline.letters[i]);
		printf("</A>");
	      }

	      for (i = follow - 1; i < l; i++) {
		putc(aline.letters[i], list->f);

	      }

	    }
	  }

	  follow = l;   /* step parsing forward across the word */
	}
	if (c == ',')
	  putchar(',');
	follow++;

      }


      putchar('\n');
      putc('\n', list->f);
    }

    else {
      TEMP.f = stdout;
      *TEMP.name = '\0';
      writestring(&TEMP, &aline);
      putchar('\n');
    }
    /* just copy the line */

    /* this line had a "see also" so process the next line */
    if (potentiate)
      linkprocess = true;

  }


  printf("</PRE>\n");
  printf("</strong>\n");
  printf("{<a href = \"htmlink.html\">created by htmlink %4.2f</a>}\n",
	 version);
}

#undef escape


/* end module htmlink.themain */

main(argc, argv)
int argc;
Char *argv[];
{
  PASCAL_MAIN(argc, argv);
  if (setjmp(_JL1))
    goto _L1;
  list.f = NULL;
  strcpy(list.name, "list");
  htmlinkp.f = NULL;
  strcpy(htmlinkp.name, "htmlinkp");
  themain(&htmlinkp, &list);
_L1:
  if (htmlinkp.f != NULL)
    fclose(htmlinkp.f);
  if (list.f != NULL)
    fclose(list.f);
  exit(EXIT_SUCCESS);
}



/* End. */