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;