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

Diff of /emacs/src/category.c

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

revision 1.32 by lektu, Tue Feb 4 14:03:11 2003 UTC revision 1.32.6.1 by handa, Mon Sep 8 12:48:09 2003 UTC
# Line 1  Line 1 
1  /* GNU Emacs routines to deal with category tables.  /* GNU Emacs routines to deal with category tables.
2     Copyright (C) 1995, 1997 Electrotechnical Laboratory, JAPAN.     Copyright (C) 1995, 1997 Electrotechnical Laboratory, JAPAN.
3     Licensed to the Free Software Foundation.       Licensed to the Free Software Foundation.
4       Copyright (C) 2003
5         National Institute of Advanced Industrial Science and Technology (AIST)
6         Registration Number H13PRO009
7    
8  This file is part of GNU Emacs.  This file is part of GNU Emacs.
9    
# Line 27  Boston, MA 02111-1307, USA.  */ Line 30  Boston, MA 02111-1307, USA.  */
30  #include <ctype.h>  #include <ctype.h>
31  #include "lisp.h"  #include "lisp.h"
32  #include "buffer.h"  #include "buffer.h"
33    #include "character.h"
34  #include "charset.h"  #include "charset.h"
35  #include "category.h"  #include "category.h"
36  #include "keymap.h"  #include "keymap.h"
# Line 186  This is the one used for new buffers.  * Line 190  This is the one used for new buffers.  *
190    return Vstandard_category_table;    return Vstandard_category_table;
191  }  }
192    
193    
194    static void
195    copy_category_entry (table, c, val)
196         Lisp_Object table, c, val;
197    {
198      val = Fcopy_sequence (val);
199      if (CONSP (c))
200        char_table_set_range (table, XINT (XCAR (c)), XINT (XCDR (c)), val);
201      else
202        char_table_set (table, XINT (c), val);
203    }
204    
205  /* Return a copy of category table TABLE.  We can't simply use the  /* Return a copy of category table TABLE.  We can't simply use the
206     function copy-sequence because no contents should be shared between     function copy-sequence because no contents should be shared between
207     the original and the copy.  This function is called recursively by     the original and the copy.  This function is called recursively by
# Line 195  Lisp_Object Line 211  Lisp_Object
211  copy_category_table (table)  copy_category_table (table)
212       Lisp_Object table;       Lisp_Object table;
213  {  {
214    Lisp_Object tmp;    table = copy_char_table (table);
   int i, to;  
215    
216    if (!NILP (XCHAR_TABLE (table)->top))    if (! NILP (XCHAR_TABLE (table)->defalt))
217      {      XCHAR_TABLE (table)->defalt
218        /* TABLE is a top level char table.        = Fcopy_sequence (XCHAR_TABLE (table)->defalt);
219           At first, make a copy of tree structure of the table.  */    XCHAR_TABLE (table)->extras[0]
220        table = Fcopy_sequence (table);      = Fcopy_sequence (XCHAR_TABLE (table)->extras[0]);
221      map_char_table (copy_category_entry, Qnil, table, table);
       /* Then, copy elements for single byte characters one by one.  */  
       for (i = 0; i < CHAR_TABLE_SINGLE_BYTE_SLOTS; i++)  
         if (!NILP (tmp = XCHAR_TABLE (table)->contents[i]))  
           XCHAR_TABLE (table)->contents[i] = Fcopy_sequence (tmp);  
       to = CHAR_TABLE_ORDINARY_SLOTS;  
   
       /* Also copy the first (and sole) extra slot.  It is a vector  
          containing docstring of each category.  */  
       Fset_char_table_extra_slot  
         (table, make_number (0),  
          Fcopy_sequence (Fchar_table_extra_slot (table, make_number (0))));  
     }  
   else  
     {  
       i  = 32;  
       to = SUB_CHAR_TABLE_ORDINARY_SLOTS;  
     }  
   
   /* If the table has non-nil default value, copy it.  */  
   if (!NILP (tmp = XCHAR_TABLE (table)->defalt))  
     XCHAR_TABLE (table)->defalt = Fcopy_sequence (tmp);  
   
   /* At last, copy the remaining elements while paying attention to a  
      sub char table.  */  
   for (; i < to; i++)  
     if (!NILP (tmp = XCHAR_TABLE (table)->contents[i]))  
       XCHAR_TABLE (table)->contents[i]  
         = (SUB_CHAR_TABLE_P (tmp)  
            ? copy_category_table (tmp) : Fcopy_sequence (tmp));  
