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

Diff of /emacs/src/fns.c

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

revision 1.303 by pj, Tue Nov 13 11:55:47 2001 UTC revision 1.303.2.1 by handa, Fri Mar 1 01:39:56 2002 UTC
# Line 33  Boston, MA 02111-1307, USA.  */ Line 33  Boston, MA 02111-1307, USA.  */
33    
34  #include "lisp.h"  #include "lisp.h"
35  #include "commands.h"  #include "commands.h"
36  #include "charset.h"  #include "character.h"
37    
38  #include "buffer.h"  #include "buffer.h"
39  #include "keyboard.h"  #include "keyboard.h"
# Line 443  usage: (vconcat &rest SEQUENCES)   */) Line 443  usage: (vconcat &rest SEQUENCES)   */)
443    return concat (nargs, args, Lisp_Vectorlike, 0);    return concat (nargs, args, Lisp_Vectorlike, 0);
444  }  }
445    
 /* Retrun a copy of a sub char table ARG.  The elements except for a  
    nested sub char table are not copied.  */  
 static Lisp_Object  
 copy_sub_char_table (arg)  
      Lisp_Object arg;  
 {  
   Lisp_Object copy = make_sub_char_table (XCHAR_TABLE (arg)->defalt);  
   int i;  
   
   /* Copy all the contents.  */  
   bcopy (XCHAR_TABLE (arg)->contents, XCHAR_TABLE (copy)->contents,  
          SUB_CHAR_TABLE_ORDINARY_SLOTS * sizeof (Lisp_Object));  
   /* Recursively copy any sub char-tables in the ordinary slots.  */  
   for (i = 32; i < SUB_CHAR_TABLE_ORDINARY_SLOTS; i++)  
     if (SUB_CHAR_TABLE_P (XCHAR_TABLE (arg)->contents[i]))  
       XCHAR_TABLE (copy)->contents[i]  
         = copy_sub_char_table (XCHAR_TABLE (copy)->contents[i]);  
   
   return copy;  
 }  
   
446    
447  DEFUN ("copy-sequence", Fcopy_sequence, Scopy_sequence, 1, 1, 0,  DEFUN ("copy-sequence", Fcopy_sequence, Scopy_sequence, 1, 1, 0,
448         doc: /* Return a copy of a list, vector or string.         doc: /* Return a copy of a list, vector or string.
# Line 476  with the original. */) Line 455  with the original. */)
455    
456    if (CHAR_TABLE_P (arg))    if (CHAR_TABLE_P (arg))
457      {      {
458        int i;        return copy_char_table (arg);
       Lisp_Object copy;  
   
       copy = Fmake_char_table (XCHAR_TABLE (arg)->purpose, Qnil);  
       /* Copy all the slots, including the extra ones.  */  
       bcopy (XVECTOR (arg)->contents, XVECTOR (copy)->contents,  
              ((XCHAR_TABLE (arg)->size & PSEUDOVECTOR_SIZE_MASK)  
               * sizeof (Lisp_Object)));  
   
       /* Recursively copy any sub char tables in the ordinary slots  
          for multibyte characters.  */  
       for (i = CHAR_TABLE_SINGLE_BYTE_SLOTS;  
            i < CHAR_TABLE_ORDINARY_SLOTS; i++)  
         if (SUB_CHAR_TABLE_P (XCHAR_TABLE (arg)->contents[i]))  
           XCHAR_TABLE (copy)->contents[i]  
             = copy_sub_char_table (XCHAR_TABLE (copy)->contents[i]);  
   
       return copy;  
459      }      }
   
