/* pagefuncs.c: HTML `functions' can be executed with page_process_page (). */

/* Author: Brian J. Fox (bfox@ai.mit.edu) Tue Jul 18 17:50:42 1995.

   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  */

#include "language.h"

#define MHTML_ARITHMETIC 1

/************************************************************/
/*							    */
/*		Language Manipulation Functions		    */
/*							    */
/************************************************************/

#if defined (MHTML_ARITHMETIC)
static void pf_gt (PFunArgs);
static void pf_lt (PFunArgs);
static void pf_eq (PFunArgs);
static void pf_add (PFunArgs);
static void pf_sub (PFunArgs);
static void pf_mul (PFunArgs);
static void pf_div (PFunArgs);
static void pf_mod (PFunArgs);
#endif /* MHTML_ARITHMETIC */

/* <randomize [seed]> */
static void pf_randomize (PFunArgs);

/* <random [max]> --> A random number between 0 and max. */
static void pf_random (PFunArgs);

/* <set-var name=value> */
static void pf_set_variable (PFunArgs);

/* <set-var-readonly name=value> */
static void pf_set_variable_readonly (PFunArgs);

/* <get-var name> --> value */
static void pf_get_variable (PFunArgs);

/* <get-var-once name> --> value, with parser advanced past value. */
static void pf_get_variable_once (PFunArgs);

/* <unset-var name> */
static void pf_unset_variable (PFunArgs);

/* <variable-set? var> */
static void pf_variable_set_p (PFunArgs);

/* <package-vars PACKAGE...> --> newline separated list of variable names. */
static void pf_package_vars (PFunArgs);

/* <package-delete PACKAGE...> --> Delete the named packages. */
static void pf_package_delete (PFunArgs);

/* <package-names> --> newline separated list of package names. */
static void pf_package_names (PFunArgs);

/* <package-to-alist packname> --> (( packname::foo . bar) ...) */
static void pf_package_to_alist (PFunArgs);

/* <alist-to-package alist [packname]> --> package */
static void pf_alist_to_package (PFunArgs);

static void pf_in_package (PFunArgs);
static void pf_with_local_package (PFunArgs);

/* <not TEST> --> "true" if TEST is empty, "" otherwise. */
static void pf_not (PFunArgs);

/* <and ...> --> Result of evaluating tests if all are true, else "". */
static void pf_and (PFunArgs);

/* <or ...> --> Result of evaluating first true test, else "" if
   all are false. */
static void pf_or (PFunArgs);

/* <defmacro macro-name> body </defmacro>
   Store MACRO-NAME as a complex tag.
   Do replacements on %1..%9 and %body in BODY at invocation time. */
static void pf_defmacro (PFunArgs);

/* <defweakmacro macro-name> body </defmacro>
   Store MACRO-NAME as a complex tag.
   Do replacements on %1..%9 and %body in BODY at invocation time.
   At invocation time, the closing tag does not necessarily have to be
   present -- it is treated as a "subst" in that case. */
static void pf_defweakmacro (PFunArgs);

/* <defun fun-name> body </defun>
   Store FUN-NAME as a complex tag.
   By default, execution takes place in the local package with
   surrounding whitespace deleted, and arguments evalled.
   Do replacements on %1..%9 and %body in BODY at invocation time. */
static void pf_defun (PFunArgs);

/* <defsubst macro-name> body </defsubst>
   Store MACRO-NAME as a sinple tag.
   Do replacements on %1..%9 and %body in BODY at invocation time. */
static void pf_defsubst (PFunArgs);

/* <undef macro-name ...>  Remove a macro definition. */
static void pf_undef (PFunArgs);

/* <function-def foo bar> --> Prints out function defs. */
static void pf_function_def (PFunArgs);

/* <increment VAR [BY=xx]>  Change the value of VAR by XX. */
static void pf_increment (PFunArgs);

/* <decrement VAR [BY=xx]>  Change the value of VAR by XX. */
static void pf_decrement (PFunArgs);

/* <comment> ... </comment> */
static void pf_comment (PFunArgs);

/* <verbatim> .... </verbatim> Insert the contents verbatim. */
static void pf_verbatim (PFunArgs);

/* <plain-text [first-char=CODE]> Modify paragraph starts. */
static void pf_plain_text (PFunArgs);

/* <include filename alt="page value if FILENAME isn't found"> */
static void pf_include (PFunArgs);

/* <replace-page filename> Replace the current page with FILENAME. */
static void pf_replace_page (PFunArgs);

/* <redirect URL> returns an HTTP Location: directive.  The returned
   URL will include the SID if the SID is present and has a value. */
static void pf_redirect (PFunArgs);

/* <server-push>TEXT</server-push> makes TEXT go down the line immediately. */
static void pf_server_push (PFunArgs);

/* <cgi-encode var1 var2 varN> --> VAR1=VAL1&VAR2=VAL2... */
static void pf_cgi_encode (PFunArgs);

/* <cgi-decode string> --> STRING to PageVars. */
static void pf_cgi_decode (PFunArgs);

/* <small-caps [upper="+0"] [lower="-1"]>This is a list</small-caps> */
static void pf_small_caps (PFunArgs);

/* <pad <get-var foo> 12 align=right>  Pad STRING on right, left, or both. */
static void pf_pad (PFunArgs);

/* <subst-in-page this that> Replace occurrences of THIS with THAT. */
static void pf_subst_in_page (PFunArgs);

/* <subst-in-var varname this that> Replace occurrences of THIS with THAT. */
static void pf_subst_in_var (PFunArgs);

/* <subst-in-string string this that> Replace occurrences of THIS with THAT. */
static void pf_subst_in_string (PFunArgs);

/* <date> --> Mon Feb 12 04:28:15 PST 1996 */
static void pf_date (PFunArgs);

/* <symbol-info name> -->
   "STRING\ncount" or "FUNCTION\n0" or "BINARY\nlength" */
static void pf_symbol_info (PFunArgs);

/* <match string regex
      [action=[delete | extract | report | startpos | endpos]]>
   When action is "report" (the default), returns "true" if REGEX matched.
   When action is "extract", returns the substring of STRING matching REGEX.
   When action is "delete", returns the unmatched part STRING.
   When action is "startpos", returns the numeric offset of the start of
   the matched substring.
   When action is "endpos", returns the numeric offset of the end of the
   matched substring. */
static void pf_match (PFunArgs);

/* Return "less", "equal" or "greater" depending on string comparision of two
   arguments.  Argument "caseless=true" means do the comparison with case
   being insignificant. */
static void pf_string_compare (PFunArgs);

/* <substring string start [end]> */
static void pf_substring (PFunArgs);

/* <upcase string> */
static void pf_upcase (PFunArgs);

/* <downcase string> */
static void pf_downcase (PFunArgs);

/* <capitalize string> */
static void pf_capitalize (PFunArgs);

/* <word-wrap <get-var text> [width=60]> */
static void pf_word_wrap (PFunArgs);

#if defined (NOT_AT_THIS_TIME)
/* <page-insert location string> */
static void pf_page_insert (PFunArgs);

/* <page-search start-offset regex> --> location */
static void pf_page_search (PFunArgs);
#endif /* NOT_AT_THIS_TIME */

#if defined (DEPRECATED)
/* <html-quote "<this is an mhtml command>"> -> &ltthis is ...and&gt */
static void pf_html_quote (PFunArgs);

#endif /* DEPRECATED */

/* <DEBUGGING-OUTPUT [arg]> 
   -> Placeholder for output, or produce output immediately. */
static void pf_debugging_output (PFunArgs);

/* <SYSTEM-ERROR-OUTPUT [arg]> 
   -> Placeholder for output, or produce output immediately. */
static void pf_system_error_output (PFunArgs);

/************************************************************/
/*							    */
/*			HTML "Helper" Functions		    */
/*							    */
/************************************************************/

/* <debugging-on set-var=2 with-open-database=3 if=0> */
static void pf_debugging_on (PFunArgs);
static void pf_page_debug (PFunArgs);

static void pf_time (PFunArgs);
static void pf_pid (PFunArgs);

