/* parser.c: -*- C -*-  Parser internals for the page processor. */

/* Author: Brian J. Fox (bfox@ai.mit.edu) Mon Oct 14 14:22:35 1996.

   This file is part of <Meta-HTML>(tm), a system for the rapid deployment
   of Internet and Intranet applications via the use of the Meta-HTML
   language.

   Copyright (c) 1995, 1996, Brian J. Fox (bfox@ai.mit.edu).
   Copyright (c) 1996, Universal Access Inc. (http://www.ua.com).

   Meta-HTML is free software; you can redistribute it and/or modify
   it under the terms of the UAI Free Software License as published
   by Universal Access Inc.; either version 1, or (at your option) any
   later version.

   This program is distributed in the hope that it will be useful,
   but WITHOUT ANY WARRANTY; without even the implied warranty of
   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   UAI Free Software License for more details.

   You should have received a copy of the UAI Free Software License
   along with this program; if you have not, you may obtain one by
   writing to:

   Universal Access Inc.
   129 El Paseo Court
   Santa Barbara, CA
   93101  */

#define COMPILING_PARSER_C 1
#include "language.h"


extern void initialize_external_functions (Package *p);

char *metahtml_copyright_string = "\
Copyright (C) 1995, 1996, Brian J. Fox\n\
Copyright (C) 1996, 1997 Universal Access Inc.";

/* Globally known variable holds onto to the reserved words. */
Package *mhtml_function_package = (Package *)NULL;

/* Macro writing and processing. */
Package *mhtml_user_keywords = (Package *)NULL;

/* The "DEFAULT" package. */
Package *PageVars = (Package *)NULL;

/* Special case code can throw out from multiple levels deep in order to
   immediately return some HTTP.  You should call the following function
   page_return_this_page (page) in order to make that happen. */
static PAGE *ImmediatePage = (PAGE *)NULL;
jmp_buf page_jmp_buffer;

void
page_return_this_page (PAGE *page)
{
  ImmediatePage = page_copy_page (page);
  longjmp (page_jmp_buffer, 1);
}

/* Sequentialy process PAGE. */
static PAGE *ThePage = (PAGE *)NULL;
static int TheOffset = 0;

PageEnv *
pagefunc_save_environment (void)
{
  PageEnv *env = (PageEnv *)xmalloc (sizeof (PageEnv));

  memcpy (&(env->env), &page_jmp_buffer, sizeof (jmp_buf));
  env->page = ThePage;
  env->offset = TheOffset;

  return (env);
}

void
pagefunc_restore_environment (PageEnv *env)
{
  memcpy (&page_jmp_buffer, &(env->env), sizeof (jmp_buf));
  ThePage = env->page;
  TheOffset = env->offset;

  free (env);
}

/* Gets 1 when mhtml::inhibit-comment-parsing has a value, 0 otherwise. */
int mhtml_inhibit_comment_parsing = 0;

/* Gets 1 when mhtml::decimal-places has a value, 0 otherwise. */
int mhtml_decimal_notify = 0;
int mhtml_decimal_places = 2;

/* Gets 1 when mhtml::parser-trace-mode has a value, 0 otherwise. */
int mhtml_parser_trace_mode = 0;

void
pagefunc_initialize_notifiers (void)
{
  Symbol *sym;

  sym = symbol_intern ("mhtml::inhibit-comment-parsing");
  symbol_notify_value (sym, &mhtml_inhibit_comment_parsing);
  sym = symbol_intern ("mhtml::decimal-places");
  symbol_notify_value (sym, &mhtml_decimal_notify);
  sym = symbol_intern ("mhtml::parser-trace-mode");
  symbol_notify_value (sym, &mhtml_parser_trace_mode);
}

static int syntax_checking = 0;
static int syntax_failure = 0;

int
page_check_syntax (PAGE *page)
{
  int syntax_ok;

  syntax_checking = 1;
  syntax_failure = 0;
  page_process_page_internal (page);
  syntax_ok = !syntax_failure;
  syntax_checking = 0;
  syntax_failure = 0;
  return (syntax_ok);
}

void
page_process_page (volatile PAGE *page)
{
  static int notifiers_initialized = 0;

  if (!notifiers_initialized)
    {
      pagefunc_initialize_notifiers ();
      notifiers_initialized++;
    }
  else
    {
      forms_gc_pointers ();
    }

  ImmediatePage = (PAGE *)NULL;
  ThePage = (PAGE *)page;
  TheOffset = 0;

  /* The ugliest hack in the world.  Please shoot me. */
  if (setjmp (page_jmp_buffer) != 0)
    {
      page->buffer = ImmediatePage->buffer;
      page->bindex = ImmediatePage->bindex;
      page->bsize  = ImmediatePage->bsize;
    }
  else
    page_process_page_internal ((PAGE *)page);
}

/* For internal use only.  Returns the zeroith value element for
   NAME in PACKAGE. */
char *
get_value (Package *package, char *name)
{
  char *value = (char *)NULL;

  if (package != (Package *)NULL)
    {
      Symbol *sym = symbol_lookup_in_package (package, name);

      if (sym && sym->values_index)
	value = sym->values[0];
    }
  return (value);
}

/* Return the values list of *pvars* in PACKAGE. */
char **
get_vars_names (Package *package)
{
  char **names = (char **)NULL;

  if (package != (Package *)NULL)
    {
      Symbol *sym = symbol_lookup_in_package (package, "*pvars*");

      if (sym != (Symbol *)NULL)
	names = sym->values;
    }

  return (names);
}

/* Return the values list of *pvals* in PACKAGE. */
char **
get_vars_vals (Package *package)
{
  char **vals = (char **)NULL;

  if (package != (Package *)NULL)
    {
      Symbol *sym = symbol_lookup_in_package (package, "*pvals*");

      if (sym != (Symbol *)NULL)
	vals = sym->values;
    }

  return (vals);
}

void
pagefunc_set_variable (char *tag, char *value)
{
  Package *orig_package = CurrentPackage;

  if (PageVars == (Package *)NULL)
    PageVars = symbol_get_package (DEFAULT_PACKAGE_NAME);

  if (CurrentPackage == (Package *)NULL)
    symbol_set_default_package (PageVars);

  forms_set_tag_value (tag, value);
  symbol_set_default_package (orig_package);
}