460    if (BOOL_VECTOR_P (arg))    if (BOOL_VECTOR_P (arg))
461      {      {
462        Lisp_Object val;        Lisp_Object val;
# Line 696  concat (nargs, args, target_type, last_s Line 657  concat (nargs, args, target_type, last_s
657            && STRING_MULTIBYTE (this) == some_multibyte)            && STRING_MULTIBYTE (this) == some_multibyte)
658          {          {
659            int thislen_byte = STRING_BYTES (XSTRING (this));            int thislen_byte = STRING_BYTES (XSTRING (this));
           int combined;  
660    
661            bcopy (XSTRING (this)->data, XSTRING (val)->data + toindex_byte,            bcopy (XSTRING (this)->data, XSTRING (val)->data + toindex_byte,
662                   STRING_BYTES (XSTRING (this)));                   STRING_BYTES (XSTRING (this)));
           combined =  (some_multibyte && toindex_byte > 0  
                        ? count_combining (XSTRING (val)->data,  
                                           toindex_byte + thislen_byte,  
                                           toindex_byte)  
                        : 0);  
663            if (! NULL_INTERVAL_P (XSTRING (this)->intervals))            if (! NULL_INTERVAL_P (XSTRING (this)->intervals))
664              {              {
665                textprops[num_textprops].argnum = argnum;                textprops[num_textprops].argnum = argnum;
666                /* We ignore text properties on characters being combined.  */                textprops[num_textprops].from = 0;
               textprops[num_textprops].from = combined;  
667                textprops[num_textprops++].to = toindex;                textprops[num_textprops++].to = toindex;
668              }              }
669            toindex_byte += thislen_byte;            toindex_byte += thislen_byte;
670            toindex += thisleni - combined;            toindex += thisleni;
           XSTRING (val)->size -= combined;  
671          }          }
672        /* Copy a single-byte string to a multibyte string.  */        /* Copy a single-byte string to a multibyte string.  */
673        else if (STRINGP (this) && STRINGP (val))        else if (STRINGP (this) && STRINGP (val))
# Line 757  concat (nargs, args, target_type, last_s Line 710  concat (nargs, args, target_type, last_s
710                    {                    {
711                      XSETFASTINT (elt, XSTRING (this)->data[thisindex++]);                      XSETFASTINT (elt, XSTRING (this)->data[thisindex++]);
712                      if (some_multibyte                      if (some_multibyte
713                          && (XINT (elt) >= 0240                          && XINT (elt) >= 0200
                             || (XINT (elt) >= 0200  
                                 && ! NILP (Vnonascii_translation_table)))  
714                          && XINT (elt) < 0400)                          && XINT (elt) < 0400)
715                        {                        {
716                          c = unibyte_char_to_multibyte (XINT (elt));                          c = unibyte_char_to_multibyte (XINT (elt));
# Line 792  concat (nargs, args, target_type, last_s Line 743  concat (nargs, args, target_type, last_s
743              else              else
744                {                {
745                  CHECK_NUMBER (elt);                  CHECK_NUMBER (elt);
746                  if (SINGLE_BYTE_CHAR_P (XINT (elt)))                  if (some_multibyte)
747                    {                    toindex_byte
748                      if (some_multibyte)                      += CHAR_STRING (XINT (elt),
749                        toindex_byte                                      XSTRING (val)->data + toindex_byte);
                         += CHAR_STRING (XINT (elt),  
                                         XSTRING (val)->data + toindex_byte);  
                     else  
                       XSTRING (val)->data[toindex_byte++] = XINT (elt);  
                     if (some_multibyte  
                         && toindex_byte > 0  
                         && count_combining (XSTRING (val)->data,  
                                             toindex_byte, toindex_byte - 1))  
                       XSTRING (val)->size--;  
                     else  
                       toindex++;  
                   }  
750                  else                  else
751                    /* If we have any multibyte characters,                    XSTRING (val)->data[toindex_byte++] = XINT (elt);
752                       we already decided to make a multibyte string.  */                  toindex++;
                   {  
                     int c = XINT (elt);  
                     /* P exists as a variable  
                        to avoid a bug on the Masscomp C compiler.  */  
                     unsigned char *p = & XSTRING (val)->data[toindex_byte];  
   
                     toindex_byte += CHAR_STRING (c, p);  
                     toindex++;  
                   }  
753                }                }
754            }            }
755      }      }
# Line 894  string_char_to_byte (string, char_index) Line 824  string_char_to_byte (string, char_index)
824    
825    if (char_index - best_below < best_above - char_index)    if (char_index - best_below < best_above - char_index)
826      {      {
827          unsigned char *p = XSTRING (string)->data + best_below_byte;
828    
829        while (best_below < char_index)        while (best_below < char_index)
830          {          {
831            int c;            p += BYTES_BY_CHAR_HEAD (*p);
832            FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c, string,            best_below++;
                                               best_below, best_below_byte);  
833          }          }
834        i = best_below;        i_byte = p - XSTRING (string)->data;
       i_byte = best_below_byte;  
835      }      }
836    else    else
837      {      {
838          unsigned char *p = XSTRING (string)->data + best_above_byte;
839    
840        while (best_above > char_index)        while (best_above > char_index)
841          {          {
842            unsigned char *pend = XSTRING (string)->data + best_above_byte;            p--;
843            unsigned char *pbeg = pend - best_above_byte;            while (!CHAR_HEAD_P (*p)) p--;
           unsigned char *p = pend - 1;  
           int bytes;  
   
           while (p > pbeg  && !CHAR_HEAD_P (*p)) p--;  
           PARSE_MULTIBYTE_SEQ (p, pend - p, bytes);  
           if (bytes == pend - p)  
             best_above_byte -= bytes;  
           else if (bytes > pend - p)  
             best_above_byte -= (pend - p);  
           else  
             best_above_byte--;  
844            best_above--;            best_above--;
845          }          }
846        i = best_above;        i_byte = p - XSTRING (string)->data;
       i_byte = best_above_byte;  
847      }      }
848    
849    string_char_byte_cache_bytepos = i_byte;    string_char_byte_cache_bytepos = i_byte;
850    string_char_byte_cache_charpos = i;    string_char_byte_cache_charpos = char_index;
851    string_char_byte_cache_string = string;    string_char_byte_cache_string = string;
852    
853    return i_byte;    return i_byte;
# Line 967  string_byte_to_char (string, byte_index) Line 887  string_byte_to_char (string, byte_index)
887    
888    if (byte_index - best_below_byte < best_above_byte - byte_index)    if (byte_index - best_below_byte < best_above_byte - byte_index)
889      {      {
890        while (best_below_byte < byte_index)        unsigned char *p = XSTRING (string)->data + best_below_byte;
891          unsigned char *pend = XSTRING (string)->data + byte_index;
892    
893          while (p < pend)
894          {          {
895            int c;            p += BYTES_BY_CHAR_HEAD (*p);
896            FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c, string,            best_below++;
                                               best_below, best_below_byte);  
897          }          }
898        i = best_below;        i = best_below;
899        i_byte = best_below_byte;        i_byte = p - XSTRING (string)->data;
900      }      }
901    else    else
902      {      {
903        while (best_above_byte > byte_index)        unsigned char *p = XSTRING (string)->data + best_above_byte;
904          unsigned char *pbeg = XSTRING (string)->data + byte_index;
905    
906          while (p > pbeg)
907          {          {
908            unsigned char *pend = XSTRING (string)->data + best_above_byte;            p--;
909            unsigned char *pbeg = pend - best_above_byte;            while (!CHAR_HEAD_P (*p)) p--;
           unsigned char *p = pend - 1;  
           int bytes;  
   
           while (p > pbeg  && !CHAR_HEAD_P (*p)) p--;  
           PARSE_MULTIBYTE_SEQ (p, pend - p, bytes);  
           if (bytes == pend - p)  
             best_above_byte -= bytes;  
           else if (bytes > pend - p)  
             best_above_byte -= (pend - p);  
           else  
             best_above_byte--;  
910            best_above--;            best_above--;
911          }          }
912        i = best_above;        i = best_above;
913        i_byte = best_above_byte;        i_byte = p - XSTRING (string)->data;
914      }      }
915    
916    string_char_byte_cache_bytepos = i_byte;    string_char_byte_cache_bytepos = i_byte;
# Line 2034  internal_equal (o1, o2, depth) Line 1948  internal_equal (o1, o2, depth)
1948             functions are sensible to compare, so eliminate the others now.  */             functions are sensible to compare, so eliminate the others now.  */
1949          if (size & PSEUDOVECTOR_FLAG)          if (size & PSEUDOVECTOR_FLAG)
1950            {            {
1951              if (!(size & (PVEC_COMPILED | PVEC_CHAR_TABLE)))              if (!(size & (PVEC_COMPILED | PVEC_CHAR_TABLE
1952                              | PVEC_SUB_CHAR_TABLE)))
1953                return 0;                return 0;
1954              size &= PSEUDOVECTOR_SIZE_MASK;              size &= PSEUDOVECTOR_SIZE_MASK;
1955            }            }
# Line 2088  ARRAY is a vector, string, char-table, o Line 2003  ARRAY is a vector, string, char-table, o
2003      }      }
2004    else if (CHAR_TABLE_P (array))    else if (CHAR_TABLE_P (array))
2005      {      {
2006        register Lisp_Object *p = XCHAR_TABLE (array)->contents;        int i;
2007        size = CHAR_TABLE_ORDINARY_SLOTS;  
2008        for (index = 0; index < size; index++)        for (i = 0; i < (1 << CHARTAB_SIZE_BITS_0); i++)
2009          p[index] = item;          XCHAR_TABLE (array)->contents[i] = item;
2010        XCHAR_TABLE (array)->defalt = Qnil;        XCHAR_TABLE (array)->defalt = item;
2011      }      }
2012    else if (STRINGP (array))    else if (STRINGP (array))
2013      {      {
# Line 2140  ARRAY is a vector, string, char-table, o Line 2055  ARRAY is a vector, string, char-table, o
2055      }      }
2056    return array;    return array;
2057  }  }
   
 DEFUN ("char-table-subtype", Fchar_table_subtype, Schar_table_subtype,  
        1, 1, 0,  
        doc: /* Return the subtype of char-table CHAR-TABLE.  The value is a symbol.  */)  
      (char_table)  
      Lisp_Object char_table;  
 {  
   CHECK_CHAR_TABLE (char_table);  
   
   return XCHAR_TABLE (char_table)->purpose;  
 }  
   
 DEFUN ("char-table-parent", Fchar_table_parent, Schar_table_parent,  
        1, 1, 0,  
        doc: /* Return the parent char-table of CHAR-TABLE.  
 The value is either nil or another char-table.  
 If CHAR-TABLE holds nil for a given character,  
 then the actual applicable value is inherited from the parent char-table  
 \(or from its parents, if necessary).  */)  
      (char_table)  
      Lisp_Object char_table;  
 {  
   CHECK_CHAR_TABLE (char_table);  
   
   return XCHAR_TABLE (char_table)->parent;  
 }  
   
 DEFUN ("set-char-table-parent", Fset_char_table_parent, Sset_char_table_parent,  
        2, 2, 0,  
        doc: /* Set the parent char-table of CHAR-TABLE to PARENT.  
 PARENT must be either nil or another char-table.  */)  
      (char_table, parent)  
      Lisp_Object char_table, parent;  
 {  
   Lisp_Object temp;  
   
   CHECK_CHAR_TABLE (char_table);  
   
   if (!NILP (parent))  
     {  
       CHECK_CHAR_TABLE (parent);  
   
       for (temp = parent; !NILP (temp); temp = XCHAR_TABLE (temp)->parent)  
         if (EQ (temp, char_table))  
           error ("Attempt to make a chartable be its own parent");  
     }  
   
   XCHAR_TABLE (char_table)->parent = parent;  
   
   return parent;  
 }  
   
 DEFUN ("char-table-extra-slot", Fchar_table_extra_slot, Schar_table_extra_slot,  
        2, 2, 0,  
        doc: /* Return the value of CHAR-TABLE's extra-slot number N.  */)  
      (char_table, n)  
      Lisp_Object char_table, n;  
 {  
   CHECK_CHAR_TABLE (char_table);  
   CHECK_NUMBER (n);  
   if (XINT (n) < 0  
       || XINT (n) >= CHAR_TABLE_EXTRA_SLOTS (XCHAR_TABLE (char_table)))  
     args_out_of_range (char_table, n);  
   
   return XCHAR_TABLE (char_table)->extras[XINT (n)];  
 }  
   
 DEFUN ("set-char-table-extra-slot", Fset_char_table_extra_slot,  
        Sset_char_table_extra_slot,  
        3, 3, 0,  
        doc: /* Set CHAR-TABLE's extra-slot number N to VALUE.  */)  
      (char_table, n, value)  
      Lisp_Object char_table, n, value;  
 {  
   CHECK_CHAR_TABLE (char_table);  
   CHECK_NUMBER (n);  
   if (XINT (n) < 0  
       || XINT (n) >= CHAR_TABLE_EXTRA_SLOTS (XCHAR_TABLE (char_table)))  
     args_out_of_range (char_table, n);  
   
   return XCHAR_TABLE (char_table)->extras[XINT (n)] = value;  
 }  
   
 DEFUN ("char-table-range", Fchar_table_range, Schar_table_range,  
        2, 2, 0,  
        doc: /* Return the value in CHAR-TABLE for a range of characters RANGE.  
 RANGE should be nil (for the default value)  
 a vector which identifies a character set or a row of a character set,  
 a character set name, or a character code.  */)  
      (char_table, range)  
      Lisp_Object char_table, range;  
 {  
   CHECK_CHAR_TABLE (char_table);  
   
   if (EQ (range, Qnil))  
     return XCHAR_TABLE (char_table)->defalt;  
   else if (INTEGERP (range))  
     return Faref (char_table, range);  
   else if (SYMBOLP (range))  
     {  
       Lisp_Object charset_info;  
   
       charset_info = Fget (range, Qcharset);  
       CHECK_VECTOR (charset_info);  
   
       return Faref (char_table,  
                     make_number (XINT (XVECTOR (charset_info)->contents[0])  
                                  + 128));  
     }  
   else if (VECTORP (range))  
     {  
       if (XVECTOR (range)->size == 1)  
         return Faref (char_table,  
                       make_number (XINT (XVECTOR (range)->contents[0]) + 128));  
       else  
         {  
           int size = XVECTOR (range)->size;  
           Lisp_Object *val = XVECTOR (range)->contents;  
           Lisp_Object ch = Fmake_char_internal (size <= 0 ? Qnil : val[0],  
                                                 size <= 1 ? Qnil : val[1],  
                                                 size <= 2 ? Qnil : val[2]);  
           return Faref (char_table, ch);  
         }  
     }  
   else  
     error ("Invalid RANGE argument to `char-table-range'");  
   return Qt;  
 }  
   
 DEFUN ("set-char-table-range", Fset_char_table_range, Sset_char_table_range,  
        3, 3, 0,  
        doc: /* Set the value in CHAR-TABLE for a range of characters RANGE to VALUE.  
 RANGE should be t (for all characters), nil (for the default value)  
 a vector which identifies a character set or a row of a character set,  
 a coding system, or a character code.  */)  
      (char_table, range, value)  
      Lisp_Object char_table, range, value;  
 {  
   int i;  
   
   CHECK_CHAR_TABLE (char_table);  
   
   if (EQ (range, Qt))  
     for (i = 0; i < CHAR_TABLE_ORDINARY_SLOTS; i++)  
       XCHAR_TABLE (char_table)->contents[i] = value;  
   else if (EQ (range, Qnil))  
     XCHAR_TABLE (char_table)->defalt = value;  
   else if (SYMBOLP (range))  
     {  
       Lisp_Object charset_info;  
   
       charset_info = Fget (range, Qcharset);  
       CHECK_VECTOR (charset_info);  
   
       return Faset (char_table,  
                     make_number (XINT (XVECTOR (charset_info)->contents[0])  
                                  + 128),  
                     value);  
     }  
   else if (INTEGERP (range))  
     Faset (char_table, range, value);  
   else if (VECTORP (range))  
     {  
       if (XVECTOR (range)->size == 1)  
         return Faset (char_table,  
                       make_number (XINT (XVECTOR (range)->contents[0]) + 128),  
                       value);  
       else  
         {  
           int size = XVECTOR (range)->size;  
           Lisp_Object *val = XVECTOR (range)->contents;  
           Lisp_Object ch = Fmake_char_internal (size <= 0 ? Qnil : val[0],  
                                                 size <= 1 ? Qnil : val[1],  
                                                 size <= 2 ? Qnil : val[2]);  
           return Faset (char_table, ch, value);  
         }  
     }  
   else  
     error ("Invalid RANGE argument to `set-char-table-range'");  
   
   return value;  
 }  
   
 DEFUN ("set-char-table-default", Fset_char_table_default,  
        Sset_char_table_default, 3, 3, 0,  
        doc: /* Set the default value in CHAR-TABLE for a generic character CHAR to VALUE.  
 The generic character specifies the group of characters.  
 See also the documentation of make-char.  */)  
      (char_table, ch, value)  
      Lisp_Object char_table, ch, value;  
 {  
   int c, charset, code1, code2;  
   Lisp_Object temp;  
   
   CHECK_CHAR_TABLE (char_table);  
   CHECK_NUMBER (ch);  
   
   c = XINT (ch);  
   SPLIT_CHAR (c, charset, code1, code2);  
   
   /* Since we may want to set the default value for a character set  
      not yet defined, we check only if the character set is in the  
      valid range or not, instead of it is already defined or not.  */  
   if (! CHARSET_VALID_P (charset))  
     invalid_character (c);  
   
   if (charset == CHARSET_ASCII)  
     return (XCHAR_TABLE (char_table)->defalt = value);  
   
   /* Even if C is not a generic char, we had better behave as if a  
      generic char is specified.  */  
   if (!CHARSET_DEFINED_P (charset) || CHARSET_DIMENSION (charset) == 1)  
     code1 = 0;  
   temp = XCHAR_TABLE (char_table)->contents[charset + 128];  
   if (!code1)  
     {  
       if (SUB_CHAR_TABLE_P (temp))  
         XCHAR_TABLE (temp)->defalt = value;  
       else  
         XCHAR_TABLE (char_table)->contents[charset + 128] = value;  
       return value;  
     }  
   if (SUB_CHAR_TABLE_P (temp))  
     char_table = temp;  
   else  
     char_table = (XCHAR_TABLE (char_table)->contents[charset + 128]  
                   = make_sub_char_table (temp));  
   temp = XCHAR_TABLE (char_table)->contents[code1];  
   if (SUB_CHAR_TABLE_P (temp))  
     XCHAR_TABLE (temp)->defalt = value;  
   else  
     XCHAR_TABLE (char_table)->contents[code1] = value;  
   return value;  
 }  
   
 /* Look up the element in TABLE at index CH,  
    and return it as an integer.  
    If the element is nil, return CH itself.  
    (Actually we do that for any non-integer.)  */  
   
 int  
 char_table_translate (table, ch)  
      Lisp_Object table;  
      int ch;  
 {  
   Lisp_Object value;  
   value = Faref (table, make_number (ch));  
   if (! INTEGERP (value))  
     return ch;  
   return XINT (value);  
 }  
   
 static void  
 optimize_sub_char_table (table, chars)  
      Lisp_Object *table;  
      int chars;  
 {  
   Lisp_Object elt;  
   int from, to;  
   
   if (chars == 94)  
     from = 33, to = 127;  
   else  
     from = 32, to = 128;  
   
   if (!SUB_CHAR_TABLE_P (*table))  
     return;  
   elt = XCHAR_TABLE (*table)->contents[from++];  
   for (; from < to; from++)  
     if (NILP (Fequal (elt, XCHAR_TABLE (*table)->contents[from])))  
       return;  
   *table = elt;  
 }  
   
 DEFUN ("optimize-char-table", Foptimize_char_table, Soptimize_char_table,  
        1, 1, 0, doc: /* Optimize char table TABLE.  */)  
      (table)  
      Lisp_Object table;  
 {  
   Lisp_Object elt;  
   int dim;  
   int i, j;  
   
   CHECK_CHAR_TABLE (table);  
   
   for (i = CHAR_TABLE_SINGLE_BYTE_SLOTS; i < CHAR_TABLE_ORDINARY_SLOTS; i++)  
     {  
       elt = XCHAR_TABLE (table)->contents[i];  
       if (!SUB_CHAR_TABLE_P (elt))  
         continue;  
       dim = CHARSET_DIMENSION (i - 128);  
       if (dim == 2)  
         for (j = 32; j < SUB_CHAR_TABLE_ORDINARY_SLOTS; j++)  
           optimize_sub_char_table (XCHAR_TABLE (elt)->contents + j, dim);  
       optimize_sub_char_table (XCHAR_TABLE (table)->contents + i, dim);  
     }  
   return Qnil;  
 }  
   
   
 /* Map C_FUNCTION or FUNCTION over SUBTABLE, calling it for each  
    character or group of characters that share a value.  
    DEPTH is the current depth in the originally specified  
    chartable, and INDICES contains the vector indices  
    for the levels our callers have descended.  
   
    ARG is passed to C_FUNCTION when that is called.  */  
   
 void  
 map_char_table (c_function, function, subtable, arg, depth, indices)  
      void (*c_function) P_ ((Lisp_Object, Lisp_Object, Lisp_Object));  
      Lisp_Object function, subtable, arg, *indices;  
      int depth;  
 {  
   int i, to;  
   
   if (depth == 0)  
     {  
       /* At first, handle ASCII and 8-bit European characters.  */  
       for (i = 0; i < CHAR_TABLE_SINGLE_BYTE_SLOTS; i++)  
         {  
           Lisp_Object elt = XCHAR_TABLE (subtable)->contents[i];  
           if (c_function)  
             (*c_function) (arg, make_number (i), elt);  
           else  
             call2 (function, make_number (i), elt);  
         }  
 #if 0 /* If the char table has entries for higher characters,  
          we should report them.  */  
       if (NILP (current_buffer->enable_multibyte_characters))  
         return;  
 #endif  
       to = CHAR_TABLE_ORDINARY_SLOTS;  
     }  
   else  
     {  
       int charset = XFASTINT (indices[0]) - 128;  
   
       i = 32;  
       to = SUB_CHAR_TABLE_ORDINARY_SLOTS;  
       if (CHARSET_CHARS (charset) == 94)  
         i++, to--;  
     }  
   
   for (; i < to; i++)  
     {  
       Lisp_Object elt;  
       int charset;  
   
       elt = XCHAR_TABLE (subtable)->contents[i];  
       XSETFASTINT (indices[depth], i);  
       charset = XFASTINT (indices[0]) - 128;  
       if (depth == 0  
           && (!CHARSET_DEFINED_P (charset)  
               || charset == CHARSET_8_BIT_CONTROL  
               || charset == CHARSET_8_BIT_GRAPHIC))  
         continue;  
   
       if (SUB_CHAR_TABLE_P (elt))  
         {  
           if (depth >= 3)  
             error ("Too deep char table");  
           map_char_table (c_function, function, elt, arg, depth + 1, indices);  
         }  
       else  
         {  
           int c1, c2, c;  
   
           if (NILP (elt))  
             elt = XCHAR_TABLE (subtable)->defalt;  
           c1 = depth >= 1 ? XFASTINT (indices[1]) : 0;  
           c2 = depth >= 2 ? XFASTINT (indices[2]) : 0;  
           c = MAKE_CHAR (charset, c1, c2);  
           if (c_function)  
             (*c_function) (arg, make_number (c), elt);  
           else  
             call2 (function, make_number (c), elt);  
         }  
     }  
 }  
   
 DEFUN ("map-char-table", Fmap_char_table, Smap_char_table,  
        2, 2, 0,  
        doc: /* Call FUNCTION for each (normal and generic) characters in CHAR-TABLE.  
 FUNCTION is called with two arguments--a key and a value.  
 The key is always a possible IDX argument to `aref'.  */)  
      (function, char_table)  
      Lisp_Object function, char_table;  
 {  
   /* The depth of char table is at most 3. */  
   Lisp_Object indices[3];  
   
   CHECK_CHAR_TABLE (char_table);  
   
   map_char_table (NULL, function, char_table, char_table, 0, indices);  
   return Qnil;  
 }  
   
 /* Return a value for character C in char-table TABLE.  Store the  
    actual index for that value in *IDX.  Ignore the default value of  
    TABLE.  */  
   
 Lisp_Object  
 char_table_ref_and_index (table, c, idx)  
      Lisp_Object table;  
      int c, *idx;  
 {  
   int charset, c1, c2;  
   Lisp_Object elt;  
   
   if (SINGLE_BYTE_CHAR_P (c))  
     {  
       *idx = c;  
       return XCHAR_TABLE (table)->contents[c];  
     }  
   SPLIT_CHAR (c, charset, c1, c2);  
   elt = XCHAR_TABLE (table)->contents[charset + 128];  
   *idx = MAKE_CHAR (charset, 0, 0);  
   if (!SUB_CHAR_TABLE_P (elt))  
     return elt;  
   if (c1 < 32 || NILP (XCHAR_TABLE (elt)->contents[c1]))  
     return XCHAR_TABLE (elt)->defalt;  
   elt = XCHAR_TABLE (elt)->contents[c1];  
   *idx = MAKE_CHAR (charset, c1, 0);  
   if (!SUB_CHAR_TABLE_P (elt))  
     return elt;  
   if (c2 < 32 || NILP (XCHAR_TABLE (elt)->contents[c2]))  
     return XCHAR_TABLE (elt)->defalt;  
   *idx = c;  
   return XCHAR_TABLE (elt)->contents[c2];  
 }  