PFunDesc pagefunc_table[] = {

  /* General use functions: variable manipulation and iteration operators. */
  { "SET-VAR",		0, 0, pf_set_variable },
  { "SET-VAR-READONLY",	0, 0, pf_set_variable_readonly },
  { "GET-VAR",		0, 0, pf_get_variable },
  { "GET-VAR-ONCE",	0, 0, pf_get_variable_once },
  { "UNSET-VAR",	0, 0, pf_unset_variable },
  { "VAR-EXISTS",	0, 0, pf_variable_set_p },
  { "SUBST-IN-VAR",	0, 0, pf_subst_in_var },
  { "SUBST-IN-STRING",	0, 0, pf_subst_in_string },
  { "SYMBOL-INFO",	0, 0, pf_symbol_info },
  { "PACKAGE-VARS",	0, 0, pf_package_vars },
  { "PACKAGE-NAMES",	0, 0, pf_package_names },
  { "IN-PACKAGE",	1, 0, pf_in_package },
  { "WITH-LOCAL-PACKAGE",	1, 0, pf_with_local_package },
  { "PACKAGE-TO-ALIST", 0, 0, pf_package_to_alist },
  { "ALIST-TO-PACKAGE", 0, 0, pf_alist_to_package },
  { "PACKAGE-DELETE",	0, 0, pf_package_delete },
  { "INCREMENT",	0, 0, pf_increment },
  { "DECREMENT",	0, 0, pf_decrement },
  { "NOT",		0, 0, pf_not },
  { "AND",		0, 0, pf_and },
  { "OR",		0, 0, pf_or },
  { "DEFMACRO",		1, 0, pf_defmacro },
  { "DEFWEAKMACRO",	1, 0, pf_defweakmacro },
  { "DEFINE-CONTAINER",	1, 0, pf_defmacro },
  { "DEFSUBST",		1, 0, pf_defsubst },
  { "DEFINE-TAG",	1, 0, pf_defsubst },
  { "DEFUN",		1, 0, pf_defun },
  { "DEFINE-FUNCTION",	1, 0, pf_defun },
  { "UNDEF",		0, 0, pf_undef },
  { "FUNCTION-DEF",	0, 0, pf_function_def },
  { "DEBUGGING-ON",	0, 0, pf_debugging_on },
  { "PAGE-DEBUG",	0, 0, pf_page_debug },
  { "DATE",		0, 0, pf_date },

  /* Random string operations. */
  { "MATCH",		0, 0, pf_match },
  { "STRING-COMPARE",	0, 0, pf_string_compare },
  { "SUBSTRING",	0, 0, pf_substring },
  { "UPCASE",		0, 0, pf_upcase },
  { "DOWNCASE",		0, 0, pf_downcase },
  { "CAPITALIZE",	0, 0, pf_capitalize },
  { "WORD-WRAP",	0, 0, pf_word_wrap },

  /* File manipulation functions. */
  { "INCLUDE",		0, 0, pf_include },
  { "REPLACE-PAGE",	0, 0, pf_replace_page },
  { "REDIRECT",		0, 0, pf_redirect },
  { "SERVER-PUSH",	1, 0, pf_server_push },
  { "CGI-ENCODE",	0, 0, pf_cgi_encode },
  { "CGI-DECODE",	0, 0, pf_cgi_decode },

  /* Block manipulation. */
  { "COMMENT",		1, 0, pf_comment },
  { "VERBATIM",		1, 0, pf_verbatim },
  { "PLAIN-TEXT",	1, 0, pf_plain_text },

#if defined (DEPRECATED)
  /* HTML "Helper" Functions. */
  { "INPUT-ITEM",	0, 0, pf_input_item },
#endif /* DEPRECATED */

  /* HTML Character manipulation. */
  { "SMALL-CAPS",	1, 0, pf_small_caps },

  /* Page manipulation.  The following functions operate on the page as it
     exists in its current state at the time the function was called. */
  { "SUBST-IN-PAGE",	0, 0, pf_subst_in_page },
  { "PAD",		0, 0, pf_pad },

#if defined (NOT_AT_THIS_TIME)
  { "PAGE-INSERT",	0, 0, pf_page_insert },
  { "PAGE-SEARCH",	0, 0, pf_page_search },
#endif /* NOT_AT_THIS_TIME */

  /* The following functions are deprecated.  They can easily be
     written as macros. */
#if defined (DEPRECATED)
  { "HTML-QUOTE",	0, 0, pf_html_quote },
#endif /* DEPRECATED */


#if defined (MHTML_ARITHMETIC)
  { "GT",		0, 0, pf_gt },
  { "LT",		0, 0, pf_lt },
  { "EQ",		0, 0, pf_eq },
  { "ADD",		0, 0, pf_add },
  { "SUB",		0, 0, pf_sub },
  { "MUL",		0, 0, pf_mul },
  { "DIV",		0, 0, pf_div },
  { "MOD",		0, 0, pf_mod },
#endif /* MHTML_ARITHMETIC */

  { "RANDOMIZE",	0, 0, pf_randomize },
  { "RANDOM",		0, 0, pf_random },

  { "TIME",		0, 0, pf_time },
  { "PID",		0, 0, pf_pid },
  { "DEBUGGING-OUTPUT",	0, 0, pf_debugging_output },
  { "SYSTEM-ERROR-OUTPUT", 0, 0, pf_system_error_output },

  { (char *)NULL,	0, 0, (PFunHandler *)NULL }
};

PACKAGE_INITIALIZER (initialize_pagefunc_functions)

void
initialize_pagefunc_functions (Package *package)
{
  register int i;
  Symbol *sym;

  for (i = 0; pagefunc_table[i].tag != (char *)NULL; i++)
    {
      sym = symbol_intern_in_package (package, pagefunc_table[i].tag);
      sym->type = symtype_FUNCTION;
      sym->values = (char **)(&pagefunc_table[i]);
    }
}

/* Control debugging on a per-function basis. */
static void
pf_debugging_on (PFunArgs)
{
  if (vars)
    {
      register int i;
      Symbol **symbols = symbols_of_package (vars);
      Symbol *sym;

      for (i = 0; (sym = symbols[i]) != (Symbol *)NULL; i++)
	{
	  mhtml_set_debugging_on (sym);
	}
    }
}

/* Evaluate BODY, and add the result to the debugging output. */
static void
pf_page_debug (PFunArgs)
{
  char *value;

  value = mhtml_evaluate_string (body->buffer ? body->buffer : "");
  if (!empty_string_p (value))
    page_debug ("%s", value);
  if (value) free (value);
}

static void
pf_defsubst (PFunArgs)
{
  char *temp = get_positional_arg (vars, 0);
  char *subst_name = mhtml_evaluate_string (temp);
  char *subst_body = body ? body->buffer : "";

  if (!empty_string_p (subst_name))
    mhtml_add_user_function (user_SUBST, subst_name, subst_body, vars);

  if (subst_name && subst_name != temp)
    free (subst_name);
}

static void
pf_defmacro (PFunArgs)
{
  char *temp = get_positional_arg (vars, 0);
  char *subst_name = mhtml_evaluate_string (temp);
  char *subst_body = body ? body->buffer : "";

  if (!empty_string_p (subst_name))
    mhtml_add_user_function (user_MACRO, subst_name, subst_body, vars);

  if (subst_name && subst_name != temp)
    free (subst_name);
}

static void
pf_defweakmacro (PFunArgs)
{
  char *temp = get_positional_arg (vars, 0);
  char *subst_name = mhtml_evaluate_string (temp);
  char *subst_body = body ? body->buffer : "";

  if (!empty_string_p (subst_name))
    {
      UserFunction *uf;
      mhtml_add_user_function (user_MACRO, subst_name, subst_body, vars);
      uf = mhtml_find_user_function (subst_name);
      uf->flags |= user_WEAK_MACRO;
    }

  if (subst_name && subst_name != temp)
    free (subst_name);
}

static void
pf_defun (PFunArgs)
{
  char *temp = get_positional_arg (vars, 0);
  char *subst_name = mhtml_evaluate_string (temp);
  char *subst_body = body ? body->buffer : "";

  if (!empty_string_p (subst_name))
    mhtml_add_user_function (user_DEFUN, subst_name, subst_body, vars);

  if (subst_name && subst_name != temp)
    free (subst_name);
}

static void
pf_undef (PFunArgs)
{
  register int i;
  char *name;

  if (!mhtml_user_keywords)
    return;

  for (i = 0; (name = get_positional_arg (vars, i)) != (char *)NULL; i++)
    {
      char *varname = name;

      varname = mhtml_evaluate_string (name);

      if (varname)
	{
	  UserFunction *uf = mhtml_find_user_function (varname);
	  Symbol *sym;

	  if (uf)
	    {
	      free (uf->body);
	      free (uf->name);
	      free (uf);
	    }

	  sym = symbol_remove_in_package (mhtml_user_keywords, varname);

	  if (sym)
	    {
	      sym->values= (char **)NULL;
	      sym->values_index = 0;
	      symbol_free (sym);
	    }

	  free (varname);
	}
    }
}

/* Get the body of the macro, verbatim. */
static void
pf_function_def (PFunArgs)
{
  if (mhtml_user_keywords == (Package *)NULL)
    return;
  else
    {
      register int i;
      char *name;
    
      for (i = 0; (name = get_positional_arg (vars, i)) != (char *)NULL; i++)
	{
	  char *varname = mhtml_evaluate_string (name);

	  if (varname != (char *)NULL)
	    {
	      UserFunction *uf = mhtml_find_user_function (varname);

	      if (uf)
		{
		  BPRINTF_BUFFER *insertion = bprintf_create_buffer ();

		  if (uf->type == user_MACRO)
		    bprintf (insertion, "<defmacro %s", uf->name);
		  else if (uf->type == user_DEFUN)
		    bprintf (insertion, "<defun %s", uf->name);
		  else if (uf->type == user_SUBST)
		    bprintf (insertion, "<defsubst %s", uf->name);

		  /* Any named parameters? */
		  if (uf->named_parameters != (char **)NULL)
		    {
		      register int j;

		      for (j = 0; uf->named_parameters[j] != (char *)NULL; j++)
			bprintf (insertion, " %s", uf->named_parameters[j]);
		    }


		  /* Any special package name? */
		  if (uf->packname != (char *)NULL)
		    bprintf (insertion, " package=%s", uf->packname);


		  /* Any CR's in body? */
		  if (uf->flags & user_WHITESPACE_DELETED)
		    bprintf (insertion, " whitespace=delete>");
		  else
		    bprintf (insertion, ">\n");

		  bprintf (insertion, "%s", uf->body);

		  if ((uf->flags & user_WHITESPACE_DELETED) == 0)
		    bprintf (insertion, "\n");

		  if (uf->type == user_MACRO)
		    bprintf (insertion, "</defmacro>");
		  else if (uf->type == user_DEFUN)
		    bprintf (insertion, "</defun>");
		  else if (uf->type == user_SUBST)
		    bprintf (insertion, "</defsubst>");

		  bprintf_insert (page, start, "%s\n", insertion->buffer);
		  start += insertion->bindex + 1;
		  bprintf_free_buffer (insertion);
		}

	      free (varname);
	    }
	}

      *newstart = start;
    }
}

static void
pf_symbol_info (PFunArgs)
{
  char *name = mhtml_evaluate_string (get_positional_arg (vars, 0));

  if (name)
    {
      Symbol *sym = symbol_lookup (name);

      if (sym != (Symbol *)NULL)
	{
	  switch (sym->type)
	    {
	    case symtype_STRING:
	      bprintf_insert (page, start, "STRING\n%d", sym->values_index);
	      break;

	    case symtype_FUNCTION:
	      bprintf_insert (page, start, "FUNCTION\n0");
	      break;

	    case symtype_BINARY:
	      bprintf_insert (page, start, "BINARY\n%d",
			      ((Datablock *)sym->values)->length);
	      break;
	    }
	}
      free (name);
    }
}