void
pagefunc_set_variable_readonly (char *tag, char *value)
{
  Package *orig_package = CurrentPackage;
  Symbol *sym;

  if (PageVars == (Package *)NULL)
    PageVars = symbol_get_package (DEFAULT_PACKAGE_NAME);

  if (CurrentPackage == (Package *)NULL)
    symbol_set_default_package (PageVars);

  forms_set_tag_value (tag, value);
  sym = symbol_lookup (tag);
  if (sym != (Symbol *)NULL)
    symbol_set_flag (sym, sym_READONLY);

  symbol_set_default_package (orig_package);
}

char *
pagefunc_get_variable (char *tag)
{
  Package *orig_package = CurrentPackage;
  char *value;

  if (PageVars == (Package *)NULL)
    PageVars = symbol_get_package ("default");

  if (CurrentPackage == (Package *)NULL)
    symbol_set_default_package (PageVars);

  value = forms_get_tag_value (tag);

  symbol_set_default_package (orig_package);
  return (value);
}

char *
get_one_of (Package *package, char *tag, ...)
{
  char *value = (char *)NULL;
  va_list args;

  va_start (args, tag);

  while (tag)
    {
      value = forms_get_tag_value_in_package (package, tag);

      if (value)
	break;

      tag = va_arg (args, char *);
    }

  va_end (args);
  return (value);
}

char *
get_positional_arg (Package *package, int position)
{
  char *result = (char *)NULL;
  int pos = 0;

  if (package != (Package *)NULL)
    {
      Symbol *pvars = symbol_lookup_in_package (package, "*pvars*");

      if (pvars != (Symbol *)NULL)
	{
	  register int i;
	  Symbol *sym;

	  for (i = 0; i < pvars->values_index; i++)
	    {
	      sym = symbol_lookup_in_package (package, pvars->values[i]);

	      if ((sym != (Symbol *)NULL) && (sym->values_index == 0))
		{
		  if (position == pos)
		    {
		      result = pvars->values[i];
		      break;
		    }
		  else
		    pos++;
		}
	    }
	}
    }
  return (result);
}

char *
read_sexp_1 (char *string, int *start, int stop_at_equals_p, int one_list)
{
  static char *workspace = (char *)NULL;
  static int wsize = 0;
  int expr_present = 0;
  char *result = (char *)NULL;

  if (string != (char *)NULL)
    {
      register int i = *start;
      register int string_len = strlen (string);
      int windex, gobbled, quoted, depth;

      windex = gobbled = quoted = depth = 0;

      if (string_len >= wsize)
	workspace = (char *)xrealloc (workspace, (wsize = 10 + string_len));

      workspace[0] = '\0';

      /* Skip leading whitespace. */
      while (whitespace (string[i])) i++;

      gobbled = 0;
      while (!gobbled)
	{
	  register int c = string[i++];

	  switch (c)
	    {
	    case '\\':
	      c = string[i++];

	      if (depth == 0)
		{
		  switch (c)
		    {
		    case 'n':
		      workspace[windex++] = '\n';
		      break;

		    case 't':
		      workspace[windex++] = '\t';
		      break;

		    case 'r':
		      workspace[windex++] = '\r';
		      break;

		    case 'f':
		      workspace[windex++] = '\f';
		      break;

		    case '\0':
		      workspace[windex] = '\\';
		      gobbled++;
		      break;

		    default:
		      workspace[windex++] = c;
		      break;
		    }
		}
	      else
		{
		  /* Skip the backslash, and the character which follows it.
		     We have to do this for the case of bizarre constructs,
		     such as <get-var <get-var \>>>. */
		  if (c != '\0')
		    {
		      workspace[windex++] = '\\';
		      workspace[windex++] = c;
		    }
		  else
		    {
		      workspace[windex] = '\\';
		      gobbled++;
		    }
		}
	      break;

	    case '<':
	      workspace[windex++] = '<';
	      if (!quoted)
		depth++;
	      break;

	    case '>':
	      workspace[windex++] = '>';
	      if (!quoted)
		{
		  depth--;
		  if (one_list && (depth == 0))
		    {
		      workspace[windex] = '\0';
		      gobbled++;
		    }
		}
	      break;

	    case '"':
	      quoted = !quoted;
	      if (depth)
		workspace[windex++] = '"';
	      else
		expr_present++;
	      break;

	    case '\r':
	      if (string[i] == '\n')
		{
		  if (!quoted && depth <= 0)
		    {
		      i++;
		      workspace[windex] = '\0';
		    }
		  else
		    workspace[windex] = c;
		}
	      break;

	    case ';':
	      if ((string[i] == ';') && (string[i + 1] == ';') && !quoted)
		{
		  i += 2;
		  while ((string[i] != '\0') && (string[i] != '\n')) i++;
		}
	      else
		workspace[windex++] = c;
	      break;

	    case ' ':
	    case '\t':
	    case '\n':
	      if (!quoted && depth <= 0)
		{
		  workspace[windex] = '\0';
		  gobbled++;
		}
	      else
		workspace[windex++] = c;
	      break;

	    case '=':
	      if (stop_at_equals_p && !quoted && depth <= 0)
		{
		  workspace[windex] = '\0';
		  gobbled++;
		  i--;
		}
	      else
		workspace[windex++] = c;
	      break;

	    case '\0':
	      workspace[windex] = '\0';
	      gobbled++;
	      i--;
	      break;

	    default:
	      workspace[windex++] = c;
	      break;
	    }
	}

      if (windex || expr_present)
	result = strdup (workspace);

      *start = i;
    }

  return (result);
}

char *
read_sexp (char *string, int *start, int stop_at_equals_p)
{
  return (read_sexp_1 (string, start, stop_at_equals_p, 0));
}

/* If you want to delete a package, you should probably call this function
   rather than calling symbol_destroy_package () from symbols.c.  This 
   allows the engine to reset a bunch of internal variables if necessary. */
