aboutsummaryrefslogtreecommitdiffstats
path: root/src/data.c
diff options
context:
space:
mode:
authorKaroly Lorentey2006-07-14 05:56:32 +0000
committerKaroly Lorentey2006-07-14 05:56:32 +0000
commit99715bbc447eb633e45ffa23b87284771ce3ac74 (patch)
tree3a8a53dfe3dbdd9f8e36965e9f043eae522d3c0e /src/data.c
parent556b89447234f15d1784a23dadbfe429464463a8 (diff)
parent763bb2d43615bc3ae816422f965d76d5e1ae4bdd (diff)
downloademacs-99715bbc447eb633e45ffa23b87284771ce3ac74.tar.gz
emacs-99715bbc447eb633e45ffa23b87284771ce3ac74.zip
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
Diffstat (limited to 'src/data.c')
-rw-r--r--src/data.c88
1 files changed, 28 insertions, 60 deletions
diff --git a/src/data.c b/src/data.c
index fdad80b2727..8cca837028d 100644
--- a/src/data.c
+++ b/src/data.c
@@ -114,18 +114,13 @@ Lisp_Object
114wrong_type_argument (predicate, value) 114wrong_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 ();
124 123
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. */
@@ -395,8 +390,7 @@ DEFUN ("arrayp", Farrayp, Sarrayp, 1, 1, 0,
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}
@@ -406,8 +400,7 @@ DEFUN ("sequencep", Fsequencep, Ssequencep, 1, 1, 0,
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}
@@ -537,15 +530,7 @@ 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
551DEFUN ("car-safe", Fcar_safe, Scar_safe, 1, 1, 0, 536DEFUN ("car-safe", Fcar_safe, Scar_safe, 1, 1, 0,
@@ -553,10 +538,7 @@ DEFUN ("car-safe", Fcar_safe, Scar_safe, 1, 1, 0,
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
562DEFUN ("cdr", Fcdr, Scdr, 1, 1, 0, 544DEFUN ("cdr", Fcdr, Scdr, 1, 1, 0,
@@ -568,15 +550,7 @@ 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
582DEFUN ("cdr-safe", Fcdr_safe, Scdr_safe, 1, 1, 0, 556DEFUN ("cdr-safe", Fcdr_safe, Scdr_safe, 1, 1, 0,
@@ -584,10 +558,7 @@ DEFUN ("cdr-safe", Fcdr_safe, Scdr_safe, 1, 1, 0,
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
593DEFUN ("setcar", Fsetcar, Ssetcar, 2, 2, 0, 564DEFUN ("setcar", Fsetcar, Ssetcar, 2, 2, 0,
@@ -595,9 +566,7 @@ DEFUN ("setcar", Fsetcar, Ssetcar, 2, 2, 0,
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;
@@ -608,9 +577,7 @@ DEFUN ("setcdr", Fsetcdr, Ssetcdr, 2, 2, 0,
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;
@@ -765,8 +732,7 @@ function with `&rest' args, or `unevalled' for a special form. */)
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)
@@ -784,8 +750,7 @@ SUBR must be a built-in function. */)
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}
@@ -2005,13 +1970,18 @@ function chain of symbols. */)
2005{ 1970{
2006 Lisp_Object result; 1971 Lisp_Object result;
2007 1972
2008 result = indirect_function (object); 1973 /* Optimize for no indirection. */
1974 result = object;
1975 if (SYMBOLP (result) && !EQ (result, Qunbound)
1976 && (result = XSYMBOL (result)->function, SYMBOLP (result)))
1977 result = indirect_function (result);
1978 if (!EQ (result, Qunbound))
1979 return result;
2009 1980
2010 if (EQ (result, Qunbound)) 1981 if (NILP (noerror))
2011 return (NILP (noerror) 1982 Fsignal (Qvoid_function, Fcons (object, Qnil));
2012 ? Fsignal (Qvoid_function, Fcons (object, Qnil)) 1983
2013 : Qnil); 1984 return Qnil;
2014 return result;
2015} 1985}
2016 1986
2017/* Extract and set vector and string elements */ 1987/* Extract and set vector and string elements */
@@ -2173,9 +2143,7 @@ bool-vector. IDX starts at 0. */)
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))