/* error handling common to all routines. */
/* Copyright (c) 1992, 1995 John E. Davis
 * All rights reserved.
 *
 * You may distribute under the terms of either the GNU General Public
 * License or the Perl Artistic License.
 */

#include "config.h"
#include "sl-feat.h"

#include <stdio.h>
#include <string.h>
#include <stdarg.h>

#ifdef HAVE_STDLIB_H
# include <stdlib.h>
#endif

#include "slang.h"
#include "_slang.h"

void (*SLang_VMessage_Hook) (char *, va_list);
void (*SLang_Error_Hook)(char *);
void (*SLang_Exit_Error_Hook)(char *, va_list);
volatile int SLang_Error = 0;
char *SLang_Error_Message;
volatile int SLKeyBoard_Quit = 0;

static char *get_error_string (void)
{
   char *str;

   if (!SLang_Error) SLang_Error = SL_UNKNOWN_ERROR;
   if (SLang_Error_Message != NULL) str = SLang_Error_Message;
   else switch(SLang_Error)
     {
      case SL_NOT_IMPLEMENTED: str = "Not Implemented"; break;
      case SL_APPLICATION_ERROR: str = "Application Error"; break;
      case SL_VARIABLE_UNINITIALIZED: str = "Variable Uninitialized"; break;
      case SL_MALLOC_ERROR : str = "Malloc Error"; break;
      case SL_INTERNAL_ERROR: str = "Internal Error"; break;
      case SL_STACK_OVERFLOW: str = "Stack Overflow"; break;
      case SL_STACK_UNDERFLOW: str = "Stack Underflow"; break;
      case SL_INTRINSIC_ERROR: str = "Intrinsic Error"; break;
      case SL_USER_BREAK: str = "User Break"; break;
      case SL_UNDEFINED_NAME: str = "Undefined Name"; break;
      case SL_SYNTAX_ERROR: str = "Syntax Error"; break;
      case SL_DUPLICATE_DEFINITION: str = "Duplicate Definition"; break;
      case SL_TYPE_MISMATCH: str = "Type Mismatch"; break;
      case SL_READONLY_ERROR: str = "Variable is read-only"; break;
      case SL_DIVIDE_ERROR: str = "Divide by zero"; break;
      case SL_OBJ_NOPEN: str = "Object not opened"; break;
      case SL_OBJ_UNKNOWN: str = "Object unknown"; break;
      case SL_INVALID_PARM: str = "Invalid Parameter"; break;
      case SL_TYPE_UNDEFINED_OP_ERROR:
	str = "Operation not defined for datatype"; break;
      case SL_USER_ERROR:
	str = "User Error"; break;
      case SL_UNKNOWN_ERROR:
      default: str = "Unknown Error Code";
     }

   SLang_Error_Message = NULL;
   return str;
}

void SLang_doerror (char *error)
{
   char err_buf [1024];
   char *str = NULL;
   char *sle = "S-Lang Error: ";
   char *err;

   err = err_buf;
   *err = 0;

   if ((SLang_Error == SL_USER_ERROR)
       && (error != NULL) && (*error != 0))
     err = error;
   else
     {
	str = get_error_string ();

	if ((error == NULL) || (*error == 0))
	  sprintf (err, "%s%s", sle, str);
	else if (SLang_Error == SL_UNKNOWN_ERROR)
	  /* Do not display an unknown error message if error is non-NULL */
	  sprintf (err, "%s%s", sle, error);
	else
	  sprintf (err, "%s%s: %s", sle, str, error);
     }

   if (SLang_Error_Hook == NULL)
     {
	fputs (err, stderr);
	fputs("\r\n", stderr);
     }
   else
     (*SLang_Error_Hook)(err);
}

void SLang_verror (int err_code, char *fmt, ...)
{
   va_list ap;
   char err [1024];

   if (err_code == 0) err_code = SL_INTRINSIC_ERROR;
   if (SLang_Error == 0) SLang_Error = err_code;

   /* I would like to use vsnprintf but I do not know how common it
    * is.
    */
   if (4 * strlen (fmt) > 3 * sizeof (err))
     fmt = NULL;

   if (fmt != NULL)
     {
	va_start(ap, fmt);
	(void) vsprintf (err, fmt, ap);
	va_end(ap);
	fmt = err;
     }

   SLang_doerror (fmt);
}

void SLang_exit_error (char *fmt, ...)
{
   va_list ap;

   va_start (ap, fmt);
   if (SLang_Exit_Error_Hook != NULL)
     {
	(*SLang_Exit_Error_Hook) (fmt, ap);
	exit (1);
     }

   if (fmt != NULL)
     {
	vfprintf (stderr, fmt, ap);
	fputs ("\r\n", stderr);
     }
   va_end (ap);

   exit (1);
}

void SLang_vmessage (char *fmt, ...)
{
   va_list ap;

   if (fmt == NULL)
     return;

   va_start (ap, fmt);

   if (SLang_VMessage_Hook != NULL)
     (*SLang_VMessage_Hook) (fmt, ap);
   else
     {
	vfprintf (stdout, fmt, ap);
	fputs ("\r\n", stdout);
     }

   va_end (ap);
}