void
pagefunc_destroy_package (char *package_name)
{
  Package *package = symbol_lookup_package (package_name);

  if (package != (Package *)NULL)
    {
      if (package == PageVars)
	PageVars = (Package *)NULL;
      else if (package == mhtml_function_package)
	mhtml_function_package = (Package *)NULL;
      else if (package == mhtml_user_keywords)
	mhtml_user_keywords = (Package *)NULL;

      symbol_destroy_package (package);
    }
}

/* Gather arguments from STRING and return a newly consed anonymous package
   containing those arguments.  If second arg ALLOW_ASSIGNMENTS_P is non-zero,
   allow equals signs to indicate keyword values. */
Package *
pagefunc_snarf_vars (char *string, int allow_assignments_p)
{
  Package *package = (Package *)NULL;
  int offset = 0;
  int string_len;

  if (string == (char *)NULL)
    return (package);
  else
    string_len = strlen (string);

  /* Gobble name and value pairs. */
  while (offset < string_len)
    {
      char *name = (char *)NULL;
      char *value = (char *)NULL;

      name = read_sexp (string, &offset, allow_assignments_p);

      /* Skip any whitespace between the name and the '='
	 starting the value. */
      while (whitespace (string[offset])) offset++;

      /* If there is an equals sign here, get the value string. */
      if (string[offset] == '=')
	{
	  offset++;
	  if (name)
	    value = read_sexp (string, &offset, 0);
	}

      if (!name)
	continue;

      /* Add this pair to our list. */
      if (package == (Package *)NULL)
	package = symbol_get_package ((char *)NULL);

      if (value == (char *)NULL)
	symbol_intern_in_package (package, name);
      else
	forms_set_tag_value_in_package (package, name, value);

      /* Add the name and value to the list of ordered variables. */
      {
	Symbol *symbol = symbol_intern_in_package (package, "*pvars*");
	symbol_add_value (symbol, name);
	symbol = symbol_intern_in_package (package, "*pvals*");
	symbol_add_value (symbol, value ? value : "");
      }

      free (name);
      if (value) free (value);
    }

  return (package);
}

/* Return the primitive descriptor for TAG, or NULL if there is none. */
PFunDesc *
pagefunc_get_descriptor (char *tag)
{
  PFunDesc *desc = (PFunDesc *)NULL;
  Symbol *sym;

  if (mhtml_function_package == (Package *)NULL)
    {
      mhtml_function_package = symbol_get_package ("*meta-html*");
      initialize_external_functions (mhtml_function_package);
    }

  sym = symbol_lookup_in_package (mhtml_function_package, tag);

  if (sym != (Symbol *)NULL)
    desc = (PFunDesc *)(sym->values);

  return (desc);
}

/* Return non-zero if STRING is non-zero or all whitespace. */
int
empty_string_p (char *string)
{
  int result = 1;

  if (string != (char *)NULL)
    {
      while (whitespace (*string)) string++;

      if (*string != '\0')
	result = 0;
    }

  return (result);
}

/* Read STRING, and convert the contents to a list of variables in PACKAGE. */
Package *
alist_to_package (char *string)
{
  WispObject *list = wisp_from_string (string);
  Package *package = (Package *)NULL;

  if (!CONS_P (list))
    return (package);

  while (list != NIL)
    {
      WispObject *pair;

      pair = CAR (list);
      list = CDR (list);

      if (CONS_P (pair) & STRING_P (CAR (pair)))
	{
	  char *tag;
	  Symbol *sym;

	  tag = STRING_VALUE (CAR (pair));

	  if (!package)
	    {
	      int old_prime = symbol_small_prime;
	      symbol_small_prime = 23;
	      package = symbol_get_package ((char *)NULL);
	      symbol_small_prime = old_prime;
	    }

	  if (STRING_P (CDR (pair)))
	    {
	      sym = symbol_intern_in_package (package, tag);
	      symbol_add_value (sym, STRING_VALUE (CDR (pair)));
	    }
	  else
	    {
	      WispObject *values = CDR (pair);

	      sym = symbol_intern_in_package (package, tag);

	      while (CONS_P (values) && STRING_P (CAR (values)))
		{
		  symbol_add_value (sym, STRING_VALUE (CAR (values)));
		  values = CDR (values);
		}
	    }
	}
    }
  gc_wisp_objects ();
  return (package);
}

/* Convert PACKAGE to an ASCII readable string -- an alist representing
   the contents of PACKAGE.  If STRIP is non-zero, the package name prefix
   is not prepended to each variable name in the alist, otherwise, the
   package name appears before each variable.  If PACKAGE is anonymous,
   no package name is associated with the variables. */
char *
package_to_alist (Package *package, int strip)
{
  char *result = (char *)NULL;
  Symbol **symbols = symbols_of_package (package);

  if (symbols != (Symbol **)NULL)
    {
      register int i;
      BPRINTF_BUFFER *buffer = bprintf_create_buffer ();
      char *packname = package->name;
      Symbol *sym;

      bprintf (buffer, "(");

      for (i = 0; (sym = symbols[i]) != (Symbol *)NULL; i++)
	{
	  static char *fullname = (char *)NULL;
	  static int fn_size = 0;
	  int name_len = package->name_len + sym->name_len + 3;
	  char *item_name;

	  if (name_len >= fn_size)
	    fullname = (char *)xrealloc (fullname, (fn_size = name_len + 20));

	  if (package->name_len && !strip)
	    sprintf (fullname, "%s::%s", packname, sym->name);
	  else
	    strcpy (fullname, sym->name);

	  item_name = strdup (wisp_readable (fullname));

	  switch (sym->values_index)
	    {
	    case 0:
	      bprintf (buffer, "(%s)", item_name);
	      break;

	    case 1:
	      bprintf (buffer, "(%s . %s)",
		       item_name, wisp_readable (sym->values[0]));
	      break;

	    default:
	      {
		register int j;

		bprintf (buffer, "(%s", item_name);
		for (j = 0; j < sym->values_index; j++)
		  bprintf (buffer, " %s", wisp_readable (sym->values[j]));
		bprintf (buffer, ")");
	      }
	    }
	  free (item_name);
	}

      free (symbols);
      bprintf (buffer, ")");
      result = buffer->buffer;
      free (buffer);
    }
  return (result);
}

