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

Diff of /emacs/src/casetab.c

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

revision 1.29 by rms, Sat May 17 12:44:28 2003 UTC revision 1.29.4.1 by handa, Mon Sep 8 12:48:09 2003 UTC
# Line 23  Boston, MA 02111-1307, USA.  */ Line 23  Boston, MA 02111-1307, USA.  */
23  #include <config.h>  #include <config.h>
24  #include "lisp.h"  #include "lisp.h"
25  #include "buffer.h"  #include "buffer.h"
26  #include "charset.h"  #include "character.h"
27    
28  Lisp_Object Qcase_table_p, Qcase_table;  Lisp_Object Qcase_table_p, Qcase_table;
29  Lisp_Object Vascii_downcase_table, Vascii_upcase_table;  Lisp_Object Vascii_downcase_table, Vascii_upcase_table;
# Line 138  set_case_table (table, standard) Line 138  set_case_table (table, standard)
138    if (NILP (up))    if (NILP (up))
139      {      {
140        up = Fmake_char_table (Qcase_table, Qnil);        up = Fmake_char_table (Qcase_table, Qnil);
141        map_char_table (set_identity, Qnil, table, table, up, 0, indices);        map_char_table (set_identity, Qnil, table, up);
142        map_char_table (shuffle, Qnil, table, table, up, 0, indices);        map_char_table (shuffle, Qnil, table, up);
143        XCHAR_TABLE (table)->extras[0] = up;        XCHAR_TABLE (table)->extras[0] = up;
144      }      }
145    
# Line 147  set_case_table (table, standard) Line 147  set_case_table (table, standard)
147      {      {
148        canon = Fmake_char_table (Qcase_table, Qnil);        canon = Fmake_char_table (Qcase_table, Qnil);
149        XCHAR_TABLE (table)->extras[1] = canon;        XCHAR_TABLE (table)->extras[1] = canon;
150        map_char_table (set_canon, Qnil, table, table, table, 0, indices);        map_char_table (set_canon, Qnil, table, table);
151      }      }
152    
153    if (NILP (eqv))    if (NILP (eqv))
154      {      {
155        eqv = Fmake_char_table (Qcase_table, Qnil);        eqv = Fmake_char_table (Qcase_table, Qnil);
156        map_char_table (set_identity, Qnil, canon, canon, eqv, 0, indices);        map_char_table (set_identity, Qnil, canon, eqv);
157        map_char_table (shuffle, Qnil, canon, canon, eqv, 0, indices);        map_char_table (shuffle, Qnil, canon, eqv);
158        XCHAR_TABLE (table)->extras[2] = eqv;        XCHAR_TABLE (table)->extras[2] = eqv;
159      }      }
160    
# Line 176  set_case_table (table, standard) Line 176  set_case_table (table, standard)
176    
177  /* The following functions are called in map_char_table.  */  /* The following functions are called in map_char_table.  */
178    
179  /*  Set CANON char-table element for C to a translated ELT by UP and  /* Set CANON char-table element for characters in RANGE to a
180     DOWN char-tables.  This is done only when ELT is a character.  The     translated ELT by UP and DOWN char-tables.  This is done only when
181     char-tables CANON, UP, and DOWN are in CASE_TABLE.  */     ELT is a character.  The char-tables CANON, UP, and DOWN are in
182       CASE_TABLE.  */
183    
184  static void  static void
185  set_canon (case_table, c, elt)  set_canon (case_table, range, elt)
186       Lisp_Object case_table, c, elt;       Lisp_Object case_table, range, elt;
187  {  {
188    Lisp_Object up = XCHAR_TABLE (case_table)->extras[0];    Lisp_Object up = XCHAR_TABLE (case_table)->extras[0];
189    Lisp_Object canon = XCHAR_TABLE (case_table)->extras[1];    Lisp_Object canon = XCHAR_TABLE (case_table)->extras[1];
190    
191    if (NATNUMP (elt))    if (NATNUMP (elt))
192      Faset (canon, c, Faref (case_table, Faref (up, elt)));      Fset_char_table_range (canon, range, Faref (case_table, Faref (up, elt)));
193  }  }
194    
195  /* Set elements of char-table TABLE for C to C itself.  This is done  /* Set elements of char-table TABLE for C to C itself.  C may be a
196     only when ELT is a character.  This is called in map_char_table.  */     cons specifying a character range.  In that case, set characters in
197       that range to themselves.  This is done only when ELT is a
198       character.  This is called in map_char_table.  */
199    
200  static void  static void
201  set_identity (table, c, elt)  set_identity (table, c, elt)
202       Lisp_Object table, c, elt;       Lisp_Object table, c, elt;
203  {  {
204    if (NATNUMP (elt))    if (NATNUMP (elt))
205      Faset (table, c, c);      {
206          int from, to;
207    
208          if (CONSP (c))
209            {
210              from = XINT (XCAR (c));
211              to = XINT (XCDR (c));
212            }
213          else
214            from = to = XINT (c);
215          for (; from <= to; from++)
216            CHAR_TABLE_SET (table, from, make_number (from));
217        }
218  }  }
219    
220  /* Permute the elements of TABLE (which is initially an identity  /* Permute the elements of TABLE (which is initially an identity
# Line 211  static void Line 226  static void
226  shuffle (table, c, elt)  shuffle (table, c, elt)
227       Lisp_Object table, c, elt;       Lisp_Object table, c, elt;
228  {  {
229    if (NATNUMP (elt) && !EQ (c, elt))    if (NATNUMP (elt))
230      {      {
231        Lisp_Object tem = Faref (table, elt);        Lisp_Object tem = Faref (table, elt);
232        Faset (table, elt, c);        int from, to;
233        Faset (table, c, tem);  
234          if (CONSP (c))
235            {
236              from = XINT (XCAR (c));
237              to = XINT (XCDR (c));
238            }
239          else
240            from = to = XINT (c);
241    
242          for (; from <= to; from++)
243            if (from != XINT (elt))
244              {
245                Faset (table, elt, make_number (from));
246                Faset (table, make_number (from), tem);
247              }
248      }      }
249  }  }
250    
# Line 240  init_casetab_once () Line 269  init_casetab_once ()
269    Vascii_downcase_table = down;    Vascii_downcase_table = down;
270    XCHAR_TABLE (down)->purpose = Qcase_table;    XCHAR_TABLE (down)->purpose = Qcase_table;
271    
272    for (i = 0; i < CHAR_TABLE_SINGLE_BYTE_SLOTS; i++)    for (i = 0; i < 128; i++)
273      XSETFASTINT (XCHAR_TABLE (down)->contents[i],      {
274                   (i >= 'A' && i <= 'Z') ? i + ('a' - 'A') : i);        int c = (i >= 'A' && i <= 'Z') ? i + ('a' - 'A') : i;
275          CHAR_TABLE_SET (down, i, make_number (c));
276        }
277    
278    XCHAR_TABLE (down)->extras[1] = Fcopy_sequence (down);    XCHAR_TABLE (down)->extras[1] = Fcopy_sequence (down);
279    
280    up = Fmake_char_table (Qcase_table, Qnil);    up = Fmake_char_table (Qcase_table, Qnil);
281    XCHAR_TABLE (down)->extras[0] = up;    XCHAR_TABLE (down)->extras[0] = up;
282    
283    for (i = 0; i < CHAR_TABLE_SINGLE_BYTE_SLOTS; i++)    for (i = 0; i < 128; i++)
284      XSETFASTINT (XCHAR_TABLE (up)->contents[i],      {
285                   ((i >= 'A' && i <= 'Z')        int c = ((i >= 'A' && i <= 'Z') ? i + ('a' - 'A')
286                    ? i + ('a' - 'A')                 : ((i >= 'a' && i <= 'z') ? i + ('A' - 'a')
287                    : ((i >= 'a' && i <= 'z')                    : i));;
288                       ? i + ('A' - 'a')        CHAR_TABLE_SET (up, i, make_number (c));
289                       : i)));      }
290    
291    XCHAR_TABLE (down)->extras[2] = Fcopy_sequence (up);    XCHAR_TABLE (down)->extras[2] = Fcopy_sequence (up);
292  }  }

Legend:
Removed from v.1.29  
changed lines
  Added in v.1.29.4.1

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