static void
generic_set_variable (Package *vars, int debug_level, int readonly_p)
{
  char *func = readonly_p ? "set-var-readonly" : "set-var";

  if (vars)
    {
      char **names = get_vars_names (vars);
      char **vals = get_vars_vals (vars);

      if (names != (char **)NULL)
	{
	  register int i;
	  char *sym_name;

	  for (i = 0; (sym_name = names[i]) != (char *)NULL; i++)
	    {
	      char *name = sym_name;
	      char *value = vals[i];
	      int free_value = 0;

	      name = mhtml_evaluate_string (sym_name);

	      if (debug_level >= 5)
		{
		  if (value)
		    page_debug ("<%s \"%s\"=\"%s\">", func, sym_name, value);
		  else
		    page_debug ("<%s \"%s\">", func, sym_name);
		}

	      if (value == (char *)NULL)
		{
		  if (debug_level)
		    page_debug ("<%s %s ...> missing `='", func, sym_name);
		}
	      else
		{
		  value = mhtml_evaluate_string (value);
		  if (value) free_value++;
		}

	      if (debug_level >= 6)
		page_debug ("--> <%s \"%s\"=\"%s\">",
			    func, name ? name : "", value ? value : "");

	      if (name)
		{
		  if (readonly_p)
		    pagefunc_set_variable_readonly (name, value);
		  else
		    pagefunc_set_variable (name, value);
		}

	      if (free_value) free (value);
	      if (name != sym_name) free (name);
	    }
	}
    }
}

static void
pf_set_variable (PFunArgs)
{
  generic_set_variable (vars, debug_level, 0);
}

static void
pf_set_variable_readonly (PFunArgs)
{
  generic_set_variable (vars, debug_level, 1);
}

static void
pf_get_variable (PFunArgs)
{
  register int i;
  char *name;

  for (i = 0; (name = get_positional_arg (vars, i)) != (char *)NULL; i++)
    {
      char *insertion;
      char *value;

      insertion = mhtml_evaluate_string (name);

      value = pagefunc_get_variable (insertion);

      if (debug_level > 5)
	page_debug ("<get-var \"%s\">", insertion ? insertion : "");

      if (value)
	{
	  bprintf_insert (page, start, "%s", value);
	  start += strlen (value);
	}
      else
	{
	  if (debug_level > 10)
	    page_debug ("<get-var \"%s\">: Unbound Variable \"%s\"!",
			insertion, insertion);
	}

      if (debug_level > 5)
	page_debug ("--> `%s'", value ? value : "");

      if (insertion)
	free (insertion);
    }
}

static void
pf_get_variable_once (PFunArgs)
{
  register int i;
  char *name;

  for (i = 0; (name = get_positional_arg (vars, i)) != (char *)NULL; i++)
    {
      char *insertion;
      char *value;

      insertion = mhtml_evaluate_string (name);

      value = pagefunc_get_variable (insertion);

      if (debug_level > 5)
	page_debug ("<get-var \"%s\">", insertion ? insertion : "");

      if (value)
	{
	  bprintf_insert (page, start, "%s", value);
	  start += strlen (value);
	}
      else
	{
	  if (debug_level > 10)
	    page_debug ("<get-var \"%s\">: Unbound Variable \"%s\"!",
			insertion, insertion);
	}

      if (debug_level > 5)
	page_debug ("--> `%s'", value ? value : "");

      if (insertion)
	free (insertion);

      *newstart = start;
    }
}

static void
pf_unset_variable (PFunArgs)
{
  register int i;
  char *name;

  for (i = 0; (name = get_positional_arg (vars, i)) != (char *)NULL; i++)
    {
      char *varname = mhtml_evaluate_string (name);
      Symbol *sym = varname ?  symbol_lookup (varname) : (Symbol *)NULL;

      if (sym)
	{
	  /* Don't really remove this symbol if it has a notifier
	     attached to it, simply zap the contents. */
	  if (sym->notifier)
	    {
	      register int j;

	      *(sym->notifier) = 0;

	      for (j = 0; j < sym->values_index; j++)
		free (sym->values[j]);

	      if (sym->values_index)
		sym->values[0] = (char *)NULL;

	      sym->values_index = 0;
	    }
	  else if (!symbol_get_flag (sym, sym_READONLY))
	    {
	      sym = symbol_remove (varname);
	      if (sym) symbol_free (sym);
	    }
	}

      xfree (varname);
    }
}

static void
pf_variable_set_p (PFunArgs)
{
  char *arg = mhtml_evaluate_string (get_positional_arg (vars, 0));
  int set_p = 0;

  if (!empty_string_p (arg) && (symbol_lookup (arg) != (Symbol *)NULL))
    set_p++;

  xfree (arg);

  if (set_p)
    {
      bprintf_insert (page, start, "true");
      *newstart += 4;
    }
}

static void
pf_package_names (PFunArgs)
{
  if (AllPackages)
    {
      register int i;
      Package *pack;

      for (i = 0; (pack = AllPackages[i]) != (Package *)NULL; i++)
	if (pack->name)
	  {
	    bprintf_insert (page, start, "%s\n", pack->name);
	    start += strlen (pack->name) + 1;
	  }

      *newstart = start;
    }
}

static void
pf_package_vars (PFunArgs)
{
  register int pos = 0;
  char *strip = get_value (vars, "STRIP");
  char *name;

  if ((CurrentPackage != (Package *)NULL) &&
      (get_positional_arg (vars, 0) == (char *)NULL))
    {
      Symbol **symbols = symbols_of_package (CurrentPackage);

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

	  for (i = 0; symbols[i] != (Symbol *)NULL; i++)
	    {
	      bprintf_insert (page, start, "%s\n", symbols[i]->name);
	      start += symbols[i]->name_len + 1;
	    }

	  free (symbols);
	}
    }

  while ((name = get_positional_arg (vars, pos)) != (char *)NULL)
    {
      Package *pack = (Package *)NULL;

      pos++;

      name = mhtml_evaluate_string (name);

      if (!empty_string_p (name))
	pack = symbol_lookup_package (name);

      if (pack)
	{
	  Symbol **symbols = symbols_of_package (pack);

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

	      for (i = 0; symbols[i] != (Symbol *)NULL; i++)
		{
		  if ((pack->name[0] != '\0') && (strip == (char *)NULL))
		    {
		      bprintf_insert (page, start, "%s::%s\n",
				      pack->name, symbols[i]->name);
		      start += pack->name_len + 3 + symbols[i]->name_len;
		    }
		  else
		    {
		      bprintf_insert (page, start, "%s\n", symbols[i]->name);
		      start += symbols[i]->name_len + 1;
		    }
		}

	      free (symbols);
	    }
	}

      if (name) free (name);
    }

  *newstart = start;
}

static void
pf_package_delete (PFunArgs)
{
  char **names = get_vars_names (vars);

  if (names != (char **)NULL)
    {
      register int i;

      for (i = 0; names[i] != (char *)NULL; i++)
	{
	  char *name = names[i];

	  name = mhtml_evaluate_string (name);

	  if (name)
	    {
	      pagefunc_destroy_package (name);
	      free (name);
	    }
	}
    }
}

#if defined (MHTML_ARITHMETIC)

/* Arithmetic operations.  This is pretty ugly. */
/* <gt  12 10> --> "true"
   <lt  10 12> --> "true"
   <eq  10 10> --> "true"
   <add 10 10> --> "20"
   <sub 10 10> --> "0"
   <mul 10 10> --> "100"
   <div 12 10> --> "1"
   <mod 12 10> --> "2" */
#define pf_GT	1
#define pf_LT	2
#define pf_EQ	3
#define pf_ADD	4
#define pf_SUB	5
#define pf_MUL	6
#define pf_DIV	7
#define pf_MOD	8

typedef struct { int op; char *name; } OP_ALIST;
static OP_ALIST op_alist[] = {
  { pf_GT, "GT" },
  { pf_LT, "LT" },
  { pf_EQ, "EQ" },
  { pf_ADD, "ADD" },
  { pf_SUB, "SUB" },
  { pf_MUL, "MUL" },
  { pf_DIV, "DIV" },
  { pf_MOD, "MOD" },

  { 0, (char *)NULL }
};

static char *
operator_name (int op)
{
  register int i;

  for (i = 0; op_alist[i].name != (char *)NULL; i++)
    if (op == op_alist[i].op)
      return (op_alist[i].name);

  return ("*invalid-op*");
}

static int
number_p (char *string)
{
  register int i;
  int result = 0;

  if (!string)
    return (0);

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

  if (string[i])
    {
      int decimal_seen = 0;

      result = 1;

      if ((string[i] == '-') || (string[i] == '+'))
	i++;

      for (; string[i]; i++)
	{
	  if (string[i] == '.')
	    {
	      if (decimal_seen)
		{
		  result = 0;
		  break;
		}
	      else
		decimal_seen++;
	    }
	  else if (!isdigit (string[i]))
	    {
	      result = 0;
	      break;
	    }
	}
    }

  return (result);
}

#if !defined (macintosh)
/* Fucking SunOS doesn't declare this, result is assumed to be INT. */
extern double strtod (const char *, char **);
#endif

static char *
arithmetic_operate (int op, char *arg1, char *arg2)
{
  double val1 = arg1 ? strtod (arg1, (char **)NULL) : 0.0;
  double val2 = arg2 ? strtod (arg2, (char **)NULL) : 0.0;
  static char resbuf[60];
  static int orig_mhtml_decimal_notify = 0;
  char *result = resbuf;

  result[0] = '\0';

  switch (op)
    {
    case pf_GT:
      if (val1 > val2) result = "true";
      break;

    case pf_LT:
      if (val1 < val2) result = "true";
      break;

    case pf_EQ:
      if (!arg1) arg1 = "";
      if (!arg2) arg2 = "";

      if (number_p (arg1) && number_p (arg2))
	{
	  if (val1 == val2)
	    result = "true";
	}
      else
	{
	  if (strcasecmp (arg1, arg2) == 0)
	    result = "true";
	}
      break;

    default:
      {
	double arith_result = 0.0;
	int dot_present = ((arg1 ? (strchr (arg1, '.') != (char *)NULL) : 0) ||
			   (arg2 ? (strchr (arg2, '.') != (char *)NULL) : 0));
    
	switch (op)
	  {
	  case pf_ADD:
	    arith_result = val1 + val2;
	    break;

	  case pf_SUB:
	    arith_result = val1 - val2;
	    break;

	  case pf_MUL:
	    arith_result = val1 * val2;
	    break;

	  case pf_DIV:
	    arith_result = val2 ? val1 / val2 : 0.0;
	    break;

	  case pf_MOD:
	    arith_result = val2 ? (double)((int)val1 % (int)val2) : 0.0;
	    break;
	  }

	if (mhtml_decimal_notify != orig_mhtml_decimal_notify)
	  {
	    orig_mhtml_decimal_notify = mhtml_decimal_notify;

	    if (mhtml_decimal_notify)
	      {
		char *temp = pagefunc_get_variable ("mhtml::decimal-places");

		if (temp)
		  mhtml_decimal_places = atoi (temp);
		else
		  mhtml_decimal_places = 0;
	      }
	    else
	      mhtml_decimal_places = 2;
	  }

	if (mhtml_decimal_notify)
	  sprintf (result, "%.*f", mhtml_decimal_places, arith_result);
	else if (!dot_present /* || (arith_result == (int)arith_result) */)
	  sprintf (result, "%ld", (long int)arith_result);
	else
	  sprintf (result, "%.*f", mhtml_decimal_places, arith_result);
      }
    }

  return (result);
}