static int parser_trace_indentation_counter = 0;

static char *
parser_trace_indentation (void)
{
  static char *blanks = (char *)NULL;
  static int blanks_size = 0;
  int indent_amount = 2 * parser_trace_indentation_counter;

  if (!indent_amount)
    return ("");

  if ((indent_amount + 2) > blanks_size)
    {
      register int i;

      blanks = (char *)xrealloc
	(blanks, (blanks_size += (indent_amount + 50)));
      for (i = 0; i < blanks_size; i++)
	blanks[i] = ' ';
      blanks[i] = '\0';
    }

  /* Return the end of the string. */
  return (blanks + (blanks_size - indent_amount));
}

/* Actually process PAGE in place.  The result of processing PAGE is placed
   within PAGE.  This is likely to change shortly, when we pre-parse the
   PAGE and write sequential output to a different destination. */
void
page_process_page_internal (PAGE *page)
{
  register int i, c;
  int search_start = 0;
  int done = 0;
  int semicolon_comments;
  static char *fname = (char *)NULL;
  static int fname_size = 0;

  if (page == (PAGE *)NULL)
    return;

  while (!done)
    {
      PFunDesc *desc = (PFunDesc *)NULL;
      static PFunDesc uf_desc;
      UserFunction *uf = (UserFunction *)NULL;

      semicolon_comments = !mhtml_inhibit_comment_parsing;

      for (i = search_start; i < page->bindex; i++)
	{
	  if (page->buffer[i] == '<')
	    break;

	  /* If there is a semicolon comment here, ignore it now. */
	  if (semicolon_comments && page->buffer[i] == ';')
	    {
	      if (((i + 2) < page->bindex) &&
		  (page->buffer[i + 1] == ';') &&
		  (page->buffer[i + 2] == ';'))
		{
		  int marker = i;
		  i += 3;
		  while (i < page->bindex &&
			 (!return_sequence (page->buffer[i],
					    page->buffer[i + 1])))
		    i++;
		  bprintf_delete_range (page, marker, i + 1);
		  i = marker - 1;
		}
	    }
	}

      if (i >= page->bindex)
	{
	  done = 1;
	  continue;
	}
      else
	{
	  int fname_beg;
	  int fname_end;
	  int fname_len;

	  search_start = i;
	  fname_beg = ++i;

	  for (; (c = page->buffer[i]) != '\0'; i++)
	    if ((c == ' ') || (c == '>') ||
		(c == '\t') || (c == '\r') ||
		(c == '\n'))
	      break;

	  if (!c)
	    {
	      search_start++;
	      continue;
	    }

	  fname_end = i;
	  fname_len = fname_end - fname_beg;

	  if (fname_len + 4 > fname_size)
	    fname = (char *)xrealloc (fname, fname_size += (20 + fname_len));

	  strncpy (fname, page->buffer + fname_beg, fname_len);
	  fname[fname_len] = '\0';

	  /* Look for a user-defined command before a static one. */
	  uf = mhtml_find_user_function (fname);
	  if (uf)
	    {
	      desc = &uf_desc;
	      desc->tag = uf->name;
	      if (uf->type == user_MACRO)
		{
		  if (uf->flags & user_WEAK_MACRO)
		    desc->complexp = -1;
		  else
		    desc->complexp = 1;
		}
	      else
		desc->complexp = 0;
	      desc->debug_level = uf->debug_level;
	      desc->fun = (PFunHandler *)NULL;
	    }

	  /* Find the description of this function, so we know how to find
	     it in the page. */
	  if (!desc)
	    desc = pagefunc_get_descriptor (fname);

	  if (!desc)
	    {
	      search_start++;
	      continue;
	    }
	  else
	    {
	      int start, end;
	      int found, complexp = desc->complexp;

	      start = search_start;

	      if (desc->complexp)
		{
		  int saved = start;
		  found = page_complex_tag_bounds (page, fname, &start, &end);

		  /* If a closer wasn't found, and this is a weak macro,
		     then treat this occurence as if the tag didn't
		     require a closer. */
		  if (!found && (desc->complexp == -1))
		    {
		      start = saved;
		      end = page_find_tag_end (page, start);
		      found = end != -1;
		      complexp = 0;
		    }
		}
	      else
		{
		  end = page_find_tag_end (page, start);
		  found = end != -1;
		}

	      if (!found)
		{
		  /* The MTHML programmer didn't close the opener correctly.
		     Tell them, and then ignore the text. */
		  page_debug ("Closing tag missing for <%s ...>", desc->tag);
		  if (syntax_checking)
		    {
		      syntax_failure = 1;
		      done = 1;
		    }
		  search_start += fname_len;
		  continue;
		}
	      else
		{
		  char *open_body = (char *)NULL;
		  char *strbody = (char *)NULL;
		  Package *vars = (Package *)NULL;
		  int open_start, open_end, open_body_len;

		  /* For simple and complex tags alike, we want to eat the
		     variables which appear in the opener. */
		  open_start = start;
		  if (complexp)
		    open_end = page_find_tag_end (page, start);
		  else
		    open_end = end;

		  open_body_len = open_end - open_start;
		  open_body = (char *)xmalloc (1 + open_body_len);
		  strncpy (open_body, page->buffer + start, open_body_len);
		  open_body[open_body_len] = '\0';

		  /* Kill the closing '>'. */
		  open_body[open_body_len - 1] = '\0';
		  memmove (open_body, open_body + 1 + fname_len,
			   (open_body_len - (1 + fname_len)));

		  vars = pagefunc_snarf_vars (open_body, uf ? 0 : 1);

		  if (!complexp)
		    {
		      if (!desc->complexp)
			strbody = open_body;
		      else
			strbody = strdup ("");
		    }
		  else
		    {
		      int open_len = open_end - open_start;
		      int body_len, body_end;
		      char *closer = (char *)xmalloc (3 + fname_len);

		      closer[0] = '<';
		      closer[1] = '/';
		      /* We'd like to copy the desc->tag, but if this is
			 a user-function that has been copy-var'd, they
			 may not be the same.  So use fname instead. */
#if 0
		      strcpy (closer + 2, desc->tag);
#else
		      strcpy (closer + 2, fname);
#endif

		      strbody = page_complex_tag_extract
			(page, fname, &open_start, &end);

		      /* Get rid of the opening tag. */
		      {
			int extra = 0;
			if ((strbody[open_len] == '\r') &&
			    (strbody[1 + open_len] == '\n'))
			  extra += 2;
			else if (strbody[open_len] == '\n')
			  extra++;

			memmove (strbody, strbody + open_len + extra,
				 (1 + strlen (strbody) - (open_len + extra)));
		      }

		      /* Get rid of the closing tag. */
		      body_len = strlen (strbody);
		      body_end = body_len - (1 + fname_len);

		      while (strncasecmp
			     (strbody + body_end, closer, 1 + fname_len) != 0)
			body_end--;

		      if (body_end > 0 && strbody[body_end - 1] == '\n')
			body_end--;

		      strbody[body_end] = '\0';
		      free (closer);
		    }

		  /* Call the handler function. */
		  if (syntax_checking)
		    {
		      search_start = end;
		    }
		  else
		    {
		      char *display_body = (char *)NULL;
		      PAGE *body;
		      body = page_create_page ();
		      page_set_contents (body, strbody);

		      /* This text is no longer in the page. */
#if defined (BREAK_SEMANTICS)
		      if (page->buffer[end + 1] == '\n')
			bprintf_delete_range (page, start, end + 1);
		      else
#endif
			bprintf_delete_range (page, start, end);

		      if (mhtml_parser_trace_mode || desc->debug_level > 5)
			{
			  display_body = strdup (open_body ? open_body : "");
			  if (strlen (display_body) > 33)
			    strcpy (display_body + 30, "...");

			  if (mhtml_parser_trace_mode)
			    page_debug ("%sEntering %s: <%s %s>",
					parser_trace_indentation (),
					desc->tag, desc->tag,
					mhtml_funargs (vars));
			  else
			    page_debug ("Entering <%s %s>",
					desc->tag, display_body);

			}

		      parser_trace_indentation_counter++;

		      if (uf)
			mhtml_execute_function
			  (uf, page, body, vars, start, end, &search_start,
			   desc->debug_level, open_body);
		      else
			(*desc->fun)
			  (page, body, vars, start, end, &search_start,
			   desc->debug_level);

		      if (search_start < 0)
			{
			  page_debug ("PPI: `%s' bashed SEARCH_START!",
				      desc->tag);
			  search_start = page->bindex;
			}

		      parser_trace_indentation_counter--;

		      if (mhtml_parser_trace_mode || desc->debug_level > 5)
			{
			  if (mhtml_parser_trace_mode)
			    page_debug ("%sLeaving %s: <%s %s>",
					parser_trace_indentation (),
					desc->tag, desc->tag,
					mhtml_funargs (vars));
			  else
			    page_debug ("Leaving <%s %s>",
					desc->tag, display_body);
			  free (display_body);
			}

		      page_free_page (body);
		    }

		  /* Free up the variables and the body. */
		  if (strbody != open_body) free (open_body);
		  symbol_destroy_package (vars);
		  free (strbody);
		}
	    }
	}
    }
}

