Mercurial > emacs
comparison src/data.c @ 83532:b19aaf4ab0ee
Merged from emacs@sv.gnu.org.
Patches applied:
* emacs@sv.gnu.org/emacs--devo--0--patch-331
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-332
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-333
Merge from gnus--rel--5.10
* emacs@sv.gnu.org/emacs--devo--0--patch-334
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-335
Add note about "link" button-class to etc/TODO
* emacs@sv.gnu.org/emacs--devo--0--patch-336
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-337
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-338
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-339
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-340
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-341
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-342
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-343
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-344
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-345
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-346
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-347
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-348
Update for ERC 5.1.3.
* emacs@sv.gnu.org/emacs--devo--0--patch-349
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-350
Merge from gnus--rel--5.10
* emacs@sv.gnu.org/gnus--rel--5.10--patch-111
Update from CVS: texi/gnus.texi (Summary Buffer Lines): Fix typo.
* emacs@sv.gnu.org/gnus--rel--5.10--patch-112
Update from CVS
* emacs@sv.gnu.org/gnus--rel--5.10--patch-113
Merge from emacs--devo--0
* emacs@sv.gnu.org/gnus--rel--5.10--patch-114
Update from CVS
git-archimport-id: lorentey@elte.hu--2004/emacs--multi-tty--0--patch-572
author | Karoly Lorentey <lorentey@elte.hu> |
---|---|
date | Fri, 14 Jul 2006 05:56:32 +0000 |
parents | 24cf4bf418dc dcd566ed4e9b |
children | 02e39decdc84 |
comparison
equal
deleted
inserted
replaced
83531:a387c138b28e | 83532:b19aaf4ab0ee |
---|---|
112 | 112 |
113 Lisp_Object | 113 Lisp_Object |
114 wrong_type_argument (predicate, value) | 114 wrong_type_argument (predicate, value) |
115 register Lisp_Object predicate, value; | 115 register Lisp_Object predicate, value; |
116 { | 116 { |
117 register Lisp_Object tem; | 117 /* If VALUE is not even a valid Lisp object, abort here |
118 do | 118 where we can get a backtrace showing where it came from. */ |
119 { | 119 if ((unsigned int) XGCTYPE (value) >= Lisp_Type_Limit) |
120 /* If VALUE is not even a valid Lisp object, abort here | 120 abort (); |
121 where we can get a backtrace showing where it came from. */ | 121 |
122 if ((unsigned int) XGCTYPE (value) >= Lisp_Type_Limit) | 122 Fsignal (Qwrong_type_argument, list2 (predicate, value)); |
123 abort (); | 123 |
124 | |
125 value = Fsignal (Qwrong_type_argument, Fcons (predicate, Fcons (value, Qnil))); | |
126 tem = call1 (predicate, value); | |
127 } | |
128 while (NILP (tem)); | |
129 /* This function is marked as NO_RETURN, gcc would warn if it has a | 124 /* This function is marked as NO_RETURN, gcc would warn if it has a |
130 return statement or if falls off the function. Other compilers | 125 return statement or if falls off the function. Other compilers |
131 warn if no return statement is present. */ | 126 warn if no return statement is present. */ |
132 #ifndef __GNUC__ | 127 #ifndef __GNUC__ |
133 return value; | 128 return value; |
393 DEFUN ("arrayp", Farrayp, Sarrayp, 1, 1, 0, | 388 DEFUN ("arrayp", Farrayp, Sarrayp, 1, 1, 0, |
394 doc: /* Return t if OBJECT is an array (string or vector). */) | 389 doc: /* Return t if OBJECT is an array (string or vector). */) |
395 (object) | 390 (object) |
396 Lisp_Object object; | 391 Lisp_Object object; |
397 { | 392 { |
398 if (VECTORP (object) || STRINGP (object) | 393 if (ARRAYP (object)) |
399 || CHAR_TABLE_P (object) || BOOL_VECTOR_P (object)) | |
400 return Qt; | 394 return Qt; |
401 return Qnil; | 395 return Qnil; |
402 } | 396 } |
403 | 397 |
404 DEFUN ("sequencep", Fsequencep, Ssequencep, 1, 1, 0, | 398 DEFUN ("sequencep", Fsequencep, Ssequencep, 1, 1, 0, |
405 doc: /* Return t if OBJECT is a sequence (list or array). */) | 399 doc: /* Return t if OBJECT is a sequence (list or array). */) |
406 (object) | 400 (object) |
407 register Lisp_Object object; | 401 register Lisp_Object object; |
408 { | 402 { |
409 if (CONSP (object) || NILP (object) || VECTORP (object) || STRINGP (object) | 403 if (CONSP (object) || NILP (object) || ARRAYP (object)) |
410 || CHAR_TABLE_P (object) || BOOL_VECTOR_P (object)) | |
411 return Qt; | 404 return Qt; |
412 return Qnil; | 405 return Qnil; |
413 } | 406 } |
414 | 407 |
415 DEFUN ("bufferp", Fbufferp, Sbufferp, 1, 1, 0, | 408 DEFUN ("bufferp", Fbufferp, Sbufferp, 1, 1, 0, |
535 See Info node `(elisp)Cons Cells' for a discussion of related basic | 528 See Info node `(elisp)Cons Cells' for a discussion of related basic |
536 Lisp concepts such as car, cdr, cons cell and list. */) | 529 Lisp concepts such as car, cdr, cons cell and list. */) |
537 (list) | 530 (list) |
538 register Lisp_Object list; | 531 register Lisp_Object list; |
539 { | 532 { |
540 while (1) | 533 return CAR (list); |
541 { | |
542 if (CONSP (list)) | |
543 return XCAR (list); | |
544 else if (EQ (list, Qnil)) | |
545 return Qnil; | |
546 else | |
547 list = wrong_type_argument (Qlistp, list); | |
548 } | |
549 } | 534 } |
550 | 535 |
551 DEFUN ("car-safe", Fcar_safe, Scar_safe, 1, 1, 0, | 536 DEFUN ("car-safe", Fcar_safe, Scar_safe, 1, 1, 0, |
552 doc: /* Return the car of OBJECT if it is a cons cell, or else nil. */) | 537 doc: /* Return the car of OBJECT if it is a cons cell, or else nil. */) |
553 (object) | 538 (object) |
554 Lisp_Object object; | 539 Lisp_Object object; |
555 { | 540 { |
556 if (CONSP (object)) | 541 return CAR_SAFE (object); |
557 return XCAR (object); | |
558 else | |
559 return Qnil; | |
560 } | 542 } |
561 | 543 |
562 DEFUN ("cdr", Fcdr, Scdr, 1, 1, 0, | 544 DEFUN ("cdr", Fcdr, Scdr, 1, 1, 0, |
563 doc: /* Return the cdr of LIST. If arg is nil, return nil. | 545 doc: /* Return the cdr of LIST. If arg is nil, return nil. |
564 Error if arg is not nil and not a cons cell. See also `cdr-safe'. | 546 Error if arg is not nil and not a cons cell. See also `cdr-safe'. |
566 See Info node `(elisp)Cons Cells' for a discussion of related basic | 548 See Info node `(elisp)Cons Cells' for a discussion of related basic |
567 Lisp concepts such as cdr, car, cons cell and list. */) | 549 Lisp concepts such as cdr, car, cons cell and list. */) |
568 (list) | 550 (list) |
569 register Lisp_Object list; | 551 register Lisp_Object list; |
570 { | 552 { |
571 while (1) | 553 return CDR (list); |
572 { | |
573 if (CONSP (list)) | |
574 return XCDR (list); | |
575 else if (EQ (list, Qnil)) | |
576 return Qnil; | |
577 else | |
578 list = wrong_type_argument (Qlistp, list); | |
579 } | |
580 } | 554 } |
581 | 555 |
582 DEFUN ("cdr-safe", Fcdr_safe, Scdr_safe, 1, 1, 0, | 556 DEFUN ("cdr-safe", Fcdr_safe, Scdr_safe, 1, 1, 0, |
583 doc: /* Return the cdr of OBJECT if it is a cons cell, or else nil. */) | 557 doc: /* Return the cdr of OBJECT if it is a cons cell, or else nil. */) |
584 (object) | 558 (object) |
585 Lisp_Object object; | 559 Lisp_Object object; |
586 { | 560 { |
587 if (CONSP (object)) | 561 return CDR_SAFE (object); |
588 return XCDR (object); | |
589 else | |
590 return Qnil; | |
591 } | 562 } |
592 | 563 |
593 DEFUN ("setcar", Fsetcar, Ssetcar, 2, 2, 0, | 564 DEFUN ("setcar", Fsetcar, Ssetcar, 2, 2, 0, |
594 doc: /* Set the car of CELL to be NEWCAR. Returns NEWCAR. */) | 565 doc: /* Set the car of CELL to be NEWCAR. Returns NEWCAR. */) |
595 (cell, newcar) | 566 (cell, newcar) |
596 register Lisp_Object cell, newcar; | 567 register Lisp_Object cell, newcar; |
597 { | 568 { |
598 if (!CONSP (cell)) | 569 CHECK_CONS (cell); |
599 cell = wrong_type_argument (Qconsp, cell); | |
600 | |
601 CHECK_IMPURE (cell); | 570 CHECK_IMPURE (cell); |
602 XSETCAR (cell, newcar); | 571 XSETCAR (cell, newcar); |
603 return newcar; | 572 return newcar; |
604 } | 573 } |
605 | 574 |
606 DEFUN ("setcdr", Fsetcdr, Ssetcdr, 2, 2, 0, | 575 DEFUN ("setcdr", Fsetcdr, Ssetcdr, 2, 2, 0, |
607 doc: /* Set the cdr of CELL to be NEWCDR. Returns NEWCDR. */) | 576 doc: /* Set the cdr of CELL to be NEWCDR. Returns NEWCDR. */) |
608 (cell, newcdr) | 577 (cell, newcdr) |
609 register Lisp_Object cell, newcdr; | 578 register Lisp_Object cell, newcdr; |
610 { | 579 { |
611 if (!CONSP (cell)) | 580 CHECK_CONS (cell); |
612 cell = wrong_type_argument (Qconsp, cell); | |
613 | |
614 CHECK_IMPURE (cell); | 581 CHECK_IMPURE (cell); |
615 XSETCDR (cell, newcdr); | 582 XSETCDR (cell, newcdr); |
616 return newcdr; | 583 return newcdr; |
617 } | 584 } |
618 | 585 |
763 function with `&rest' args, or `unevalled' for a special form. */) | 730 function with `&rest' args, or `unevalled' for a special form. */) |
764 (subr) | 731 (subr) |
765 Lisp_Object subr; | 732 Lisp_Object subr; |
766 { | 733 { |
767 short minargs, maxargs; | 734 short minargs, maxargs; |
768 if (!SUBRP (subr)) | 735 CHECK_SUBR (subr); |
769 wrong_type_argument (Qsubrp, subr); | |
770 minargs = XSUBR (subr)->min_args; | 736 minargs = XSUBR (subr)->min_args; |
771 maxargs = XSUBR (subr)->max_args; | 737 maxargs = XSUBR (subr)->max_args; |
772 if (maxargs == MANY) | 738 if (maxargs == MANY) |
773 return Fcons (make_number (minargs), Qmany); | 739 return Fcons (make_number (minargs), Qmany); |
774 else if (maxargs == UNEVALLED) | 740 else if (maxargs == UNEVALLED) |
782 SUBR must be a built-in function. */) | 748 SUBR must be a built-in function. */) |
783 (subr) | 749 (subr) |
784 Lisp_Object subr; | 750 Lisp_Object subr; |
785 { | 751 { |
786 const char *name; | 752 const char *name; |
787 if (!SUBRP (subr)) | 753 CHECK_SUBR (subr); |
788 wrong_type_argument (Qsubrp, subr); | |
789 name = XSUBR (subr)->symbol_name; | 754 name = XSUBR (subr)->symbol_name; |
790 return make_string (name, strlen (name)); | 755 return make_string (name, strlen (name)); |
791 } | 756 } |
792 | 757 |
793 DEFUN ("interactive-form", Finteractive_form, Sinteractive_form, 1, 1, 0, | 758 DEFUN ("interactive-form", Finteractive_form, Sinteractive_form, 1, 1, 0, |
2003 register Lisp_Object object; | 1968 register Lisp_Object object; |
2004 Lisp_Object noerror; | 1969 Lisp_Object noerror; |
2005 { | 1970 { |
2006 Lisp_Object result; | 1971 Lisp_Object result; |
2007 | 1972 |
2008 result = indirect_function (object); | 1973 /* Optimize for no indirection. */ |
2009 | 1974 result = object; |
2010 if (EQ (result, Qunbound)) | 1975 if (SYMBOLP (result) && !EQ (result, Qunbound) |
2011 return (NILP (noerror) | 1976 && (result = XSYMBOL (result)->function, SYMBOLP (result))) |
2012 ? Fsignal (Qvoid_function, Fcons (object, Qnil)) | 1977 result = indirect_function (result); |
2013 : Qnil); | 1978 if (!EQ (result, Qunbound)) |
2014 return result; | 1979 return result; |
1980 | |
1981 if (NILP (noerror)) | |
1982 Fsignal (Qvoid_function, Fcons (object, Qnil)); | |
1983 | |
1984 return Qnil; | |
2015 } | 1985 } |
2016 | 1986 |
2017 /* Extract and set vector and string elements */ | 1987 /* Extract and set vector and string elements */ |
2018 | 1988 |
2019 DEFUN ("aref", Faref, Saref, 2, 2, 0, | 1989 DEFUN ("aref", Faref, Saref, 2, 2, 0, |
2171 { | 2141 { |
2172 register int idxval; | 2142 register int idxval; |
2173 | 2143 |
2174 CHECK_NUMBER (idx); | 2144 CHECK_NUMBER (idx); |
2175 idxval = XINT (idx); | 2145 idxval = XINT (idx); |
2176 if (!VECTORP (array) && !STRINGP (array) && !BOOL_VECTOR_P (array) | 2146 CHECK_ARRAY (array, Qarrayp); |
2177 && ! CHAR_TABLE_P (array)) | |
2178 array = wrong_type_argument (Qarrayp, array); | |
2179 CHECK_IMPURE (array); | 2147 CHECK_IMPURE (array); |
2180 | 2148 |
2181 if (VECTORP (array)) | 2149 if (VECTORP (array)) |
2182 { | 2150 { |
2183 if (idxval < 0 || idxval >= XVECTOR (array)->size) | 2151 if (idxval < 0 || idxval >= XVECTOR (array)->size) |