static void
arithmetic_process (int op, PFunArgs)
{
  char *_arg1 = get_positional_arg (vars, 0);
  char *_arg2 = get_positional_arg (vars, 1);
  char *arg1, *arg2;
  int error_found = 0;
  char *result;

  if (!_arg1)
    {
      error_found++;
      page_debug ("<%s ...> seen with zero args", operator_name (op));
      _arg1 = "";
    }

  if (!_arg2)
    {
      if (!error_found)
	page_debug ("<%s %s ?> seen with one arg", operator_name (op), _arg1);

      _arg2 = "";
    }

  arg1 = _arg1; arg2 = _arg2;

  /* Evaluate the args as variable names if they are not
     already all digits. */
  if (!number_p (arg1) || !number_p (arg2))
    {
      register int i;
      char *rarg1 = (char *)NULL;
      char *rarg2 = (char *)NULL;

      if ((strchr (arg1, '<') != (char *)NULL) ||
	  ((LEFT_BRACKET != '<') &&
	   (strchr (arg1, LEFT_BRACKET) != (char *)NULL)))
	arg1 = mhtml_evaluate_string (arg1);

      if ((strchr (arg2, '<') != (char *)NULL) ||
	  ((LEFT_BRACKET != '<') &&
	   (strchr (arg2, LEFT_BRACKET) != (char *)NULL)))
	arg2 = mhtml_evaluate_string (arg2);

      rarg1 = arg1;
      rarg2 = arg2;

      /* If still not all digits, lookup arg as variable name.
	 Only do this when the operation is not pf_EQ, or if
	 the variables were not page evaluated. */
      if (!number_p (arg1))
	{
	  if ((op != pf_EQ) || (arg1 == _arg1))
	    {
	      for (i = 0; whitespace (arg1[i]); i++);
	      rarg1 = pagefunc_get_variable (arg1 + i);
	    }
	}

      if (!number_p (arg2))
	{
	  if ((op != pf_EQ) || (arg2 == _arg2))
	    {
	      for (i = 0; whitespace (arg2[i]); i++);
	      rarg2 = pagefunc_get_variable (arg2 + i);
	    }
	}

      result = arithmetic_operate (op, rarg1 ? rarg1 : "", rarg2 ? rarg2 : "");
    }
  else
    result = arithmetic_operate (op, arg1 ? arg1 : "", arg2 ? arg2 : "");

  if (arg1 && arg1 != _arg1) free (arg1);
  if (arg2 && arg2 != _arg2) free (arg2);

  if (*result)
    bprintf_insert (page, start, "%s", result);
}

static void pf_gt (PFunArgs)
{
  arithmetic_process
    (pf_GT, page, body, vars, start, end, newstart, debug_level);
}

static void pf_lt (PFunArgs)
{
  arithmetic_process
    (pf_LT, page, body, vars, start, end, newstart, debug_level);
}

static void pf_eq (PFunArgs)
{
  arithmetic_process
    (pf_EQ, page, body, vars, start, end, newstart, debug_level);
}

static void pf_add (PFunArgs)
{
  arithmetic_process
    (pf_ADD, page, body, vars, start, end, newstart, debug_level);
}

static void pf_sub (PFunArgs)
{
  if ((body == (PAGE *)NULL) || (empty_string_p (body->buffer)))
    {
      bprintf_insert (page, start, "<SUB>");
      *newstart += 4;
    }
  else
    {
      arithmetic_process
	(pf_SUB, page, body, vars, start, end, newstart, debug_level);
    }
}

static void pf_mul (PFunArgs)
{
  arithmetic_process
    (pf_MUL, page, body, vars, start, end, newstart, debug_level);
}

static void pf_div (PFunArgs)
{
  /* If it only contains assigned attributes, it is meant for the browser,
     not us. */
  if (get_positional_arg (vars, 0) == (char *)NULL)
    {
      bprintf_insert (page, start, "<DIV %s>", mhtml_funargs (vars));
      *newstart += 4;
    }
  else
    {
      arithmetic_process
	(pf_DIV, page, body, vars, start, end, newstart, debug_level);
    }
}

static void pf_mod (PFunArgs)
{
  arithmetic_process
    (pf_MOD, page, body, vars, start, end, newstart, debug_level);
}

#endif /* MHTML_ARITHMETIC */

static int randomize_called = 0;
static void
pf_randomize (PFunArgs)
{
  unsigned int seed = (unsigned int)getpid ();
  char *user_seed = mhtml_evaluate_string (get_positional_arg (vars, 0));

  if (user_seed)
    {
      seed = (unsigned int)atoi (user_seed);
      free (user_seed);
    }

  if (seed == 0) seed = 1;
  srandom (seed);
  randomize_called = 1;
}

static void
pf_random (PFunArgs)
{
  char *max_arg = mhtml_evaluate_string (get_positional_arg (vars, 0));
  int max_value = max_arg ? atoi (max_arg) : 0;
  int result;

  if (!randomize_called)
    {
      srandom ((unsigned int)getpid ());
      randomize_called++;
    }

  result = random ();

  if (max_value)
    result = result % max_value;

  if (max_arg) free (max_arg);

  bprintf_insert (page, start, "%d", result);
}

static void
pf_not (PFunArgs)
{
  int offset = 0;
  char *sexp = read_sexp (body->buffer, &offset, 0);
  char *test = mhtml_evaluate_string (sexp);

  if (empty_string_p (test))
    bprintf_insert (page, start, "true");

  if (test) free (test);
  if (sexp) free (sexp);
}

static void
pf_and (PFunArgs)
{
  register int i = 0;
  char *result = strdup ("true");
  char *temp;

  while ((temp = get_positional_arg (vars, i++)) != (char *)NULL)
    {
      char *value = mhtml_evaluate_string (temp);

      if (!empty_string_p (value))
	{
	  free (result);
	  result = value;
	}
      else
	{
	  if (value) free (value);
	  free (result);
	  result = (char *)NULL;
	  break;
	}
    }

  if (result)
    {
      bprintf_insert (page, start, "%s", result);
      free (result);
    }
}

static void
pf_or (PFunArgs)
{
  register int i = 0;
  char *result = (char *)NULL;
  char *temp;

  while ((temp = get_positional_arg (vars, i++)) != (char *)NULL)
    {
      char *value = mhtml_evaluate_string (temp);
      if (!empty_string_p (value))
	{
	  result = value;
	  break;
	}
      else if (value) free (value);
    }

  if (result)
    {
      bprintf_insert (page, start, "%s", result);
      free (result);
    }
}

static void
change_increment (PFunArgs, int default_amount)
{
  char *var_name = mhtml_evaluate_string (get_positional_arg (vars, 0));

  if (!empty_string_p (var_name))
    {
      char *var_value = pagefunc_get_variable (var_name);
      char *incr = get_one_of (vars, "BY", "AMOUNT", (char *)NULL);
      int value = 0;
      int amount = default_amount;
      static char number[40];

      if (var_value != (char *)NULL)
	value = atoi (var_value);

      if (!empty_string_p (incr))
	{
	  incr = mhtml_evaluate_string (incr);
	  if (incr)
	    {
	      amount = default_amount * atoi (incr);
	      free (incr);
	    }
	}

      value += amount;
      sprintf (number, "%d", value);

      pagefunc_set_variable (var_name, number);
    }
  if (var_name) free (var_name);
}

static void
pf_increment (PFunArgs)
{
  change_increment (page, body, vars, start, end, newstart, debug_level, 1);
}

static void
pf_decrement (PFunArgs)
{
  change_increment (page, body, vars, start, end, newstart, debug_level, -1);
}