/* Evaluate the string BODY in the current environment, returning the results
   as a newly consed string, or NULL if BODY was NULL. */
char *
mhtml_evaluate_string (char *body)
{
  PAGE *evaluated;
  char *result = (char *)NULL;
  int clear_whitespace_p = 0;

  if (!body)
    return ((char *)NULL);

  evaluated = page_create_page ();
  page_set_contents (evaluated, body);
  page_process_page_internal (evaluated);
  result = evaluated->buffer;
  free (evaluated);

  /* Strip leading and trailing whitespace from the string.  Yes? */
  if (clear_whitespace_p && (result != (char *)NULL))
    {
      register int i;
      char *temp = result;

      /* Strip leading. */
      while (whitespace (*temp)) temp++;

      if (temp != result)
	memmove (result, temp, 1 + strlen (temp));

      /* Strip trailing. */
      for (i = strlen (result) - 1; i > -1 && whitespace (result[i]); i--);
      if (i > -1)
	{
	  i++;
	  result[i] = '\0';
	}

      /* If there was nothing but whitespace, return the NULL string. */
      if (*result == '\0')
	{
	  free (result);
	  result = (char *)NULL;
	}
    }

  return (result);
}

/* Return a pointer to the UserFunction structure describing the user level
   function named by NAME, or NULL if no such function exists. */
UserFunction *
mhtml_find_user_function (char *name)
{
  Symbol *sym = symbol_lookup_in_package (mhtml_user_keywords, name);

  return (sym ? (UserFunction *)(sym->values) : (UserFunction *)NULL);
}

/* Add or replace a function of TYPE with NAME, BODY in the
   *user-functions* package. The definition is modified by variable
   names and values specified in the package passed in VARS. */
