/* TTY-specific Lisp objects.
   Copyright (C) 1995 Board of Trustees, University of Illinois
   Copyright (C) 1995 Ben Wing

This file is part of XEmacs.

XEmacs is free software; you can redistribute it and/or modify it
under the terms of the GNU General Public License as published by the
Free Software Foundation; either version 2, or (at your option) any
later version.

XEmacs 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 GNU General Public License
for more details.

You should have received a copy of the GNU General Public License
along with XEmacs; see the file COPYING.  If not, write to the Free
Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */

/* Synched up with: Not in FSF. */

#include <config.h>
#include "lisp.h"

#include "device-tty.h"
#include "objects-tty.h"

Lisp_Object Qblack, Qred, Qgreen, Qyellow, Qblue, Qmagenta, Qcyan, Qwhite;
Lisp_Object Qbold, Qunderscore, Qblink, Qconcealed;

/* Qreverse defined in general.c */

static int
tty_initialize_color_instance (struct Lisp_Color_Instance *p, Lisp_Object name,
			       Lisp_Object device, int no_error)
{
  /* Old doc string:

       "Given a list of colors and attributes return a composite sequence.\n\
The return value is actually a list with two elements.  The first element\n\
is the sequence to turn the combination on.  The second is the combination\n\
to turn them off."
  */
  return 0;
  /* #### write this function */
  /* #### Need to be able to allow user to specify arbitrary
     strings in order to support other color models. */
}

static void
tty_mark_color_instance (struct Lisp_Color_Instance *c,
			 void (*markobj) (Lisp_Object))
{
  ((markobj) (COLOR_INSTANCE_TTY_BEGIN (c)));
  ((markobj) (COLOR_INSTANCE_TTY_END (c)));
}

static void
tty_print_color_instance (struct Lisp_Color_Instance *c,
			  Lisp_Object printcharfun,
			  int escapeflag)
{
  /* #### write this. */
}

static void
tty_finalize_color_instance (struct Lisp_Color_Instance *c)
{
  if (c->data)
    xfree (c->data);
}

static int
tty_color_instance_equal (struct Lisp_Color_Instance *c1,
			  struct Lisp_Color_Instance *c2,
			  int depth)
{
  /* compare the escape sequences */
  return (internal_equal (COLOR_INSTANCE_TTY_BEGIN (c1),
			  COLOR_INSTANCE_TTY_BEGIN (c2),
			  depth + 1) &&
	  internal_equal (COLOR_INSTANCE_TTY_END (c1),
			  COLOR_INSTANCE_TTY_END (c2),
			  depth + 1));
}

static unsigned long
tty_color_instance_hash (struct Lisp_Color_Instance *c, int depth)
{
  return HASH2 (internal_hash (COLOR_INSTANCE_TTY_BEGIN (c), depth + 1),
		internal_hash (COLOR_INSTANCE_TTY_END (c), depth + 1));
}

static int
tty_valid_color_name_p (struct device *d, Lisp_Object color)
{
  /* The colors. */
  if (EQ (color, Qblack))
    return 1;
  else if (EQ (color, Qred))
    return 1;
  else if (EQ (color, Qgreen))
    return 1;
  else if (EQ (color, Qyellow))
    return 1;
  else if (EQ (color, Qblue))
    return 1;
  else if (EQ (color, Qmagenta))
    return 1;
  else if (EQ (color, Qcyan))
    return 1;
  else if (EQ (color, Qwhite))
    return 1;

  /* The attributes. */
  if (EQ (color, Qbold))
    return 1;
  else if (EQ (color, Qunderscore))
    return 1;
  else if (EQ (color, Qblink))
    return 1;
  else if (EQ (color, Qreverse))
    return 1;
  else if (EQ (color, Qconcealed))
    return 1;

  return 0;
}


static int
tty_initialize_font_instance (struct Lisp_Font_Instance *p, Lisp_Object name,
			      Lisp_Object device, int no_error)
{
  return 0;
  /* #### write these functions. */
}

static void
tty_mark_font_instance (struct Lisp_Font_Instance *f,
			void (*markobj) (Lisp_Object))
{
  /* #### write these functions. */
}

static void
tty_print_font_instance (struct Lisp_Font_Instance *f,
			 Lisp_Object printcharfun,
			 int escapeflag)
{
  /* #### write these functions. */
}

static void
tty_finalize_font_instance (struct Lisp_Font_Instance *f)
{
  /* #### write these functions. */
  if (f->data)
    xfree (f->data);
}

static Lisp_Object
tty_list_fonts (Lisp_Object pattern, Lisp_Object device)
{
  /* #### write these functions. */
  return Qnil;
}


/************************************************************************/
/*                            initialization                            */
/************************************************************************/

void
syms_of_objects_tty (void)
{
  defsymbol (&Qblack, "black");
  defsymbol (&Qred, "red");
  defsymbol (&Qgreen, "green");
  defsymbol (&Qyellow, "yellow");
  defsymbol (&Qblue, "blue");
  defsymbol (&Qmagenta, "magenta");
  defsymbol (&Qcyan, "cyan");
  defsymbol (&Qwhite, "white");

  defsymbol (&Qbold, "bold");
  defsymbol (&Qunderscore, "underscore");
  defsymbol (&Qblink, "blink");
  defsymbol (&Qconcealed, "concealed");
}

void
device_type_create_objects_tty (void)
{
  /* object methods */
  DEVICE_HAS_METHOD (tty, initialize_color_instance);
  DEVICE_HAS_METHOD (tty, mark_color_instance);
  DEVICE_HAS_METHOD (tty, print_color_instance);
  DEVICE_HAS_METHOD (tty, finalize_color_instance);
  DEVICE_HAS_METHOD (tty, color_instance_equal);
  DEVICE_HAS_METHOD (tty, color_instance_hash);
  DEVICE_HAS_METHOD (tty, valid_color_name_p);

  DEVICE_HAS_METHOD (tty, initialize_font_instance);
  DEVICE_HAS_METHOD (tty, mark_font_instance);
  DEVICE_HAS_METHOD (tty, print_font_instance);
  DEVICE_HAS_METHOD (tty, finalize_font_instance);
  DEVICE_HAS_METHOD (tty, list_fonts);
}