#define MAX_SUBEXPS 10
static void
pf_match (PFunArgs)
{
  char *_string = get_positional_arg (vars, 0);
  char *_regex = get_positional_arg (vars, 1);
  char *result = (char *)NULL;

  if (_string && _regex)
    {
      char *string = mhtml_evaluate_string (_string);
      char *regex = mhtml_evaluate_string (_regex);
      int caseless = var_present_p (vars, "caseless");
      char *action = "report";

      if ((string != (char *)NULL) && (regex != (char *)NULL))
	{
	  /* Only up to MAX_SUBEXPS subexpressions kept. */
	  regex_t re;
	  regmatch_t offsets[MAX_SUBEXPS];
	  int slen = strlen (string);
	  int matched;
	  int so = 0, eo = 0, len = 0;
	  char *temp = get_value (vars, "action");
	  char *packname = mhtml_evaluate_string (get_value (vars, "package"));

	  if (temp) action = temp;

	  regcomp (&re, regex, REG_EXTENDED | (caseless ? REG_ICASE : 0));

	  matched = (regexec (&re, string, MAX_SUBEXPS, offsets, 0) == 0);

	  if (matched)
	    {
	      so = offsets[0].rm_so;
	      eo = offsets[0].rm_eo;
	      len = eo - so;
	    }

	  /* If the caller has specified a package to receive the detailed
	     results of the match, put the information there now. */
	  if (matched && packname)
	    {
	      register int i, limit;
	      Package *p = symbol_get_package (packname);
	      Symbol *starts, *ends, *lengths;
	      Symbol *matches = (Symbol *)NULL;
	      char digitbuff[40];

	      forms_set_tag_value_in_package (p, "expr", regex);
	      starts = symbol_intern_in_package (p, "start");
	      ends = symbol_intern_in_package (p, "end");
	      lengths = symbol_intern_in_package (p, "length");
	      if (strcasecmp (action, "extract") == 0)
		matches = symbol_intern_in_package (p, "matches");

	      for (limit = MAX_SUBEXPS; limit; limit--)
		if (offsets[limit - 1].rm_so != -1)
		  break;

	      sprintf (digitbuff, "%d", limit - 1);
	      forms_set_tag_value_in_package (p, "matched", digitbuff);

	      for (i = 0; i < limit; i++)
		{
		  int sublen = offsets[i].rm_eo - offsets[i].rm_so;

		  sprintf (digitbuff, "%d", offsets[i].rm_so);
		  symbol_add_value (starts, digitbuff);
		  sprintf (digitbuff, "%d", offsets[i].rm_eo);
		  symbol_add_value (ends, digitbuff);
		  sprintf (digitbuff, "%d", sublen);
		  symbol_add_value (lengths, digitbuff);

		  if (matches != (Symbol *)NULL)
		    {
		      char *substring = (char *)xmalloc (1 + sublen);
		      strncpy (substring, string + offsets[i].rm_so, sublen);
		      substring[sublen] = '\0';
		      symbol_add_value (matches, substring);
		      free (substring);
		    }
		}
	    }

	  if (packname != (char *)NULL) free (packname);
	      
	  if (matched && strcasecmp (action, "report") == 0)
	    {
	      result = strdup ("true");
	    }
	  else if (matched && (strcasecmp (action, "extract") == 0))
	    {
	      result = (char *)xmalloc (1 + len);
	      strncpy (result, string + so, len);
	      result[len] = '\0';
	    }
	  else if (strcasecmp (action, "delete") == 0)
	    {
	      result = strdup (string);
	      if (matched)
		memmove (result + so, result + eo, (slen + 1) - eo);
	    }
	  else if ((strcasecmp (action, "startpos") == 0) ||
		   (strcasecmp (action, "endpos") == 0) ||
		   (strcasecmp (action, "length") == 0))
	    {
	      result = (char *)xmalloc (20);
	      result[0]= '\0';

	      if (matched)
		{
		  if (strcasecmp (action, "startpos") == 0)
		    sprintf (result, "%d", so);
		  else if (strcasecmp (action, "endpos") == 0)
		    sprintf (result, "%d", eo);
		  else
		    sprintf (result, "%d", len);
		}
	    }
	  regfree (&re);
	}

      if (string) free (string);
      if (regex) free (regex);
    }

  if (result)
    {
      bprintf_insert (page, start, "%s", result);
      *newstart += strlen (result);
      free (result);
    }
}

/* <substring string start [end]> */
static void
pf_substring (PFunArgs)
{
  char *str_arg = mhtml_evaluate_string (get_positional_arg (vars, 0));
  char *beg_arg = mhtml_evaluate_string (get_positional_arg (vars, 1));
  char *end_arg = mhtml_evaluate_string (get_positional_arg (vars, 2));

  if (str_arg != (char *)NULL)
    {
      register int i;
      char *temp;
      int len = strlen (str_arg);
      int beg_index = 0;
      int end_index = len;

      /* If not all digits, lookup arg as variable name. */
      if (!empty_string_p (beg_arg))
	{
	  if (!number_p (beg_arg))
	    {
	      for (i = 0; whitespace (beg_arg[i]); i++);
	      temp = pagefunc_get_variable (beg_arg + i);
	      if (temp != (char *)NULL)
		beg_index = atoi (temp);
	    }
	  else
	    beg_index = atoi (beg_arg);
	}

      if (!empty_string_p (end_arg))
	{
	  if (!number_p (end_arg))
	    {
	      for (i = 0; whitespace (end_arg[i]); i++);
	      temp = pagefunc_get_variable (end_arg + i);
	      if (temp != (char *)NULL)
		end_index = atoi (temp);
	    }
	  else
	    end_index = atoi (end_arg);
	}

      if (beg_index > end_index)
	{ i = beg_index; beg_index = end_index; end_index = i; }

      if (end_index > len) end_index = len;

      if ((beg_index != end_index) && (beg_index < len))
	{
	  if ((end_index - beg_index) < 100)
	    {
	      char buffer[100];

	      strncpy (buffer, str_arg + beg_index, end_index - beg_index);
	      buffer[end_index - beg_index] = '\0';
	      bprintf_insert (page, start, "%s", buffer);
	      *newstart += (end_index - beg_index);
	    }
	  else
	    {
	      temp = (char *)xmalloc (1 + (end_index - beg_index));
	      strncpy (temp, str_arg + beg_index, end_index - beg_index);
	      temp[end_index - beg_index] = '\0';
	      bprintf_insert (page, start, "%s", temp);
	      *newstart += (end_index - beg_index);
	      free (temp);
	    }
	}
    }

  if (str_arg) free (str_arg);
  if (beg_arg) free (beg_arg);
  if (end_arg) free (end_arg);
}

static void
pf_downcase (PFunArgs)
{
  char *value = mhtml_evaluate_string (get_positional_arg (vars, 0));

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

      for (i = 0; value[i] != '\0'; i++)
	if (isupper (value[i]))
	  value[i] = tolower (value[i]);

      bprintf_insert (page, start, "%s", value);
      *newstart += i;
      free (value);
    }
}

static void
pf_upcase (PFunArgs)
{
  char *value = mhtml_evaluate_string (get_positional_arg (vars, 0));

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

      for (i = 0; value[i] != '\0'; i++)
	if (islower (value[i]))
	  value[i] = toupper (value[i]);

      bprintf_insert (page, start, "%s", value);
      *newstart += i;
      free (value);
    }
}

static void
pf_capitalize (PFunArgs)
{
  char *value = mhtml_evaluate_string (get_positional_arg (vars, 0));

  if (value != (char *)NULL)
    {
      register int i;
      int capnext = 1;

      for (i = 0; value[i] != '\0'; i++)
	{
	  if (!isalpha (value[i]))
	    capnext = 1;
	  else
	    {
	      if (capnext)
		{
		  if (islower (value[i]))
		    value[i] = toupper (value[i]);

		  capnext = 0;
		}
	      else
		{
		  if (isupper (value[i]))
		    value[i] = tolower (value[i]);
		}
	    }
	}

      bprintf_insert (page, start, "%s", value);
      *newstart += i;
      free (value);
    }
}

static void
pf_string_compare (PFunArgs)
{
  char *string_1 = mhtml_evaluate_string (get_positional_arg (vars, 0));
  char *string_2 = mhtml_evaluate_string (get_positional_arg (vars, 1));
  int caseless_p = get_value (vars, "caseless") != (char *)NULL;
  char *result = (char *)NULL;

  /* Both strings empty? */
  if (string_1 == string_2)
    result = "equal";
  else if (string_1 == (char *)NULL)
    result = "less";
  else if (string_2 == (char *)NULL)
    result = "greater";
  else
    {
      int temp;

      if (caseless_p)
	temp = strcasecmp (string_1, string_2);
      else
	temp = strcmp (string_1, string_2);

    switch (temp)
      {
      case 0: result = "equal"; break;
      case 1: result = "greater"; break;
      case -1: result = "less"; break;
      }
    }

  if (string_1 != (char *)NULL) free (string_1);
  if (string_2 != (char *)NULL) free (string_2);

  if (result)
    {
      bprintf_insert (page, start, "%s", result);
      *newstart = start + strlen (result);
    }
}

static void
pf_word_wrap (PFunArgs)
{
  char *width_spec = mhtml_evaluate_string (get_value (vars, "width"));
  char *indent_spec = mhtml_evaluate_string (get_value (vars, "indent"));
  int width = (width_spec != (char *)NULL) ? atoi (width_spec) : 60;
  int indent = (indent_spec != (char *)NULL) ? atoi (indent_spec) : 0;
  char *text = mhtml_evaluate_string (get_positional_arg (vars, 0));

  if (width == 0) width = 60;
  if (indent > width) indent = width;
  if (indent < 0) indent = 0;

  if (!empty_string_p (text))
    {
      BPRINTF_BUFFER *temp = bprintf_create_buffer ();

      bprintf (temp, "%s", text);
      bprintf_word_wrap (temp, width);

      if (indent)
	{
	  register int i;
	  char *indent_string = (char *)xmalloc (1 + indent);

	  for (i = 0; i < indent; i++) indent_string[i] = ' ';
	  indent_string[i] = '\0';

	  /* Kill leading indentation on the first line. */
	  for (i = 0; (i < temp->bindex) && (whitespace (temp->buffer[i])); i++);
	  if (i) bprintf_delete_range (temp, 0, i);

	  /* Indent the first line. */
	  bprintf_insert (temp, 0, "%s", indent_string);

	  /* Now do the rest. */
	  while (i < temp->bindex)
	    {
	      if (temp->buffer[i] == '\n')
		{
		  bprintf_insert (temp, i + 1, "%s", indent_string);
		  i += indent;
		}
	      i++;
	    }
	}
	  
      bprintf_insert (page, start, "%s", temp->buffer);
      *newstart += temp->bindex;
      bprintf_free_buffer (temp);
    }

  xfree (text);
  xfree (width_spec);
  xfree (indent_spec);
}

static void
pf_comment (PFunArgs)
{
  /* Contents already deleted by caller. */
}

/* Does modifications to the plain text in BODY.  Usually, this simply
   inserts paragraph breaks where they appear, and optionally operates
   on the first character of paragraphs.  The text starts with a <P>,
   unless the variable NOBR is set.*/
