/[emacs]/emacs/src/data.c
ViewVC logotype

Diff of /emacs/src/data.c

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.224 by rms, Sat May 17 12:42:31 2003 UTC revision 1.224.4.1 by handa, Mon Sep 8 12:48:10 2003 UTC
# Line 25  Boston, MA 02111-1307, USA.  */ Line 25  Boston, MA 02111-1307, USA.  */
25  #include <stdio.h>  #include <stdio.h>
26  #include "lisp.h"  #include "lisp.h"
27  #include "puresize.h"  #include "puresize.h"
28  #include "charset.h"  #include "character.h"
29  #include "buffer.h"  #include "buffer.h"
30  #include "keyboard.h"  #include "keyboard.h"
31  #include "frame.h"  #include "frame.h"
# Line 447  DEFUN ("char-or-string-p", Fchar_or_stri Line 447  DEFUN ("char-or-string-p", Fchar_or_stri
447       (object)       (object)
448       register Lisp_Object object;       register Lisp_Object object;
449  {  {
450    if (INTEGERP (object) || STRINGP (object))    if (CHARACTERP (object) || STRINGP (object))
451      return Qt;      return Qt;
452    return Qnil;    return Qnil;
453  }  }
# Line 1855  or a byte-code object.  IDX starts at 0. Line 1855  or a byte-code object.  IDX starts at 0.
1855      }      }
1856    else if (CHAR_TABLE_P (array))    else if (CHAR_TABLE_P (array))
1857      {      {
1858        Lisp_Object val;        CHECK_CHARACTER (idx);
1859          return CHAR_TABLE_REF (array, idxval);
       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;  
         }  
1860      }      }
1861    else    else
1862      {      {
# Line 1988  bool-vector.  IDX starts at 0.  */) Line 1919  bool-vector.  IDX starts at 0.  */)
1919      }      }
1920    else if (CHAR_TABLE_P (array))    else if (CHAR_TABLE_P (array))
1921      {      {
1922        if (idxval < 0)        CHECK_CHARACTER (idx);
1923          args_out_of_range (array, idx);        CHAR_TABLE_SET (array, idxval, newelt);
       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;  
         }  
1924      }      }
1925    else if (STRING_MULTIBYTE (array))    else if (STRING_MULTIBYTE (array))
1926      {      {
# Line 2071  bool-vector.  IDX starts at 0.  */) Line 1966  bool-vector.  IDX starts at 0.  */)
1966          args_out_of_range (array, idx);          args_out_of_range (array, idx);
1967        CHECK_NUMBER (newelt);        CHECK_NUMBER (newelt);
1968    
1969        if (XINT (newelt) < 0 || SINGLE_BYTE_CHAR_P (XINT (newelt)))        if (XINT (newelt) < 0 || ASCII_CHAR_P (XINT (newelt)))
1970          SSET (array, idxval, XINT (newelt));          SSET (array, idxval, XINT (newelt));
1971        else        else
1972          {          {

Legend:
Removed from v.1.224  
changed lines
  Added in v.1.224.4.1

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26