Mercurial > hg > xemacs-beta

comparison src/casetab.c @ 5125:b5df3737028a ben-lisp-object

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
merge
author Ben Wing <ben@xemacs.org>
date Wed, 24 Feb 2010 01:58:04 -0600
parents e0db3c197671 ae48681c47fa
children a9c41067dd88
comparison
equal deleted inserted replaced
5124:623d57b7fbe8 5125:b5df3737028a
51 (4) `eqv' lists the "equivalence classes" defined by `canon'. Imagine 51 (4) `eqv' lists the "equivalence classes" defined by `canon'. Imagine
52 that all characters are divided into groups having the same `canon' 52 that all characters are divided into groups having the same `canon'
53 entry; these groups are called "equivalence classes" and `eqv' lists them 53 entry; these groups are called "equivalence classes" and `eqv' lists them
54 by linking the characters in each equivalence class together in a 54 by linking the characters in each equivalence class together in a
55 circular list. That is, to find out all all the members of a given char's 55 circular list. That is, to find out all all the members of a given char's
56 equivalence classe, you need something like the following code: 56 equivalence class, you need something like the following code:
57 57
58 (let* ((char ?i) 58 (let* ((char ?i)
59 (original-char char) 59 (original-char char)
60 (standard-case-eqv (case-table-eqv (standard-case-table)))) 60 (standard-case-eqv (case-table-eqv (standard-case-table))))
61 (loop 61 (loop
103 print_case_table (Lisp_Object obj, Lisp_Object printcharfun, 103 print_case_table (Lisp_Object obj, Lisp_Object printcharfun,
104 int UNUSED (escapeflag)) 104 int UNUSED (escapeflag))
105 { 105 {
106 Lisp_Case_Table *ct = XCASE_TABLE (obj); 106 Lisp_Case_Table *ct = XCASE_TABLE (obj);
107 if (print_readably) 107 if (print_readably)
108 printing_unreadable_object ("#<case-table 0x%x>", ct->header.uid); 108 printing_unreadable_lcrecord (obj, 0);
109 write_fmt_string_lisp 109 write_fmt_string_lisp
110 (printcharfun, "#<case-table downcase=%s upcase=%s canon=%s eqv=%s ", 4, 110 (printcharfun, "#<case-table downcase=%s upcase=%s canon=%s eqv=%s ", 4,
111 CASE_TABLE_DOWNCASE (ct), CASE_TABLE_UPCASE (ct), 111 CASE_TABLE_DOWNCASE (ct), CASE_TABLE_UPCASE (ct),
112 CASE_TABLE_CANON (ct), CASE_TABLE_EQV (ct)); 112 CASE_TABLE_CANON (ct), CASE_TABLE_EQV (ct));
113 write_fmt_string (printcharfun, "0x%x>", ct->header.uid); 113 write_fmt_string (printcharfun, "0x%x>", ct->header.uid);
301 301
302 static int 302 static int
303 compute_canon_mapper (struct chartab_range *range, 303 compute_canon_mapper (struct chartab_range *range,
304 Lisp_Object UNUSED (table), Lisp_Object val, void *arg) 304 Lisp_Object UNUSED (table), Lisp_Object val, void *arg)
305 { 305 {
306 Lisp_Object casetab = VOID_TO_LISP (arg); 306 Lisp_Object casetab = GET_LISP_FROM_VOID (arg);
307 if (range->type == CHARTAB_RANGE_CHAR) 307 if (range->type == CHARTAB_RANGE_CHAR)
308 SET_TRT_TABLE_OF (XCASE_TABLE_CANON (casetab), range->ch, 308 SET_TRT_TABLE_OF (XCASE_TABLE_CANON (casetab), range->ch,
309 TRT_TABLE_OF (XCASE_TABLE_DOWNCASE (casetab), 309 TRT_TABLE_OF (XCASE_TABLE_DOWNCASE (casetab),
310 TRT_TABLE_OF (XCASE_TABLE_UPCASE (casetab), 310 TRT_TABLE_OF (XCASE_TABLE_UPCASE (casetab),
311 XCHAR (val)))); 311 XCHAR (val))));
316 static int 316 static int
317 initialize_identity_mapper (struct chartab_range *range, 317 initialize_identity_mapper (struct chartab_range *range,
318 Lisp_Object UNUSED (table), 318 Lisp_Object UNUSED (table),
319 Lisp_Object UNUSED (val), void *arg) 319 Lisp_Object UNUSED (val), void *arg)
320 { 320 {
321 Lisp_Object trt = VOID_TO_LISP (arg); 321 Lisp_Object trt = GET_LISP_FROM_VOID (arg);
322 if (range->type == CHARTAB_RANGE_CHAR) 322 if (range->type == CHARTAB_RANGE_CHAR)
323 SET_TRT_TABLE_OF (trt, range->ch, range->ch); 323 SET_TRT_TABLE_OF (trt, range->ch, range->ch);
324 324
325 return 0; 325 return 0;
326 } 326 }
328 static int 328 static int
329 compute_up_or_eqv_mapper (struct chartab_range *range, 329 compute_up_or_eqv_mapper (struct chartab_range *range,
330 Lisp_Object UNUSED (table), 330 Lisp_Object UNUSED (table),
331 Lisp_Object val, void *arg) 331 Lisp_Object val, void *arg)
332 { 332 {
333 Lisp_Object inverse = VOID_TO_LISP (arg); 333 Lisp_Object inverse = GET_LISP_FROM_VOID (arg);
334 Ichar toch = XCHAR (val); 334 Ichar toch = XCHAR (val);
335 335
336 if (range->type == CHARTAB_RANGE_CHAR && range->ch != toch) 336 if (range->type == CHARTAB_RANGE_CHAR && range->ch != toch)
337 { 337 {
338 Ichar c = TRT_TABLE_OF (inverse, toch); 338 Ichar c = TRT_TABLE_OF (inverse, toch);
358 range.type = CHARTAB_RANGE_ALL; 358 range.type = CHARTAB_RANGE_ALL;
359 /* Turn off dirty flag first so we don't get infinite recursion when 359 /* Turn off dirty flag first so we don't get infinite recursion when
360 retrieving the values below! */ 360 retrieving the values below! */
361 XCASE_TABLE (casetab)->dirty = 0; 361 XCASE_TABLE (casetab)->dirty = 0;
362 map_char_table (XCASE_TABLE_DOWNCASE (casetab), &range, 362 map_char_table (XCASE_TABLE_DOWNCASE (casetab), &range,
363 compute_canon_mapper, LISP_TO_VOID (casetab)); 363 compute_canon_mapper, STORE_LISP_IN_VOID (casetab));
364 map_char_table (XCASE_TABLE_CANON (casetab), &range, 364 map_char_table (XCASE_TABLE_CANON (casetab), &range,
365 initialize_identity_mapper, 365 initialize_identity_mapper,
366 LISP_TO_VOID (XCASE_TABLE_EQV (casetab))); 366 STORE_LISP_IN_VOID (XCASE_TABLE_EQV (casetab)));
367 map_char_table (XCASE_TABLE_CANON (casetab), &range, 367 map_char_table (XCASE_TABLE_CANON (casetab), &range,
368 compute_up_or_eqv_mapper, 368 compute_up_or_eqv_mapper,
369 LISP_TO_VOID (XCASE_TABLE_EQV (casetab))); 369 STORE_LISP_IN_VOID (XCASE_TABLE_EQV (casetab)));
370 } 370 }
371 371
372 DEFUN ("current-case-table", Fcurrent_case_table, 0, 1, 0, /* 372 DEFUN ("current-case-table", Fcurrent_case_table, 0, 1, 0, /*
373 Return the case table of BUFFER, which defaults to the current buffer. 373 Return the case table of BUFFER, which defaults to the current buffer.
374 */ 374 */
401 set_case_table (Lisp_Object table, int standard) 401 set_case_table (Lisp_Object table, int standard)
402 { 402 {
403 /* This function can GC */ 403 /* This function can GC */
404 struct buffer *buf = 404 struct buffer *buf =
405 standard ? XBUFFER (Vbuffer_defaults) : current_buffer; 405 standard ? XBUFFER (Vbuffer_defaults) : current_buffer;
406 Lisp_Object casetab;
406 407
407 check_case_table (table); 408 check_case_table (table);
408 409
409 if (CASE_TABLEP (table)) 410 if (CASE_TABLEP (table))
410 { 411 casetab = table;
411 if (standard)
412 Vstandard_case_table = table;
413
414 buf->case_table = table;
415 }
416 else 412 else
417 { 413 {
418 /* For backward compatibility. */ 414 /* For backward compatibility. */
419 Lisp_Object down, up, canon, eqv, tail = table; 415 Lisp_Object down, up, canon, eqv, tail = table;
420 Lisp_Object casetab =
421 standard ? Vstandard_case_table : buf->case_table;
422 struct chartab_range range; 416 struct chartab_range range;
417
418 casetab = Fmake_case_table ();
423 419
424 range.type = CHARTAB_RANGE_ALL; 420 range.type = CHARTAB_RANGE_ALL;
425 421
426 Freset_char_table (XCASE_TABLE_DOWNCASE (casetab)); 422 Freset_char_table (XCASE_TABLE_DOWNCASE (casetab));
427 Freset_char_table (XCASE_TABLE_UPCASE (casetab)); 423 Freset_char_table (XCASE_TABLE_UPCASE (casetab));
437 433
438 if (NILP (up)) 434 if (NILP (up))
439 { 435 {
440 map_char_table (XCASE_TABLE_DOWNCASE (casetab), &range, 436 map_char_table (XCASE_TABLE_DOWNCASE (casetab), &range,
441 initialize_identity_mapper, 437 initialize_identity_mapper,
442 LISP_TO_VOID (XCASE_TABLE_UPCASE (casetab))); 438 STORE_LISP_IN_VOID (XCASE_TABLE_UPCASE (casetab)));
443 map_char_table (XCASE_TABLE_DOWNCASE (casetab), &range, 439 map_char_table (XCASE_TABLE_DOWNCASE (casetab), &range,
444 compute_up_or_eqv_mapper, 440 compute_up_or_eqv_mapper,
445 LISP_TO_VOID (XCASE_TABLE_UPCASE (casetab))); 441 STORE_LISP_IN_VOID (XCASE_TABLE_UPCASE (casetab)));
446 } 442 }
447 else 443 else
448 convert_old_style_syntax_string (XCASE_TABLE_UPCASE (casetab), up); 444 convert_old_style_syntax_string (XCASE_TABLE_UPCASE (casetab), up);
449 445
450 if (NILP (canon)) 446 if (NILP (canon))
451 map_char_table (XCASE_TABLE_DOWNCASE (casetab), &range, 447 map_char_table (XCASE_TABLE_DOWNCASE (casetab), &range,
452 compute_canon_mapper, LISP_TO_VOID (casetab)); 448 compute_canon_mapper, STORE_LISP_IN_VOID (casetab));
453 else 449 else
454 convert_old_style_syntax_string (XCASE_TABLE_CANON (casetab), canon); 450 convert_old_style_syntax_string (XCASE_TABLE_CANON (casetab), canon);
455 451
456 if (NILP (eqv)) 452 if (NILP (eqv))
457 { 453 {
458 map_char_table (XCASE_TABLE_CANON (casetab), &range, 454 map_char_table (XCASE_TABLE_CANON (casetab), &range,
459 initialize_identity_mapper, 455 initialize_identity_mapper,
460 LISP_TO_VOID (XCASE_TABLE_EQV (casetab))); 456 STORE_LISP_IN_VOID (XCASE_TABLE_EQV (casetab)));
461 map_char_table (XCASE_TABLE_CANON (casetab), &range, 457 map_char_table (XCASE_TABLE_CANON (casetab), &range,
462 compute_up_or_eqv_mapper, 458 compute_up_or_eqv_mapper,
463 LISP_TO_VOID (XCASE_TABLE_EQV (casetab))); 459 STORE_LISP_IN_VOID (XCASE_TABLE_EQV (casetab)));
464 } 460 }
465 else 461 else
466 convert_old_style_syntax_string (XCASE_TABLE_CANON (casetab), eqv); 462 convert_old_style_syntax_string (XCASE_TABLE_CANON (casetab), eqv);
467 } 463 }
464
465
466 if (standard)
467 Vstandard_case_table = casetab;
468
469 buf->case_table = casetab;
468 470
469 return buf->case_table; 471 return buf->case_table;
470 } 472 }
471 473
472 DEFUN ("set-case-table", Fset_case_table, 1, 1, 0, /* 474 DEFUN ("set-case-table", Fset_case_table, 1, 1, 0, /*