static void
pf_plain_text (PFunArgs)
{
  register int i;
  char *first_char;
  char *nobr = mhtml_evaluate_string (get_value (vars, "NOBR"));
  char *nolower = mhtml_evaluate_string (get_value (vars, "NOLOWER"));

  first_char = mhtml_evaluate_string (get_value (vars, "FIRST-CHAR"));

  /* Remove all comments from BODY. */
  page_subst_in_page (body, ";;;[^\n]*(\n|$)", "");

  /* Insert one blank line in the front of BODY. */
  bprintf_insert (body, 0, "<p>");

  /* Modify blank lines in BODY such that they contain <p> instead. */
  page_subst_in_page (body, "\n[ \t]*\n", "<p>\n");

  /* Modify the first character of every paragraph by inserting the
     open tag before it, and inserting a matching close tag after it. */
  if (first_char)
    {
      register int begin;
      char *closer = (char *)NULL;
      int o_len = strlen (first_char);
      int c_len = 0;

      if (*first_char == '<')
	{
	  register int c;

	  for (i = 1; whitespace (first_char[i]); i++);

	  begin = i;

	  for (i = begin; (c = first_char[i]) != '\0'; i++)
	    if ((c == '>') || (whitespace (c)))
	      break;

	  closer = (char *)xmalloc (4 + (i - begin));
	  closer[0] = '<';
	  closer[1] = '/';
	  strncpy (closer + 2, first_char + begin, i - begin);
	  closer[(i - begin) + 2] = '>';
	  closer[(i - begin) + 3] = '\0';
	  c_len = strlen (closer);
	}

      /* Now quickly find occurences of "<p>" in BODY. */
      begin = 0;

      while ((begin = page_search (body, "<p>", begin)) != -1)
	{
	  begin += 3;

	  while (begin < body->bindex && whitespace (body->buffer[begin]))
	    begin++;

	  if ((begin < body->bindex) && (isalnum (body->buffer[begin])) &&
	      ((empty_string_p (nolower)) || (isupper (body->buffer[begin]))))
	    {
	      /* Insert closer first, if present. */
	      if (closer)
		bprintf_insert (body, begin + 1, "%s", closer);

	      /* Now insert the opener. */
	      bprintf_insert (body, begin, "%s", first_char);

	      /* Bump BEGIN past just inserted text. */
	      begin += o_len + c_len;
	    }
	}
      if (closer) free (closer);
    }

  /* Insert the modified body. */
  bprintf_insert (page, start, "%s", body->buffer + (nobr ? 3 : 0));
  xfree (nobr);
  xfree (nolower);
  xfree (first_char);
}

static int include_recursive_calls = 0;

static void
pf_include (PFunArgs)
{
  int verbatim_p = var_present_p (vars, "VERBATIM");
  char *pathname = (char *)NULL;

  include_recursive_calls++;
  if (include_recursive_calls < MHTML_INCLUDE_RECURSION_LIMIT)
    {
      char *arg = mhtml_evaluate_string (get_positional_arg (vars, 0));
      char *incpref = pagefunc_get_variable ("%%::incpref");
      char *relpref = pagefunc_get_variable ("%%::relpref");

      if (!incpref) incpref = pagefunc_get_variable ("mhtml::include-prefix");
      if (!relpref) relpref = pagefunc_get_variable ("mhtml::relative-prefix");

      if (arg != (char *)NULL)
	{
	  PAGE *file_contents = (PAGE *)NULL;

	  pathname = mhtml_canonicalize_file_name (arg, incpref, relpref);

	  if (!empty_string_p (pathname))
	    file_contents = page_read_template (pathname);

	  /* Did the user specify some alternate HTML if the file
	     couldn't be found? */
	  if (!file_contents)
	    {
	      char *alt = mhtml_evaluate_string
		(get_one_of (vars, "ALT", "ALTERNATE", (char *)0));

	      if (alt != (char *)NULL)
		{
		  verbatim_p = 0;
		  file_contents = page_create_page ();
		  bprintf (file_contents, "%s", alt);
		  free (alt);
		}
	    }

	  if (file_contents)
	    {
#if defined (NOT_BINARY_COMPATIBLE)
	      bprintf_insert (page, start, "%s", file_contents->buffer);
#else
	      /* Manually insert the file instead of letting bprintf
		 do it for us.  This is because the file could contain
		 binary data, and then file->bindex wouldn't necessarily
		 reflect the length of what was inserted. */
	      if ((file_contents->bindex + page->bindex) >= page->bsize)
		page->buffer = (char *)xrealloc
		(page->buffer, (page->bsize += (file_contents->bindex + 100)));

	      memmove (page->buffer + start + file_contents->bindex,
		       page->buffer + start,
		       (page->bindex + 1) - start);

	      memcpy (page->buffer + start, file_contents->buffer,
		      file_contents->bindex);
	      page->bindex += file_contents->bindex;
#endif /* BINARY_COMPATIBLE */

	      if (verbatim_p)
		*newstart += file_contents->bindex;
#if defined (MHTML_INCLUDE_IS_RELATIVE)
	      else if (!empty_string_p (relpref))
		{
		  char *temp = strstr (pathname, incpref);

		  if (temp != (char *)NULL)
		    {
		      char *last;

		      temp += strlen (incpref);
		      last = strrchr (temp, '/');

		      if (last != (char *)NULL)
			{
			  *last = '\0';

			  bprintf_insert
			    (page, start + file_contents->bindex,
			     "<set-var %%%%::relpref=%s>", relpref);

			  pagefunc_set_variable ("%%::relpref", temp);

			}
		    }
		}
#endif /* MHTML_INCLUDE_IS_RELATIVE */

	      page_free_page (file_contents);
	    }
	  free (arg);
	}
    }
  if (pathname != (char *)NULL) free (pathname);
  include_recursive_calls--;
}

static void
pf_replace_page (PFunArgs)
{
  PAGE *newpage = page_create_page ();
  int newpage_start = 0;

  pf_include (newpage, body, vars, 0, 0, &newpage_start, debug_level);
  page_process_page_internal (newpage);
  page_return_this_page (newpage);
}

#define OTHER 1
#define UPPER 2
#define LOWER 3

#define CLOSE_STATE \
  switch (state) \
    { \
    case OTHER: bprintf (buffer, "%s", other_close); break; \
    case UPPER: bprintf (buffer, "%s", upper_close); break; \
    case LOWER: bprintf (buffer, "%s", lower_close); break; \
    }

static char *
wrap_by_character_class (char *string, int small_caps_p, int leave_braces,
			 char *upper_open, char *upper_close,
			 char *lower_open, char *lower_close,
			 char *other_open, char *other_close)
{
  register int i, c, state;
  char *result;
  BPRINTF_BUFFER *buffer;

  /* Handle easiest case first. */
  if (!string)
    return ((char *)NULL);

  if (!upper_open) upper_open = "";
  if (!upper_close) upper_close = "";
  if (!lower_open) lower_open = "";
  if (!lower_close) lower_close = "";
  if (!other_open) other_open = "";
  if (!other_close) other_close = "";

  buffer = bprintf_create_buffer ();

  state = 0;

  for (i = 0; (c = string[i]) != '\0'; i++)
    {
      if (isupper (c) && state != UPPER)
	{
	  CLOSE_STATE;
	  state = UPPER;
	  bprintf (buffer, "%s", upper_open);
	}
      else if (islower (c) && state != LOWER)
	{
	  CLOSE_STATE;
	  state = LOWER;
	  bprintf (buffer, "%s", lower_open);
	}
      else if (isspace (c))
	{
	}
      else if (leave_braces && ((c == '<') || (c == '>')))
	{
	  int point = i;
	  char *sexp;

	  CLOSE_STATE;
	  state = 0;
	  sexp = read_sexp_1 (string, &point, 0, 1);
	  if (sexp != (char *)NULL)
	    {
	      bprintf (buffer, "%s", sexp);
	      free (sexp);
	      c = '\0';
	      i = point - 1;
	    }
	}
      else if (!(isupper (c) || islower (c)) && state != OTHER)
	{
	  CLOSE_STATE;
	  state = OTHER;
	  bprintf (buffer, "%s", other_open);
	}

      if (small_caps_p && islower (c))
	c = toupper (c);

      if (c)
	bprintf (buffer, "%c", c);
    }

  CLOSE_STATE;

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

  return (result);
}

static void
pf_small_caps (PFunArgs)
{
  char *string = mhtml_evaluate_string (body->buffer);

  if (string)
    {
      char *upper_size = get_one_of (vars, "upper", "upper-size", (char *)0);
      char *lower_size = get_one_of (vars, "lower", "lower-size", (char *)0);
      char *other_size = get_one_of (vars, "other", "other-size", (char *)0);
      char uo[100], lo[100], oo[1000], *cl = "</FONT>";
      char *result;

      if (!upper_size) upper_size = "+0";
      if (!lower_size) lower_size = "-1";
      if (!other_size) other_size = "+0";

      sprintf (uo, "<FONT SIZE=\"%s\">", upper_size);
      sprintf (lo, "<FONT SIZE=\"%s\">", lower_size);
      sprintf (oo, "<FONT SIZE=\"%s\">", other_size);

      result = wrap_by_character_class (string, 1, 1, uo, cl, lo, cl, oo, cl);
      bprintf_insert (page, start, "%s", result);
      free (string);
      free (result);
    }
}

char *
html_quote_string (char *string)
{
  BPRINTF_BUFFER *newstring = bprintf_create_buffer ();
  char *result;

  if (string != (char *)NULL)
    {
      register int i;

      for (i = 0; string[i] != '\0'; i++)
	{
	  if (string[i] == '<')
	    bprintf (newstring, "&lt;");
	  else if (string[i] == '>')
	    bprintf (newstring, "&gt;");
	  else if (string[i] == '&')
	    bprintf (newstring, "&amp;");
	  else
	    bprintf (newstring, "%c", string[i]);
	}
    }

  result = newstring->buffer;
  free (newstring);

  return (result);
}

/* Pad the input text.  ALIGN can be one of LEFT, MIDDLE, or RIGHT.
   Insert the correct number of spaces to make the input argument
   take the desired number of spaces (presumably for use in a
   <pre> ... </pre> statement).  ALIGN defaults to "RIGHT".
   Optional arg "TRUNCATE" says to force the string to be the specified
   length.  Calling sequence:

      <pad <get-var foo> 23 align=middle truncate>
*/

#define align_RIGHT  0
#define align_LEFT   1
#define align_MIDDLE 2