2058    
2059    
2060  /* ARGSUSED */  /* ARGSUSED */
# Line 3753  base64_decode_1 (from, to, length, multi Line 3237  base64_decode_1 (from, to, length, multi
3237     if a `:linear-search t' argument is given to make-hash-table.  */     if a `:linear-search t' argument is given to make-hash-table.  */
3238    
3239    
 /* Value is the key part of entry IDX in hash table H.  */  
   
 #define HASH_KEY(H, IDX)   AREF ((H)->key_and_value, 2 * (IDX))  
   
 /* Value is the value part of entry IDX in hash table H.  */  
   
 #define HASH_VALUE(H, IDX) AREF ((H)->key_and_value, 2 * (IDX) + 1)  
   
3240  /* Value is the index of the next entry following the one at IDX  /* Value is the index of the next entry following the one at IDX
3241     in hash table H.  */     in hash table H.  */
3242    
# Line 5084  guesswork fails.  Normally, an error is Line 4560  guesswork fails.  Normally, an error is
4560    
4561            if (STRING_MULTIBYTE (object))            if (STRING_MULTIBYTE (object))
4562              /* use default, we can't guess correct value */              /* use default, we can't guess correct value */
4563              coding_system = SYMBOL_VALUE (XCAR (Vcoding_category_list));              coding_system = preferred_coding_system ();
4564            else            else
4565              coding_system = Qraw_text;              coding_system = Qraw_text;
4566          }          }
# Line 5101  guesswork fails.  Normally, an error is Line 4577  guesswork fails.  Normally, an error is
4577          }          }
4578    
4579        if (STRING_MULTIBYTE (object))        if (STRING_MULTIBYTE (object))
4580          object = code_convert_string1 (object, coding_system, Qnil, 1);          object = code_convert_string (object, coding_system, Qnil, 1, 0, 1);
4581    
4582        size = XSTRING (object)->size;        size = XSTRING (object)->size;
4583        size_byte = STRING_BYTES (XSTRING (object));        size_byte = STRING_BYTES (XSTRING (object));
# Line 5233  guesswork fails.  Normally, an error is Line 4709  guesswork fails.  Normally, an error is
4709        object = make_buffer_string (b, e, 0);        object = make_buffer_string (b, e, 0);
4710    
4711        if (STRING_MULTIBYTE (object))        if (STRING_MULTIBYTE (object))
4712          object = code_convert_string1 (object, coding_system, Qnil, 1);          object = code_convert_string (object, coding_system, Qnil, 1, 0, 1);
4713      }      }
4714    
4715    md5_buffer (XSTRING (object)->data + start_byte,    md5_buffer (XSTRING (object)->data + start_byte,
# Line 5371  invoked by mouse clicks and mouse menu i Line 4847  invoked by mouse clicks and mouse menu i
4847    defsubr (&Sput);    defsubr (&Sput);
4848    defsubr (&Sequal);    defsubr (&Sequal);
4849    defsubr (&Sfillarray);    defsubr (&Sfillarray);
   defsubr (&Schar_table_subtype);  
   defsubr (&Schar_table_parent);  
   defsubr (&Sset_char_table_parent);  
   defsubr (&Schar_table_extra_slot);  
   defsubr (&Sset_char_table_extra_slot);  
   defsubr (&Schar_table_range);  
   defsubr (&Sset_char_table_range);  
   defsubr (&Sset_char_table_default);  
   defsubr (&Soptimize_char_table);  
   defsubr (&Smap_char_table);  
4850    defsubr (&Snconc);    defsubr (&Snconc);
4851    defsubr (&Smapcar);    defsubr (&Smapcar);
4852    defsubr (&Smapc);    defsubr (&Smapc);

Legend:
Removed from v.1.303  
changed lines
  Added in v.1.303.2.1

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