222    
223    return table;    return table;
224  }  }
# Line 258  DEFUN ("make-category-table", Fmake_cate Line 244  DEFUN ("make-category-table", Fmake_cate
244       ()       ()
245  {  {
246    Lisp_Object val;    Lisp_Object val;
247      int i;
248    
249    val = Fmake_char_table (Qcategory_table, Qnil);    val = Fmake_char_table (Qcategory_table, Qnil);
250    XCHAR_TABLE (val)->defalt = MAKE_CATEGORY_SET;    XCHAR_TABLE (val)->defalt = MAKE_CATEGORY_SET;
251      for (i = 0; i < (1 << CHARTAB_SIZE_BITS_0); i++)
252        XCHAR_TABLE (val)->contents[i] = MAKE_CATEGORY_SET;
253    Fset_char_table_extra_slot (val, make_number (0),    Fset_char_table_extra_slot (val, make_number (0),
254                                Fmake_vector (make_number (95), Qnil));                                Fmake_vector (make_number (95), Qnil));
255    return val;    return val;
# Line 281  DEFUN ("set-category-table", Fset_catego Line 270  DEFUN ("set-category-table", Fset_catego
270  }  }
271    
272    
273    Lisp_Object
274    char_category_set (c)
275         int c;
276    {
277      return CHAR_TABLE_REF (current_buffer->category_table, c);
278    }
279    
280  DEFUN ("char-category-set", Fchar_category_set, Schar_category_set, 1, 1, 0,  DEFUN ("char-category-set", Fchar_category_set, Schar_category_set, 1, 1, 0,
281         doc: /* Return the category set of CHAR.  */)         doc: /* Return the category set of CHAR.  */)
282       (ch)       (ch)
# Line 313  The return value is a string containing Line 309  The return value is a string containing
309    return build_string (str);    return build_string (str);
310  }  }
311    
 /* Modify all category sets stored under sub char-table TABLE so that  
    they contain (SET_VALUE is t) or don't contain (SET_VALUE is nil)  
    CATEGORY.  */  
   
 void  
 modify_lower_category_set (table, category, set_value)  
      Lisp_Object table, category, set_value;  
 {  
   Lisp_Object val;  
   int i;  
   
   val = XCHAR_TABLE (table)->defalt;  
   if (!CATEGORY_SET_P (val))  
     val = MAKE_CATEGORY_SET;  
   SET_CATEGORY_SET (val, category, set_value);  
   XCHAR_TABLE (table)->defalt = val;  
   
   for (i = 32; i < SUB_CHAR_TABLE_ORDINARY_SLOTS; i++)  
     {  
       val = XCHAR_TABLE (table)->contents[i];  
   
       if (CATEGORY_SET_P (val))  
         SET_CATEGORY_SET (val, category, set_value);  
       else if (SUB_CHAR_TABLE_P (val))  
         modify_lower_category_set (val, category, set_value);  
     }  
 }  
   