static void
pf_pad (PFunArgs)
{
  register int i;
  char *input = mhtml_evaluate_string (get_positional_arg (vars, 0));
  char *wtext = mhtml_evaluate_string (get_positional_arg (vars, 1));
  char *align = mhtml_evaluate_string (get_value (vars, "ALIGN"));
  int truncation = var_present_p (vars, "TRUNCATE");
  int width = wtext ? atoi (wtext) : 15;
  int alignment = align_RIGHT;
  int input_len = input ? strlen (input) : 0;

  if (align)
    {
       if (strcasecmp (align, "left") == 0)
	 alignment = align_LEFT;
       else if ((strcasecmp (align, "middle") == 0) ||
		(strcasecmp (align, "center") == 0))
	 alignment = align_MIDDLE;

       free (align);
     }

  if (wtext) free (wtext);

  if (!input)
    return;

  /* Strip leading and trailing whitespace from the input. */
  if (input_len)
    {
      for (i = 0; whitespace (input[i]); i++);
      if (i)
	memmove (input, input + i, (input_len - i) + 1);

      for (i = strlen (input) - 1; i > -1; i--)
	if (!whitespace (input[i]))
	  break;

      input[i + 1] = '\0';
      input_len = i + 1;
    }

  /* Handle truncation. */
  if (input_len > width)
    {
      if (truncation)
	input[width] = '\0';
    }
  else
    {
      int offset = 0;
      int left_pad = 0;
      int right_pad = 0;
      char *string = (char *)xmalloc (2 + width);

      /* Get the amount to pad on the left and right. */
      switch (alignment)
	{
	case align_LEFT:
	  right_pad = width - input_len;
	  break;

	case align_RIGHT:
	  left_pad = width - input_len;
	  break;

	case align_MIDDLE:
	  left_pad = (width - input_len) ? (width - input_len) / 2 : 0;
	  right_pad = width - (input_len + left_pad);
	  break;
	}

      /* Put the left-hand spaces in place. */
      for (offset = 0; offset < left_pad; offset++)
	string[offset] = ' ';

      /* Drop the input string down. */
      for (i = 0; (string[offset] = input[i]) != '\0'; i++, offset++);

      /* Put the right-hand spaces in place. */
      for (i = 0; i < right_pad; i++)
	string[offset++] = ' ';

      /* Terminate the string. */
      string[offset] = '\0';

      free (input);
      input = string;
    }

  if (input)
    {
      bprintf_insert (page, start, "%s", input);
      free (input);
    }
}

static void
pf_subst_in_page (PFunArgs)
{
  int arg = 0, done = 0;

  while (!done)
    {
      char *this, *that;

      this = get_positional_arg (vars, arg++);
      that = get_positional_arg (vars, arg++);

      if (this == (char *)NULL)
	done = 1;
      else
	{
	  this = mhtml_evaluate_string (this);
	  that = mhtml_evaluate_string (that);

	  if (this)
	    page_subst_in_page_pivot (page, this, that, &start);

	  if (this) free (this);
	  if (that) free (that);
	}
    }
  *newstart = start;
}