void
mhtml_add_user_function (int type, char *name, char *body, Package *vars)
{
  UserFunction *uf = mhtml_find_user_function (name);
  char *body_whitespace = get_value (vars, "whitespace");
  char *debug_level = get_value (vars, "debug");
  char *wrapper_packname = mhtml_evaluate_string (get_value (vars, "package"));
  char **named_parameters = (char **)NULL;
  int np_size = 0;
  int np_index = 0;

  if (type == user_DEFUN)
    {
      body_whitespace = "delete";
      if (!wrapper_packname)
	wrapper_packname = strdup ("local");
    }

  /* Gather named arguments if present. */
  {
    register int i;
    char *param;

    for (i = 1; (param = get_positional_arg (vars, i)) != (char *)NULL; i++)
      {
	if (np_index + 2 > np_size)
	  named_parameters = (char **) xrealloc
	  (named_parameters, (np_size += 10) * sizeof (char *));

	named_parameters[np_index++] = strdup (param);
	named_parameters[np_index] = (char *)NULL;
      }
  }

  if (empty_string_p (wrapper_packname))
    {
      if (wrapper_packname) free (wrapper_packname);
      wrapper_packname = (char *)NULL;
    }

  if (uf == (UserFunction *)NULL)
    {
      Symbol *sym;

      uf = (UserFunction *)xmalloc (sizeof (UserFunction));
      uf->type = type;
      uf->debug_level = debug_level ? atoi (debug_level) : 0;
      uf->name = strdup (name);
      uf->packname = wrapper_packname;
      uf->named_parameters = named_parameters;
      uf->body = strdup (body ? body : "");

      if (mhtml_user_keywords == (Package *)NULL)
	mhtml_user_keywords = symbol_get_package ("*user-functions*");
      sym = symbol_intern_in_package (mhtml_user_keywords, name);
      sym->values = (char **)uf;
      sym->type = symtype_USERFUN;
    }
  else
    {
      uf->type = type;
      if (uf->packname) free (uf->packname);
      uf->packname = wrapper_packname;
      if (uf->named_parameters)
	{
	  register int i;

	  for (i = 0; uf->named_parameters[i] != (char *)NULL; i++)
	    free (uf->named_parameters[i]);
	  free (uf->named_parameters);
	}
      uf->named_parameters = named_parameters;

      free (uf->body);
      uf->body = strdup (body ? body : "");
    }

  uf->flags = 0;

  /* Strip comments now, rather than later. */
  {
    register int i = 0;
    char *b = uf->body;

    while (b[i] != '\0')
      {
	if ((b[i] == ';') && (b[i + 1] == ';') && (b[i + 2] == ';'))
	  {
	    register int j;
	    
	    for (j = i; (b[j] != '\0') && (b[j] != '\n'); j++);
	    memmove (b + i, b + j, strlen (b + j) + 1);
	  }
	else
	  i++;
      }
  }
     
  /* If the user wants special behaviour for the whitespace present in
     the macro body, then handle it now. */
  if (body_whitespace != (char *)NULL)
    {
      char *b = uf->body;

      if (strcasecmp (body_whitespace, "delete") == 0)
	{
	  register int i, c, l, start;
	  int brace_level = 0;
	  int quote_level = 0;

	  uf->flags |= user_WHITESPACE_DELETED;

	  l = strlen (b);

	  /* Delete all occurences of whitespace outside of 
	     `< ...>' and `" ... "'. */
	  i = 0;
	  while ((c = b[i]) != '\0')
	    {
	      switch (c)
		{
		case '"':
		  quote_level = !quote_level;
		  break;

		case '<':
		  if (!quote_level)
		    brace_level++;
		  break;

		case '>':
		  if (!quote_level)
		    brace_level--;
		  break;

		case '\\':
		  if (b[i + 1])
		    i++;
		  break;

		  /* Handle comments. */
		case ';':
		  if (!quote_level && !mhtml_inhibit_comment_parsing &&
		      ((i + 2) < l) && (b[i + 1] == ';' && b[i + 2] == ';'))
		    {
		      start = i;
		      while (b[i] && b[i] != '\n') i++;
		      memmove (b + start, b + i, 1 + strlen (b + i));
		      i = start - 1;
		    }
		  break;

		case '\r':
		  if (b[i + 1] == '\n')
		    {
		      if (!quote_level && !brace_level)
			{
			  i++;
			  start = i;
			  while (whitespace (b[i])) i++;
			  memmove (b + start, b + i, 1 + strlen (b + i));
			  i = start - 1;
			}
		    }
		  break;

		case ' ':
		case '\t':
		case '\n':
		  if (((c == ' ' || c == '\t') && (i == 0)) ||
		      (c == '\n' && !quote_level && !brace_level))
		    {
		      start = i;
		      while (whitespace (b[i])) i++;
		      memmove (b + start, b + i, 1 + strlen (b + i));
		      i = start - 1;
		    }
		}
	      i++;
	    }
	}
    }
}

