Mercurial > hg > xemacs-beta
comparison src/mule-charset.c @ 272:c5d627a313b1 r21-0b34
Import from CVS: tag r21-0b34
author | cvs |
---|---|
date | Mon, 13 Aug 2007 10:28:48 +0200 |
parents | f955c73f5258 |
children | 7df0dd720c89 |
comparison
equal
deleted
inserted
replaced
271:c7b7086b0a39 | 272:c5d627a313b1 |
---|---|
384 | 384 |
385 /************************************************************************/ | 385 /************************************************************************/ |
386 /* charset object */ | 386 /* charset object */ |
387 /************************************************************************/ | 387 /************************************************************************/ |
388 | 388 |
389 static Lisp_Object mark_charset (Lisp_Object, void (*) (Lisp_Object)); | |
390 static void print_charset (Lisp_Object, Lisp_Object, int); | |
391 DEFINE_LRECORD_IMPLEMENTATION ("charset", charset, | |
392 mark_charset, print_charset, 0, 0, 0, | |
393 struct Lisp_Charset); | |
394 | |
395 static Lisp_Object | 389 static Lisp_Object |
396 mark_charset (Lisp_Object obj, void (*markobj) (Lisp_Object)) | 390 mark_charset (Lisp_Object obj, void (*markobj) (Lisp_Object)) |
397 { | 391 { |
398 struct Lisp_Charset *cs = XCHARSET (obj); | 392 struct Lisp_Charset *cs = XCHARSET (obj); |
399 | 393 |
431 print_internal (CHARSET_REGISTRY (cs), printcharfun, 0); | 425 print_internal (CHARSET_REGISTRY (cs), printcharfun, 0); |
432 sprintf (buf, " 0x%x>", cs->header.uid); | 426 sprintf (buf, " 0x%x>", cs->header.uid); |
433 write_c_string (buf, printcharfun); | 427 write_c_string (buf, printcharfun); |
434 } | 428 } |
435 | 429 |
430 DEFINE_LRECORD_IMPLEMENTATION ("charset", charset, | |
431 mark_charset, print_charset, 0, 0, 0, | |
432 struct Lisp_Charset); | |
436 /* Make a new charset. */ | 433 /* Make a new charset. */ |
437 | 434 |
438 static Lisp_Object | 435 static Lisp_Object |
439 make_charset (int id, Lisp_Object name, Bufbyte leading_byte, unsigned char rep_bytes, | 436 make_charset (int id, Lisp_Object name, Bufbyte leading_byte, unsigned char rep_bytes, |
440 unsigned char type, unsigned char columns, unsigned char graphic, | 437 unsigned char type, unsigned char columns, unsigned char graphic, |
441 Bufbyte final, unsigned char direction, Lisp_Object doc, | 438 Bufbyte final, unsigned char direction, Lisp_Object doc, |
442 Lisp_Object reg) | 439 Lisp_Object reg) |
443 { | 440 { |
444 struct Lisp_Charset *cs; | 441 Lisp_Object obj; |
445 Lisp_Object obj = Qnil; | 442 struct Lisp_Charset *cs = |
446 | 443 alloc_lcrecord_type (struct Lisp_Charset, lrecord_charset); |
447 cs = alloc_lcrecord_type (struct Lisp_Charset, lrecord_charset); | |
448 XSETCHARSET (obj, cs); | 444 XSETCHARSET (obj, cs); |
449 | 445 |
450 CHARSET_ID (cs) = id; | 446 CHARSET_ID (cs) = id; |
451 CHARSET_NAME (cs) = name; | 447 CHARSET_NAME (cs) = name; |
452 CHARSET_LEADING_BYTE (cs) = leading_byte; | 448 CHARSET_LEADING_BYTE (cs) = leading_byte; |
519 DEFUN ("charsetp", Fcharsetp, 1, 1, 0, /* | 515 DEFUN ("charsetp", Fcharsetp, 1, 1, 0, /* |
520 Return non-nil if OBJECT is a charset. | 516 Return non-nil if OBJECT is a charset. |
521 */ | 517 */ |
522 (object)) | 518 (object)) |
523 { | 519 { |
524 return (CHARSETP (object) ? Qt : Qnil); | 520 return CHARSETP (object) ? Qt : Qnil; |
525 } | 521 } |
526 | 522 |
527 DEFUN ("find-charset", Ffind_charset, 1, 1, 0, /* | 523 DEFUN ("find-charset", Ffind_charset, 1, 1, 0, /* |
528 Retrieve the charset of the given name. | 524 Retrieve the charset of the given name. |
529 If CHARSET-OR-NAME is a charset object, it is simply returned. | 525 If CHARSET-OR-NAME is a charset object, it is simply returned. |
532 */ | 528 */ |
533 (charset_or_name)) | 529 (charset_or_name)) |
534 { | 530 { |
535 if (CHARSETP (charset_or_name)) | 531 if (CHARSETP (charset_or_name)) |
536 return charset_or_name; | 532 return charset_or_name; |
533 | |
537 CHECK_SYMBOL (charset_or_name); | 534 CHECK_SYMBOL (charset_or_name); |
538 | |
539 return Fgethash (charset_or_name, Vcharset_hashtable, Qnil); | 535 return Fgethash (charset_or_name, Vcharset_hashtable, Qnil); |
540 } | 536 } |
541 | 537 |
542 DEFUN ("get-charset", Fget_charset, 1, 1, 0, /* | 538 DEFUN ("get-charset", Fget_charset, 1, 1, 0, /* |
543 Retrieve the charset of the given name. | 539 Retrieve the charset of the given name. |
599 DEFUN ("charset-name", Fcharset_name, 1, 1, 0, /* | 595 DEFUN ("charset-name", Fcharset_name, 1, 1, 0, /* |
600 Return the name of the given charset. | 596 Return the name of the given charset. |
601 */ | 597 */ |
602 (charset)) | 598 (charset)) |
603 { | 599 { |
604 return (XCHARSET_NAME (Fget_charset (charset))); | 600 return XCHARSET_NAME (Fget_charset (charset)); |
605 } | 601 } |
606 | 602 |
607 DEFUN ("make-charset", Fmake_charset, 3, 3, 0, /* | 603 DEFUN ("make-charset", Fmake_charset, 3, 3, 0, /* |
608 Define a new character set. | 604 Define a new character set. |
609 This function is for use with Mule support. | 605 This function is for use with Mule support. |
925 if (EQ (prop, Qfinal)) return make_char (CHARSET_FINAL (cs)); | 921 if (EQ (prop, Qfinal)) return make_char (CHARSET_FINAL (cs)); |
926 if (EQ (prop, Qchars)) return make_int (CHARSET_CHARS (cs)); | 922 if (EQ (prop, Qchars)) return make_int (CHARSET_CHARS (cs)); |
927 if (EQ (prop, Qregistry)) return CHARSET_REGISTRY (cs); | 923 if (EQ (prop, Qregistry)) return CHARSET_REGISTRY (cs); |
928 if (EQ (prop, Qccl_program)) return CHARSET_CCL_PROGRAM (cs); | 924 if (EQ (prop, Qccl_program)) return CHARSET_CCL_PROGRAM (cs); |
929 if (EQ (prop, Qdirection)) | 925 if (EQ (prop, Qdirection)) |
930 return (CHARSET_DIRECTION (cs) == CHARSET_LEFT_TO_RIGHT ? Ql2r : Qr2l); | 926 return CHARSET_DIRECTION (cs) == CHARSET_LEFT_TO_RIGHT ? Ql2r : Qr2l; |
931 if (EQ (prop, Qreverse_direction_charset)) | 927 if (EQ (prop, Qreverse_direction_charset)) |
932 { | 928 { |
933 Lisp_Object obj = CHARSET_REVERSE_DIRECTION_CHARSET (cs); | 929 Lisp_Object obj = CHARSET_REVERSE_DIRECTION_CHARSET (cs); |
934 if (NILP (obj)) | 930 if (NILP (obj)) |
935 return Qnil; | 931 return Qnil; |