312  void  void
313  set_category_set (category_set, category, val)  set_category_set (category_set, category, val)
314       Lisp_Object category_set, category, val;       Lisp_Object category_set, category, val;
# Line 360  DEFUN ("modify-category-entry", Fmodify_ Line 328  DEFUN ("modify-category-entry", Fmodify_
328         Smodify_category_entry, 2, 4, 0,         Smodify_category_entry, 2, 4, 0,
329         doc: /* Modify the category set of CHARACTER by adding CATEGORY to it.         doc: /* Modify the category set of CHARACTER by adding CATEGORY to it.
330  The category is changed only for table TABLE, which defaults to  The category is changed only for table TABLE, which defaults to
331   the current buffer's category table.  the current buffer's category table.
332    CHARACTER can be either a single character or a cons representing the
333    lower and upper ends of an inclusive character range to modify.
334  If optional fourth argument RESET is non-nil,  If optional fourth argument RESET is non-nil,
335  then delete CATEGORY from the category set instead of adding it.  */)  then delete CATEGORY from the category set instead of adding it.  */)
336       (character, category, table, reset)       (character, category, table, reset)
337       Lisp_Object character, category, table, reset;       Lisp_Object character, category, table, reset;
338  {  {
   int c, charset, c1, c2;  
339    Lisp_Object set_value;        /* Actual value to be set in category sets.  */    Lisp_Object set_value;        /* Actual value to be set in category sets.  */
340    Lisp_Object val, category_set;    Lisp_Object category_set;
341      int start, end;
342      int from, to;
343    
344    CHECK_NUMBER (character);    if (INTEGERP (character))
   c = XINT (character);  
   CHECK_CATEGORY (category);  
   table = check_category_table (table);  
   
   if (NILP (CATEGORY_DOCSTRING (table, XFASTINT (category))))  
     error ("Undefined category: %c", XFASTINT (category));  
   
   set_value = NILP (reset) ? Qt : Qnil;  
   
   if (c < CHAR_TABLE_SINGLE_BYTE_SLOTS)  
     {  
       val = XCHAR_TABLE (table)->contents[c];  
       if (!CATEGORY_SET_P (val))  
         XCHAR_TABLE (table)->contents[c] = (val = MAKE_CATEGORY_SET);  
       SET_CATEGORY_SET (val, category, set_value);  
       return Qnil;  
     }  
   
   SPLIT_CHAR (c, charset, c1, c2);  
   
   /* The top level table.  */  
   val = XCHAR_TABLE (table)->contents[charset + 128];  
   if (CATEGORY_SET_P (val))  
     category_set = val;  
   else if (!SUB_CHAR_TABLE_P (val))  
345      {      {
346        category_set = val = MAKE_CATEGORY_SET;        CHECK_CHARACTER (character);
347        XCHAR_TABLE (table)->contents[charset + 128] = category_set;        start = end = XFASTINT (character);
348      }      }
349      else
   if (c1 <= 0)  
     {  
       /* Only a charset is specified.  */  
       if (SUB_CHAR_TABLE_P (val))  
         /* All characters in CHARSET should be the same as for having  
            CATEGORY or not.  */  
         modify_lower_category_set (val, category, set_value);  
       else  
         SET_CATEGORY_SET (category_set, category, set_value);  
       return Qnil;  
     }  
   
   /* The second level table.  */  
   if (!SUB_CHAR_TABLE_P (val))  
350      {      {
351        val = make_sub_char_table (Qnil);        CHECK_CONS (character);
352        XCHAR_TABLE (table)->contents[charset + 128] = val;        CHECK_CHARACTER_CAR (character);
353        /* We must set default category set of CHARSET in `defalt' slot.  */        CHECK_CHARACTER_CDR (character);
354        XCHAR_TABLE (val)->defalt = category_set;        start = XFASTINT (XCAR (character));
355          end = XFASTINT (XCDR (character));
356      }      }
   table = val;  
357    
358    val = XCHAR_TABLE (table)->contents[c1];    CHECK_CATEGORY (category);
359    if (CATEGORY_SET_P (val))    table = check_category_table (table);
     category_set = val;  
   else if (!SUB_CHAR_TABLE_P (val))  
     {  
       category_set = val = Fcopy_sequence (XCHAR_TABLE (table)->defalt);  
       XCHAR_TABLE (table)->contents[c1] = category_set;  
     }  
360    
361    if (c2 <= 0)    if (NILP (CATEGORY_DOCSTRING (table, XFASTINT (category))))
362      {      error ("Undefined category: %c", XFASTINT (category));
       if (SUB_CHAR_TABLE_P (val))  
         /* All characters in C1 group of CHARSET should be the same as  
            for CATEGORY.  */  
         modify_lower_category_set (val, category, set_value);  
       else  
         SET_CATEGORY_SET (category_set, category, set_value);  
       return Qnil;  
     }  
363    
364    /* The third (bottom) level table.  */    set_value = NILP (reset) ? Qt : Qnil;
   if (!SUB_CHAR_TABLE_P (val))  
     {  
       val = make_sub_char_table (Qnil);  
       XCHAR_TABLE (table)->contents[c1] = val;  
       /* We must set default category set of CHARSET and C1 in  
          `defalt' slot.  */  
       XCHAR_TABLE (val)->defalt = category_set;  
     }  
   table = val;  
365    
366    val = XCHAR_TABLE (table)->contents[c2];    while (start <= end)
   if (CATEGORY_SET_P (val))  
     category_set = val;  
   else if (!SUB_CHAR_TABLE_P (val))  
367      {      {
368        category_set = Fcopy_sequence (XCHAR_TABLE (table)->defalt);        category_set = char_table_ref_and_range (table, start, &from, &to);
369        XCHAR_TABLE (table)->contents[c2] = category_set;        if (CATEGORY_MEMBER (XFASTINT (category), category_set) != NILP (reset))
370            {
371              category_set = Fcopy_sequence (category_set);
372              SET_CATEGORY_SET (category_set, category, set_value);
373              if (to > end)
374                char_table_set_range (table, start, end, category_set);
375              else
376                char_table_set_range (table, start, to, category_set);
377            }
378          start = to + 1;
379      }      }
   else  
     /* This should never happen.  */  
     error ("Invalid category table");  
   
   SET_CATEGORY_SET (category_set, category, set_value);  
380    
381    return Qnil;    return Qnil;
382  }  }

Legend:
Removed from v.1.32  
changed lines
  Added in v.1.32.6.1

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