comparison src/data.c @ 89483:2f877ed80fa6

*** empty log message ***

88123:375f2633d815

#include <config.h>
#include <signal.h>
#include <stdio.h>
#include "lisp.h"
#include "puresize.h"
#include "charset.h"
#include "buffer.h"
#include "keyboard.h"
#include "frame.h"
#include "syssignal.h"

DEFUN ("char-or-string-p", Fchar_or_string_p, Schar_or_string_p, 1, 1, 0,
       doc: /* Return t if OBJECT is a character (an integer) or a string.  */)
     (object)
     register Lisp_Object object;
{
  if (INTEGERP (object) || STRINGP (object))
    return Qt;
  return Qnil;
}

DEFUN ("integerp", Fintegerp, Sintegerp, 1, 1, 0,

      val = (unsigned char) XBOOL_VECTOR (array)->data[idxval / BITS_PER_CHAR];
      return (val & (1 << (idxval % BITS_PER_CHAR)) ? Qt : Qnil);
    }
  else if (CHAR_TABLE_P (array))
    {
      Lisp_Object val;

      val = Qnil;

      if (idxval < 0)
	args_out_of_range (array, idx);
      if (idxval < CHAR_TABLE_ORDINARY_SLOTS)
	{
	  /* For ASCII and 8-bit European characters, the element is
             stored in the top table.  */
	  val = XCHAR_TABLE (array)->contents[idxval];
	  if (NILP (val))
	    val = XCHAR_TABLE (array)->defalt;
	  while (NILP (val))	/* Follow parents until we find some value.  */
	    {
	      array = XCHAR_TABLE (array)->parent;
	      if (NILP (array))
		return Qnil;
	      val = XCHAR_TABLE (array)->contents[idxval];
	      if (NILP (val))
		val = XCHAR_TABLE (array)->defalt;
	    }
	  return val;
	}
      else
	{
	  int code[4], i;
	  Lisp_Object sub_table;

	  SPLIT_CHAR (idxval, code[0], code[1], code[2]);
	  if (code[1] < 32) code[1] = -1;
	  else if (code[2] < 32) code[2] = -1;

	  /* Here, the possible range of CODE[0] (== charset ID) is
	    128..MAX_CHARSET.  Since the top level char table contains
	    data for multibyte characters after 256th element, we must
	    increment CODE[0] by 128 to get a correct index.  */
	  code[0] += 128;
	  code[3] = -1;		/* anchor */

	try_parent_char_table:
	  sub_table = array;
	  for (i = 0; code[i] >= 0; i++)
	    {
	      val = XCHAR_TABLE (sub_table)->contents[code[i]];
	      if (SUB_CHAR_TABLE_P (val))
		sub_table = val;
	      else
		{
		  if (NILP (val))
		    val = XCHAR_TABLE (sub_table)->defalt;
		  if (NILP (val))
		    {
		      array = XCHAR_TABLE (array)->parent;
		      if (!NILP (array))
			goto try_parent_char_table;
		    }
		  return val;
		}
	    }
	  /* Here, VAL is a sub char table.  We try the default value
             and parent.  */
	  val = XCHAR_TABLE (val)->defalt;
	  if (NILP (val))
	    {
	      array = XCHAR_TABLE (array)->parent;
	      if (!NILP (array))
		goto try_parent_char_table;
	    }
	  return val;
	}
    }
  else
    {
      int size = 0;
      if (VECTORP (array))

	val &= ~(1 << (idxval % BITS_PER_CHAR));
      XBOOL_VECTOR (array)->data[idxval / BITS_PER_CHAR] = val;
    }
  else if (CHAR_TABLE_P (array))
    {
      if (idxval < 0)
	args_out_of_range (array, idx);
      if (idxval < CHAR_TABLE_ORDINARY_SLOTS)
	XCHAR_TABLE (array)->contents[idxval] = newelt;
      else
	{
	  int code[4], i;
	  Lisp_Object val;

	  SPLIT_CHAR (idxval, code[0], code[1], code[2]);
	  if (code[1] < 32) code[1] = -1;
	  else if (code[2] < 32) code[2] = -1;

	  /* See the comment of the corresponding part in Faref.  */
	  code[0] += 128;
	  code[3] = -1;		/* anchor */
	  for (i = 0; code[i + 1] >= 0; i++)
	    {
	      val = XCHAR_TABLE (array)->contents[code[i]];
	      if (SUB_CHAR_TABLE_P (val))
		array = val;
	      else
		{
		  Lisp_Object temp;

		  /* VAL is a leaf.  Create a sub char table with the
		     default value VAL or XCHAR_TABLE (array)->defalt
		     and look into it.  */

		  temp = make_sub_char_table (NILP (val)
					      ? XCHAR_TABLE (array)->defalt
					      : val);
		  XCHAR_TABLE (array)->contents[code[i]] = temp;
		  array = temp;
		}
	    }
	  XCHAR_TABLE (array)->contents[code[i]] = newelt;
	}
    }
  else if (STRING_MULTIBYTE (array))
    {
      int idxval_byte, prev_bytes, new_bytes, nbytes;
      unsigned char workbuf[MAX_MULTIBYTE_LENGTH], *p0 = workbuf, *p1;

    {
      if (idxval < 0 || idxval >= SCHARS (array))
	args_out_of_range (array, idx);
      CHECK_NUMBER (newelt);

      if (XINT (newelt) < 0 || SINGLE_BYTE_CHAR_P (XINT (newelt)))
	SSET (array, idxval, XINT (newelt));
      else
	{
	  /* We must relocate the string data while converting it to
	     multibyte.  */

89483:2f877ed80fa6

#include <config.h>
#include <signal.h>
#include <stdio.h>
#include "lisp.h"
#include "puresize.h"
#include "character.h"
#include "buffer.h"
#include "keyboard.h"
#include "frame.h"
#include "syssignal.h"

DEFUN ("char-or-string-p", Fchar_or_string_p, Schar_or_string_p, 1, 1, 0,
       doc: /* Return t if OBJECT is a character (an integer) or a string.  */)
     (object)
     register Lisp_Object object;
{
  if (CHARACTERP (object) || STRINGP (object))
    return Qt;
  return Qnil;
}

DEFUN ("integerp", Fintegerp, Sintegerp, 1, 1, 0,

      val = (unsigned char) XBOOL_VECTOR (array)->data[idxval / BITS_PER_CHAR];
      return (val & (1 << (idxval % BITS_PER_CHAR)) ? Qt : Qnil);
    }
  else if (CHAR_TABLE_P (array))
    {
      CHECK_CHARACTER (idx);
      return CHAR_TABLE_REF (array, idxval);
    }
  else
    {
      int size = 0;
      if (VECTORP (array))

	val &= ~(1 << (idxval % BITS_PER_CHAR));
      XBOOL_VECTOR (array)->data[idxval / BITS_PER_CHAR] = val;
    }
  else if (CHAR_TABLE_P (array))
    {
      CHECK_CHARACTER (idx);
      CHAR_TABLE_SET (array, idxval, newelt);
    }
  else if (STRING_MULTIBYTE (array))
    {
      int idxval_byte, prev_bytes, new_bytes, nbytes;
      unsigned char workbuf[MAX_MULTIBYTE_LENGTH], *p0 = workbuf, *p1;

    {
      if (idxval < 0 || idxval >= SCHARS (array))
	args_out_of_range (array, idx);
      CHECK_NUMBER (newelt);

      if (XINT (newelt) < 0 || ASCII_CHAR_P (XINT (newelt)))
	SSET (array, idxval, XINT (newelt));
      else
	{
	  /* We must relocate the string data while converting it to
	     multibyte.  */