/* Execute the subst, function or macro described by UF. */
void
mhtml_execute_function (UserFunction *uf, PFunArgs, char *attr)
{
  PAGE *subber = (PAGE *)NULL;

  if (!empty_string_p (uf->body))
    {
      register int i = 0, j;

      subber = page_create_page ();
      page_set_contents (subber, uf->body);

      /* Process the body. */
      while (i < subber->bindex)
	{
	  for (; (i < subber->bindex) && (subber->buffer[i] != '%'); i++);

	  i++;
	  if (i < subber->bindex)
	    {
	      if (isdigit (subber->buffer[i]))
		{
		  int which = subber->buffer[i] - '0';
		  char *arg = get_positional_arg (vars, which);

		  i--;
		  bprintf_delete_range (subber, i, i + 2);

		  if (!empty_string_p (arg))
		    {
		      char *insertion = mhtml_evaluate_string (arg);

		      if (!empty_string_p (insertion))
			{
			  bprintf_insert (subber, i, "%s", insertion);
			  i += strlen (insertion);
			}

		      if (insertion) free (insertion);
		    }
		}
	      else if (subber->buffer[i] == '\\')
		{
		  bprintf_delete_range (subber, i, i + 1);
		  continue;
		}
	      else if (((subber->bindex - i) > 3) &&
		       (strncasecmp (subber->buffer + i, "BODY", 4) == 0))
		{
		  i--;
		  bprintf_delete_range (subber, i, i + 5);

		  if (!empty_string_p (body->buffer))
		    {
		      j = 0;
		      if (uf->type != user_MACRO)
			while (whitespace (body->buffer[j])) j++;

		      bprintf_insert (subber, i, "%s", body->buffer + j);
		      i += strlen (body->buffer + j);
		    }
		}
	      else if (((subber->bindex - i) > 4) &&
		       (strncasecmp (subber->buffer + i, "QBODY", 5) == 0))
		{
		  i--;
		  bprintf_delete_range (subber, i, i + 6);

		  if (!empty_string_p (body->buffer))
		    {
		      register int k;
		      char *setval;

		      j = 0;
		      if (uf->type != user_MACRO)
			while (whitespace (body->buffer[j])) j++;

		      setval = (char *)xmalloc ((2 * body->bindex) + 4);

		      setval[0] = '"';

		      for (k = 1; j < body->bindex; j++)
			{
			  if (body->buffer[j] == '"')
			    setval[k++] = '\\';

			  setval[k++] = body->buffer[j];
			}

		      setval[k++] = '"';
		      setval[k] = '\0';

		      bprintf_insert (subber, i, "%s", setval);
		      free (setval);
		      i += k;
		    }
		}
	      else if (((subber->bindex - i) > 4) &&
		       (strncasecmp (subber->buffer + i, "XBODY", 5) == 0))
		{
		  i--;
		  bprintf_delete_range (subber, i, i + 6);
		  if (body && body->buffer)
		    {
		      char *evalled = (char *)NULL;

		      j = 0;
		      if (uf->type != user_MACRO)
			while (whitespace (body->buffer[j])) j++;

		      evalled = mhtml_evaluate_string (body->buffer + j);

		      if (evalled != (char *)NULL)
			{
			  bprintf_insert (subber, i, "%s", evalled);
			  i += strlen (evalled);
			  free (evalled);
			}
		    }
		}
	      else if (((subber->bindex - i) > 9) &&
		       (strncasecmp (subber->buffer + i, "ATTRIBUTES", 10)
			== 0))
		{
		  i--;
		  bprintf_delete_range (subber, i, i + 11);

		  if (!empty_string_p (attr))
		    {
		      for (j = 0; whitespace (attr[j]); j++);

		      bprintf_insert (subber, i, "%s", attr + j);
		      i += strlen (attr + j);
		    }
		}
	      else
		i++;
	    }
	}

      if (!empty_string_p (subber->buffer))
	{
	  char *packname = uf->packname;
	  char *parameter_setter = (char *)NULL;

	  if (uf->named_parameters != (char **)NULL)
	    {
	      BPRINTF_BUFFER *wrapper = bprintf_create_buffer ();
	      bprintf (wrapper, "<set-var");
	      for (i = 0; uf->named_parameters[i] != (char *)NULL; i++)
		{
		  char *value = get_positional_arg (vars, i);

		  if (value != (char *)NULL)
		    {
		      register int k;
		      char *setval;

		      if (uf->type == user_DEFUN)
			value = mhtml_evaluate_string (value);

		      setval = (char *)xmalloc ((2 * strlen (value)) + 4);

		      setval[0] = '"';

		      for (j = 0, k = 1; value[j] != '\0'; j++)
			{
			  if (value[j] == '"')
			    setval[k++] = '\\';

			  setval[k++] = value[j];
			}

		      setval[k++] = '"';
		      setval[k] = '\0';

		      bprintf (wrapper, " %s=%s",
			       uf->named_parameters[i], setval);

		      if (uf->type == user_DEFUN)
			free (value);

		      free (setval);
		    }
		}
	      bprintf (wrapper, ">");
	      parameter_setter = wrapper->buffer;
	      free (wrapper);
	    }

	  if (packname)
	    bprintf_insert (page, start, "<in-package %s>%s%s</in-package>",
			    packname, parameter_setter ? parameter_setter : "",
			    subber->buffer);
	  else
	    bprintf_insert (page, start, "%s%s", 
			    parameter_setter ? parameter_setter : "",
			    subber->buffer);
	}

      page_free_page (subber);
    }
}

/* Canonicalize the filename INPUT such that it is a complete and
   valid path to a file. */
char *
mhtml_canonicalize_file_name (char *input, char *docroot, char *relpref)
{
  register int i;
  char *result = (char *)NULL;
  static char *workbuff = (char *)NULL;
  static int workbuff_len = 0;
  int docroot_len = docroot ? strlen (docroot) : 0;
  int relpref_len = relpref ? strlen (relpref) : 0;
  int input_len = input ? strlen (input) : 0;
  int maxlen = 10 + input_len + docroot_len + relpref_len;

  if (input == (char *)NULL)
    return (input);

  if (!docroot) docroot = "";
  if (!relpref) relpref = "";

  if (maxlen >= workbuff_len)
    workbuff = (char *)xrealloc (workbuff, workbuff_len = maxlen);

  /* Ignore leading and trailing whitespace. */
  input = strdup (input);
  for (i = 0; input[i] && whitespace (input[i]); i++);

  if (i != 0)
    memmove (input, input + i, strlen (input + i) + 1);

  for (i = strlen (input) - 1; i > 0 && whitespace (input[i]); i--);
  if (input[i])
    input[i + 1] = '\0';

  /* If not absolute, root this document at RELPREF. */
  if (input[0] != '/')
    sprintf (workbuff, "%s/%s", relpref, input);
  else
    strcpy (workbuff, input);
    
  /* Clean up the work buffer so that "." and ".." disappear. */
  {
    register int last_slash = 0;

    for (i = 0; workbuff[i] != '\0'; i++)
      {
	/* If in eligible spot for "./" or "../" removal, do it now. */
	if ((i == 0) || (workbuff[i] == '/'))
	  {
	    if ((workbuff[i + 1] == '.') && (workbuff[i + 2] == '/'))
	      {
		/* Remove "./". */
		memmove (workbuff + i, workbuff + i + 2,
			 1 + strlen (workbuff + i + 2));
		i--;
	      }
	    else if ((workbuff[i + 1] == '.') &&
		     (workbuff[i + 2] == '.') &&
		     (workbuff[i + 3] == '/'))
	      {
		/* Remove "../" back to previous slash location. */
		memmove (workbuff + last_slash, workbuff + i + 3,
			 1 + strlen (workbuff + i + 3));
		i = last_slash - 1;

		/* Move the last slash back. */
		for (last_slash = i; last_slash > 0; last_slash--)
		  if (workbuff[last_slash] == '/')
		    break;
	      }
	    else
	      last_slash = i;
	  }
      }
  }

#if defined (HAVE_GETPWNAM)
  /* If username expansion is being allowed, we allow it to work here
     as well. */
  if (workbuff[0] == '/' && workbuff[1] == '~')
    {
      char *homedir = pagefunc_get_variable ("mhtml::~directory");

      if (homedir != (char *)NULL)
	{
	  char *username;
	  struct passwd *entry;

	  for (i = 2; (workbuff[i] != '\0') && (workbuff[i] != '/'); i++);

	  username = (char *)xmalloc (i);
	  strncpy (username, workbuff + 2, i - 2);
	  username[i - 2] = '\0';
	  entry = (struct passwd *)getpwnam (username);
	  free (username);

	  if ((entry != (struct passwd *)NULL) &&
	      (entry->pw_dir != (char *)NULL))
	    {
	      char *temp = strdup (workbuff + i);

	      if ((3 +
		   strlen (entry->pw_dir) +
		   strlen (homedir) +
		   strlen (temp)) >= workbuff_len)
		workbuff = (char *)xrealloc
		  (workbuff, workbuff_len = (3 +
					     strlen (entry->pw_dir) +
					     strlen (homedir) +
					     strlen (temp)));

	      sprintf (workbuff, "%s/%s%s", entry->pw_dir, homedir, temp);
	      free (temp);
	      docroot_len = 0;
	    }
	}
    }
#endif /* HAVE_GETPWNAM */

  /* The semantics of INCLUDE are similar to the semantics of web-space.
     This means that "<include /header.mhtml>" gets `header.mhtml' from
     the root directory, and not from the local directory. */
  if (docroot_len != 0)
    {
      memmove (workbuff + docroot_len, workbuff, 1 + strlen (workbuff));
      memmove (workbuff, docroot, docroot_len);
    }

  result = strdup (workbuff);

#if defined (macintosh) || defined (__WINNT__)
  /* Fix pathname separators. */
  if (result)
    {
      register int i;

#if defined (__WINNT__)
      if ((result[0] != '\0') && (result[1] == ':'))
	memmove (result, result + 2, strlen (result) - 2);
#endif /* __WINNT__ */

      for (i = 0; result[i] != '\0'; i++)
	{
#if defined (macintosh)
	  if (result[i] == '/')
	    result[i] = ':';
#endif /* macintosh */
#if defined (__WINNT__)
	  if (result[i] == '\\')
	    result[i] = '/';
#endif /* __WINNT__ */
	}
    }
#endif /* mac || NT */

  return (result);
}