static char *
subst_in_string_internal (char *contents, Package *vars, int debug_level)
{
  char *result = (char *)NULL;

  if (contents != (char *)NULL)
    {
      int done = 0;
      int arg = 1;
      PAGE *temp = page_create_page ();
      page_set_contents (temp, contents);

      while (!done)
	{
	  char *this = get_positional_arg (vars, arg++);
	  char *that = get_positional_arg (vars, arg++);

	  if (this == (char *)NULL)
	    done = 1;
	  else
	    {
	      this = mhtml_evaluate_string (this);
	      that = mhtml_evaluate_string (that);

	      if (debug_level > 5)
		page_debug
		  ("<subst-in-var \"%s\" \"%s\" \"%s\">",
		   contents, this, that ? that : "");

	      if (this)
		page_subst_in_page (temp, this, that);

	      if (debug_level > 5)
		page_debug ("--> `%s'", temp->buffer ? temp->buffer : "");

	      if (this) free (this);
	      if (that) free (that);
	    }
	}

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

  return (result);
}

static void
pf_subst_in_var (PFunArgs)
{
  char *varname = mhtml_evaluate_string (get_positional_arg (vars, 0));

  if (!empty_string_p (varname))
    {
      char *contents = pagefunc_get_variable (varname);
      char *result = subst_in_string_internal (contents, vars, debug_level);

      pagefunc_set_variable (varname, result);
      if (result) free (result);
    }

  if (varname != (char *)NULL) free (varname);
}

static void
pf_subst_in_string (PFunArgs)
{
  char *contents = mhtml_evaluate_string (get_positional_arg (vars, 0));

  if (contents != (char *)NULL)
    {
      char *result = subst_in_string_internal (contents, vars, debug_level);

      free (contents);

      if (result)
	{
	  bprintf_insert (page, start, "%s", result);
	  free (result);
	}
    }
}

static void
pf_with_local_package (PFunArgs)
{
  int jump_again = 0;
  Package *current_package = CurrentPackage;
  char *result = (char *)NULL;

  {
    PageEnv *page_environ = pagefunc_save_environment ();
    Package *temp = symbol_get_package ((char *)NULL);

    CurrentPackage = temp;

    if ((jump_again = setjmp (page_jmp_buffer)) == 0)
      result = mhtml_evaluate_string (body->buffer);

    CurrentPackage = current_package;
    symbol_destroy_package (temp);
    pagefunc_restore_environment (page_environ);
  }

  if (result != (char *)NULL)
    {
      if (jump_again == 0)
	bprintf_insert (page, start, "%s", (char *)result);
      free ((char *)result);
    }
  if (jump_again) longjmp (page_jmp_buffer, 1);
}

static void
pf_in_package (PFunArgs)
{
  int jump_again = 0;
  char *packname = mhtml_evaluate_string (get_positional_arg (vars, 0));
  char *result = (char *)NULL;

  if (empty_string_p (packname))
    {
      if (packname) free (packname);
      packname = strdup ("DEFAULT");
    }

  if (strcasecmp (packname, "local") == 0)
    {
      free ((char *)packname);
      packname = (char *)NULL;
    }

  {
    PageEnv *page_environ = pagefunc_save_environment ();
    Package *current_package = CurrentPackage;

    CurrentPackage = symbol_get_package (packname);

    if ((jump_again = setjmp (page_jmp_buffer)) == 0)
      result = mhtml_evaluate_string (body->buffer);

    CurrentPackage = current_package;

    pagefunc_restore_environment (page_environ);
  }

  if (result != (char *)NULL)
    {
      if (jump_again == 0)
	bprintf_insert (page, start, "%s", (char *)result);
      free ((char *)result);
    }

  if (packname) free (packname);
  if (jump_again) longjmp (page_jmp_buffer, 1);
}

#if defined (NOT_AT_THIS_TIME)
static void
pf_page_search (PFunArgs)
{
  char *search_start = mhtml_evaluate_string (get_positional_arg (vars, 0));
  char *search_string = mhtml_evaluate_string (get_positional_arg (vars, 1));

  if ((!empty_string_p (search_start)) && (!empty_string_p (search_string)) &&
      (ThePage != (PAGE *)NULL))
    {
      int loc = atoi (search_start);

      if (loc < ThePage->bindex)
	{
	  int end_point, beg_point;

	  beg_point =
	    page_search_boundaries (ThePage, search_string, loc, &end_point);

	  if (beg_point != -1)
	    {
	      int use_end_p = var_present_p (vars, "end");

	      bprintf_insert (page, start, "%d",
			      use_end_p ? end_point : beg_point);
	    }
	}
    }
}

static void
pf_page_insert (PFunArgs)
{
  char *insert_loc = mhtml_evaluate_string (get_positional_arg (vars, 0));
  char *insertion = mhtml_evaluate_string (get_positional_arg (vars, 1));

  if ((!empty_string_p (insert_loc)) && (!empty_string_p (insertion)))
    {
      int loc = atoi (insert_loc);

      if ((loc > -1) && (loc < ThePage->bindex))
	{
	  bprintf_insert (ThePage, loc, "%s", insertion);
	  if ((loc < start) && (ThePage == page))
	    *newstart += strlen (insertion);
	}
    }
}
#endif /* NOT_AT_THIS_TIME */

static void
pf_redirect (PFunArgs)
{
  PAGE *new_page;
  char *arg = (char *)NULL;
  char *protocol = pagefunc_get_variable ("env::server_protocol");
  char *protover = pagefunc_get_variable ("env::protocol_version");

  if (!protocol) protocol = "HTTP";
  if (!protover) protover = "1.0";

  if ((body != (PAGE *)NULL) && (body->buffer != (char *)NULL))
    {
      int offset = 0;
      char *sexp = read_sexp (body->buffer, &offset, 0);

      if (!empty_string_p (sexp))
	arg =  mhtml_evaluate_string (sexp);

      xfree (sexp);
    }

  new_page = page_create_page ();

  /* If there is something to redirect to, then do it now.
     Otherwise, return a null response code, indicating that the
     browser should retain the old view. */
  if (!empty_string_p (arg))
    {
      register int i;

      for (i = 0; whitespace (arg[i]); i++);

      /* Fully qualify ARG if it isn't already. */
      if ((strncasecmp (arg + i, "http://", 7) != 0) &&
	  (strncasecmp (arg + i, "https://", 8) != 0) &&
	  (strncasecmp (arg + i, "ftp://", 6) != 0) &&
	  (strncasecmp (arg + i, "gopher://", 9) != 0))
	{
	  BPRINTF_BUFFER *newarg = bprintf_create_buffer ();
	  char *temp = pagefunc_get_variable ("mhtml::relative-prefix");

	  /* We can't do a complete canonicalization of the name here,
	     because there isn't any way to tell where the PATH_INFO
	     part of the name begins, if any.  But, we can strip double
	     dots which appear at the start of the name. */
	  if (temp != (char *)NULL)
	    {
	      temp = strdup (temp);

	      while (strncmp (arg + i, "../", 3) == 0)
		{
		  char *slash = strrchr (temp, '/');

		  if (slash != (char *)NULL)
		    {
		      *slash = '\0';
		      i += 3;
		    }
		}
	    }

	  bprintf (newarg, "%s", pagefunc_get_variable ("mhtml::http-prefix"));
	  if (arg[i] != '/')
	    bprintf (newarg, "%s/%s", temp ? temp : "", arg + i);
	  else
	    bprintf (newarg, "%s", arg + i);

	  xfree (temp);
	  free (arg);
	  arg = newarg->buffer;
	  free (newarg);
	  i = 0;
	}

#if defined (macintosh)
      bprintf (new_page,  "%s/%s 302 Found\nLocation: %s\n\n",
	       protocol, protover, arg + i);
#else
      if (pagefunc_get_variable ("mhtml::unparsed-headers"))
	bprintf (new_page, "%s/%s 302 Found\nLocation: %s\n\n",
		 protocol, protover, arg + i);
      else
	bprintf (new_page, "Location: %s\n\n", arg + i);
#endif /* !macintosh */
    }
  else
    bprintf (new_page, "%s/%s.0 204 No Response\n\n", protocol, protover);

  if (arg) free (arg);
  page_return_this_page (new_page);
}

static void
pf_cgi_encode (PFunArgs)
{
  char **names = get_vars_names (vars);

  if (names != (char **)NULL)
    {
      register int i;
      char *name;
      char *result = (char *)NULL;
      Package *cgivars = symbol_get_package ((char *)NULL);
      Symbol **symbols = (Symbol **)NULL;
      int save_case_p = 0;

      {
	char *temp = mhtml_evaluate_string (get_value (vars, "preserve-case"));
	if (!empty_string_p (temp)) save_case_p++;
      }

      for (i = 0; (name = names[i]) != (char *)NULL; i++)
	{
	  name = mhtml_evaluate_string (name);

	  if (!empty_string_p (name))
	    {
	      Symbol *sym = symbol_lookup (name);
	      if ((sym != (Symbol *)NULL) && (sym->type == symtype_STRING))
		{
		  register int j;
		  Symbol *newsym = symbol_intern_in_package (cgivars, name);

		  if (save_case_p)
		    newsym->preserved_name = strdup (name);

		  for (j = 0; j < sym->values_index; j++)
		    symbol_add_value (newsym, sym->values[j]);
		}
	    }

	  if (name) free (name);
	}

      symbols = symbols_of_package (cgivars);
      result = forms_unparse_items (symbols);

      if (!empty_string_p (result))
	{
	  bprintf_insert (page, start, "%s", result);
	  *newstart = start + strlen (result);
	}

      if (result) free (result);
      if (symbols) free (symbols);
      symbol_destroy_package (cgivars);
    }
}

/* <cgi-decode string [package]> Decode STRING into PACKAGE.
   If PACKAGE is not specified the current package is used. */
static void
pf_cgi_decode (PFunArgs)
{
  char *string, *packname = (char *)NULL;
  char *temp;
  Package *package = CurrentPackage;
  int offset = 0;

  string = read_sexp (body->buffer, &offset, 0);
  packname = read_sexp (body->buffer, &offset, 0);

  if (string != (char *)NULL)
    {
      temp = mhtml_evaluate_string (string);
      free (string);
      string = temp;
    }

  if (!empty_string_p (string))
    {
      if (packname != (char *)NULL)
	{
	  temp = mhtml_evaluate_string (packname);
	  free (packname);
	  packname = temp;

	  if (!empty_string_p (packname))
	    package = symbol_get_package (packname);

	  if (packname != (char *)NULL)
	    free (packname);
	}

      forms_parse_data_string (string, package);
    }

  if (string != (char *)NULL)
    free (string);
}

/* Insert the contents of the body verbatim.
   With optional arg "quote", quote the string being inserted. */
static void
pf_verbatim (PFunArgs)
{
  int quote_p = var_present_p (vars, "quote");

  /* Insert the contents, and then skip past them. */
  if (body && body->buffer)
    {
      char *string = body->buffer;

      if (quote_p)
	string = html_quote_string (string);

      if (string != (char *)NULL)
	{
	  bprintf_insert (page, start, "%s", string);
	  *newstart = start + strlen (string);

	  if (quote_p)
	    free (string);
	}
    }
}

static void
pf_package_to_alist (PFunArgs)
{
  char *packname = mhtml_evaluate_string (get_positional_arg (vars, 0));
  char *strip = get_value (vars, "STRIP");
  char *result = (char *)NULL;
  Package *package = (Package *)NULL;

  if (!empty_string_p (packname))
    package = symbol_lookup_package (packname);
  else
    package = CurrentPackage;

  if (packname != (char *)NULL) free (packname);

  if (package != (Package *)NULL)
    result = package_to_alist (package, (strip != (char *)NULL));

  if (result)
    {
      bprintf_insert (page, start, "%s", result);
      *newstart += strlen (result);
      free (result);
    }
}

static void
pf_alist_to_package (PFunArgs)
{
  char *alist = mhtml_evaluate_string (get_positional_arg (vars, 0));
  char *packname = mhtml_evaluate_string (get_positional_arg (vars, 1));

  if (!empty_string_p (alist))
    {
      Package *from = (Package *)NULL;
      Package *to = (Package *)NULL;

      from = alist_to_package (alist);

      if (from)
	{
	  Symbol **symbols = symbols_of_package (from);

	  if (packname == (char *)NULL)
	    packname = strdup (DEFAULT_PACKAGE_NAME);

	  if (symbols != (Symbol **)NULL)
	    {
	      register int i;
	      Symbol *sym, *copy;

	      to = symbol_get_package (packname);

	      for (i = 0; (sym = symbols[i]) != (Symbol *)NULL; i++)
		{
		  char *sym_name = sym->name;
		  char *temp = strstr (sym_name, "::");

		  if (temp)
		    sym_name = temp + 2;

		  copy = symbol_copy (sym, to);
		  if (temp)
		    symbol_rename (copy, sym_name);
		}
	      free (symbols);
	    }

	  symbol_destroy_package (from);
	}
    }
  if (alist) free (alist);
  if (packname) free (packname);
}

static void
pf_time (PFunArgs)
{
  unsigned long ticks = (unsigned long)time ((time_t *)0);

  bprintf_insert (page, start, "%ld", ticks);
}

static void
pf_pid (PFunArgs)
{
  pid_t pid = getpid ();

  bprintf_insert (page, start, "%ld", (unsigned long)pid);
}

/* Here's a wild one.

   <server-push>
     <html>
     <head><title>Just a Moment, please</title></head>
     <body>
     <h3>Please wait a moment, we are searching the entire Web...</h3>
     </body>
     </html>
   </server-push>

   Immediately sends this stuff down the line, but doesn't affect
   processesing or the current page. */
static void
pf_server_push (PFunArgs)
{
  PAGE *text = (PAGE *)NULL;
  static int called_yet = 0;
  static int output_fd = 0;
  char *type = mhtml_evaluate_string (get_value (vars, "type"));

  if (body && body->buffer)
    {
      text = page_create_page ();
      page_set_contents (text, body->buffer);
      page_process_page_internal (text);

      if (text && text->buffer)
	{
	  PAGE *pushed = page_create_page ();
	  char *boundary = "Meta-HTML-server-push-boundary";

	  /* Only do this for the first time through. */
	  if (!called_yet)
	    {
	      char *nph = pagefunc_get_variable ("mhtml::unparsed-headers");
	      Symbol *sym = symbol_remove ("mhtml::unparsed-headers");

	      called_yet++;

	      output_fd = mhtml_stdout_fileno;

	      if (nph)
		bprintf (pushed, "HTTP/1.0 200\n");

	      symbol_free (sym);
	      pagefunc_set_variable ("mhtml::server-pushed", "true");
	      bprintf (pushed, "Content-type: multipart/x-mixed-replace;");
	      bprintf (pushed, "boundary=%s\n\n", boundary);
	      bprintf (pushed, "%s\n", boundary);
	    }

	  if (type == (char *)NULL)
	    type = strdup ("text/html");

	  bprintf (pushed, "Content-type: %s\n", type);
	  bprintf (pushed, "Content-length: %d\n\n", text->bindex);
	  write (output_fd, pushed->buffer, pushed->bindex);
	  write (output_fd, text->buffer, text->bindex);
	  page_free_page (text);
	  write (output_fd, "\n", 1);
	  write (output_fd, boundary, strlen (boundary));
	  write (output_fd, "\n", 1);
	  free (type);
	  page_free_page (pushed);
	}
    }
}

static void
pf_date (PFunArgs)
{
  char *tstring = mhtml_evaluate_string (get_positional_arg (vars, 0));
  char *gmt = get_value (vars, "gmt");
  time_t ticks = tstring ? (time_t)atol (tstring) : (time_t)time ((time_t *)0);
  char *time_string = ctime (&ticks);
  char *temp = strchr (time_string, '\n');

  if (temp) *temp = '\0';

  if (gmt != (char *)NULL)
    time_string = http_date_format ((long) ticks);

  bprintf_insert (page, start, "%s", time_string);
  *newstart += strlen (time_string);
  if (tstring) free (tstring);
}

static void
pf_debugging_output (PFunArgs)
{
  register int i = 0;
  char *text;
  static char *token_name = "<DEBUGGING-OUTPUT>";

  while ((text = get_positional_arg (vars, i)) != (char *)NULL)
    {
      char *arg = mhtml_evaluate_string (text);

      if (!empty_string_p (arg))
	{
	  if (strcasecmp (arg, "clear") == 0)
	    {
	      page_debug_clear ();
	    }
	  else if (strcasecmp (arg, "retrieve") == 0)
	    {
	      char *contents = page_debug_buffer ();

	      if (contents != (char *)NULL)
		{
		  bprintf_insert (page, start, "%s", contents);
		  *newstart = start + strlen (contents) - 1;
		}
	    }
	}
      xfree (arg);
      i++;
    }

  if (i == 0)
    {
      bprintf_insert (page, start, token_name);
      *newstart = start + strlen (token_name) - 1;
    }
}

static void
pf_system_error_output (PFunArgs)
{
  register int i = 0;
  char *text;
  static char *token_name = "<SYSTEM-ERROR-OUTPUT>";

  while ((text = get_positional_arg (vars, i)) != (char *)NULL)
    {
      char *arg = mhtml_evaluate_string (text);

      if (!empty_string_p (arg))
	{
	  if (strcasecmp (arg, "clear") == 0)
	    {
	      page_syserr_clear ();
	    }
	  else if (strcasecmp (arg, "retrieve") == 0)
	    {
	      char *contents = page_syserr_buffer ();

	      if (contents != (char *)NULL)
		{
		  bprintf_insert (page, start, "%s", contents);
		  *newstart = start + strlen (contents) - 1;
		}
	    }
	}
      xfree (arg);
      i++;
    }

  if (i == 0)
    {
      bprintf_insert (page, start, token_name);
      *newstart = start + strlen (token_name) - 1;
    }
}