/* Set the debugging level for the function named in SYM to
   be the value of SYM. */
void
mhtml_set_debugging_on (Symbol *sym)
{
  UserFunction *uf = mhtml_find_user_function (sym->name);
  PFunDesc *desc = pagefunc_get_descriptor (sym->name);

  if ((uf != (UserFunction *)NULL)  || (desc != (PFunDesc *)NULL))
    {
      int new_debug_level = 1;

      if (sym->values && sym->values[0])
	new_debug_level = atoi (sym->values[0]);

      if (uf)
	uf->debug_level = new_debug_level;
      else
	desc->debug_level = new_debug_level;
    }
}

/* Deliver a string which looks like the string that might have been
   passed to a function.  PACKAGE is the package returned from
   PAGEFUNC_SNARF_VARS. */
char *
mhtml_funargs (Package *pack)
{
  char **names = get_vars_names (pack);
  char *result = (char *)NULL;

  if (names != (char **)NULL)
    {
      register int i;
      char **values = get_vars_vals (pack);
      BPRINTF_BUFFER *string = bprintf_create_buffer ();

      for (i = 0; names[i] != (char *)NULL; i++)
	{
	  if (i > 0)
	    bprintf (string, " ");

	  if ((values[i] != (char *)NULL) && (values[i][0] != '\0'))
	    {
	      /* Place quotes around this string on the way out. */
	      bprintf (string, "%s=\"%s\"", names[i], values[i]);
	    }
	  else
	    {
	      /* Just print the attribute name. */
	      bprintf (string, "%s", names[i]);
	    }
	}

      result = string->buffer;
      free (string);
    }

  return (result);
}

/* Returns non-zero if STRING consists exclusively of all digits.
   A decimal point is NOT a digit. */
int
mhtml_all_digits (char *string)
{
  register int i;
  int result = 0;

  /* Skip leading whitespace. */
  for (i = 0; whitespace (string[i]); i++);

  if (string[i])
    {
      result = 1;

      for (; string[i]; i++)
	if (!isdigit (string[i]))
	  {
	    result = 0;
	    break;
	  }
    }
  return (result);
}

#define DECODE(c) transtab[(int)c]
char *
mhtml_base64decode (char *encoded, int *len)
{
  register int i, count;
  char *decoded;
  int decoded_size = 0;
  static int called_once = 0;
  static unsigned char transtab[256];

  /* If not already called, initialize the translation map. */
  if (!called_once)
    {
      static char lut[64] = {
	'A','B','C','D','E','F','G','H','I','J','K','L','M',
	'N','O','P','Q','R','S','T','U','V','W','X','Y','Z',
	'a','b','c','d','e','f','g','h','i','j','k','l','m',
	'n','o','p','q','r','s','t','u','v','w','x','y','z',
	'0','1','2','3','4','5','6','7','8','9','+','/'
      };
      called_once++;

      for (i = 0; i < 256; i++)
	transtab[i] = 64;

      for (i = 0; i < 64; i++)
	transtab[(int) lut[i]] = (unsigned char) i;
   }

  for (i = 0; transtab[(int)encoded[i]] < 64; i++);
  count = i - 1;
  decoded_size = ((count + 3) / 4) * 3;

  decoded = (char *)xmalloc (1 + decoded_size);
  if (len != (int *)NULL) *len = decoded_size;

  i = 0;
  while (count > 0)
    {
      decoded[i] = (DECODE (encoded[0]) << 2 | DECODE (encoded[1]) >> 4); i++;
      decoded[i] = (DECODE (encoded[1]) << 4 | DECODE (encoded[2]) >> 2); i++;
      decoded[i] = (DECODE (encoded[2]) << 6 | DECODE (encoded[3])); i++;
      encoded += 4;
      count -= 4;
   }

  i += ++count;
  decoded[i] = '\0';

  return (decoded);
}
