Mercurial > hg > xemacs-beta
comparison src/fns.c @ 207:e45d5e7c476e r20-4b2
Import from CVS: tag r20-4b2
author | cvs |
---|---|
date | Mon, 13 Aug 2007 10:03:52 +0200 |
parents | eb5470882647 |
children | 41ff10fd062f |
comparison
equal
deleted
inserted
replaced
206:d3e9274cbc4e | 207:e45d5e7c476e |
---|---|
2884 if (EQ_WITH_EBOLA_NOTICE (o1, o2)) | 2884 if (EQ_WITH_EBOLA_NOTICE (o1, o2)) |
2885 return 1; | 2885 return 1; |
2886 /* Note that (equal 20 20.0) should be nil */ | 2886 /* Note that (equal 20 20.0) should be nil */ |
2887 else if (XTYPE (o1) != XTYPE (o2)) | 2887 else if (XTYPE (o1) != XTYPE (o2)) |
2888 return 0; | 2888 return 0; |
2889 #ifndef LRECORD_CONS | |
2889 else if (CONSP (o1)) | 2890 else if (CONSP (o1)) |
2890 { | 2891 { |
2891 if (!internal_equal (XCAR (o1), XCAR (o2), depth + 1)) | 2892 if (!internal_equal (XCAR (o1), XCAR (o2), depth + 1)) |
2892 return 0; | 2893 return 0; |
2893 o1 = XCDR (o1); | 2894 o1 = XCDR (o1); |
2894 o2 = XCDR (o2); | 2895 o2 = XCDR (o2); |
2895 goto do_cdr; | 2896 goto do_cdr; |
2896 } | 2897 } |
2897 | 2898 #endif |
2898 #ifndef LRECORD_VECTOR | 2899 #ifndef LRECORD_VECTOR |
2899 else if (VECTORP (o1)) | 2900 else if (VECTORP (o1)) |
2900 { | 2901 { |
2901 int indice; | 2902 int indice; |
2902 int len = XVECTOR_LENGTH (o1); | 2903 int len = XVECTOR_LENGTH (o1); |
2910 if (!internal_equal (v1, v2, depth + 1)) | 2911 if (!internal_equal (v1, v2, depth + 1)) |
2911 return 0; | 2912 return 0; |
2912 } | 2913 } |
2913 return 1; | 2914 return 1; |
2914 } | 2915 } |
2915 #endif /* !LRECORD_VECTOR */ | 2916 #endif |
2917 #ifndef LRECORD_STRING | |
2916 else if (STRINGP (o1)) | 2918 else if (STRINGP (o1)) |
2917 { | 2919 { |
2918 Bytecount len = XSTRING_LENGTH (o1); | 2920 Bytecount len = XSTRING_LENGTH (o1); |
2919 if (len != XSTRING_LENGTH (o2)) | 2921 if (len != XSTRING_LENGTH (o2)) |
2920 return 0; | 2922 return 0; |
2921 if (memcmp (XSTRING_DATA (o1), XSTRING_DATA (o2), len)) | 2923 if (memcmp (XSTRING_DATA (o1), XSTRING_DATA (o2), len)) |
2922 return 0; | 2924 return 0; |
2923 return 1; | 2925 return 1; |
2924 } | 2926 } |
2927 #endif | |
2925 else if (LRECORDP (o1)) | 2928 else if (LRECORDP (o1)) |
2926 { | 2929 { |
2927 CONST struct lrecord_implementation | 2930 CONST struct lrecord_implementation |
2928 *imp1 = XRECORD_LHEADER (o1)->implementation, | 2931 *imp1 = XRECORD_LHEADER (o1)->implementation, |
2929 *imp2 = XRECORD_LHEADER (o2)->implementation; | 2932 *imp2 = XRECORD_LHEADER (o2)->implementation; |
2954 if (HACKEQ_UNSAFE (o1, o2)) | 2957 if (HACKEQ_UNSAFE (o1, o2)) |
2955 return 1; | 2958 return 1; |
2956 /* Note that (equal 20 20.0) should be nil */ | 2959 /* Note that (equal 20 20.0) should be nil */ |
2957 else if (XTYPE (o1) != XTYPE (o2)) | 2960 else if (XTYPE (o1) != XTYPE (o2)) |
2958 return 0; | 2961 return 0; |
2962 #ifndef LRECORD_CONS | |
2959 else if (CONSP (o1)) | 2963 else if (CONSP (o1)) |
2960 { | 2964 { |
2961 if (!internal_old_equal (XCAR (o1), XCAR (o2), depth + 1)) | 2965 if (!internal_old_equal (XCAR (o1), XCAR (o2), depth + 1)) |
2962 return 0; | 2966 return 0; |
2963 o1 = XCDR (o1); | 2967 o1 = XCDR (o1); |
2964 o2 = XCDR (o2); | 2968 o2 = XCDR (o2); |
2965 goto do_cdr; | 2969 goto do_cdr; |
2966 } | 2970 } |
2967 | 2971 #endif |
2968 #ifndef LRECORD_VECTOR | 2972 #ifndef LRECORD_VECTOR |
2969 else if (VECTORP (o1)) | 2973 else if (VECTORP (o1)) |
2970 { | 2974 { |
2971 int indice; | 2975 int indice; |
2972 int len = XVECTOR_LENGTH (o1); | 2976 int len = XVECTOR_LENGTH (o1); |
2979 depth + 1)) | 2983 depth + 1)) |
2980 return 0; | 2984 return 0; |
2981 } | 2985 } |
2982 return 1; | 2986 return 1; |
2983 } | 2987 } |
2984 #endif /* !LRECORD_VECTOR */ | 2988 #endif |
2989 #ifndef LRECORD_STRING | |
2985 else if (STRINGP (o1)) | 2990 else if (STRINGP (o1)) |
2986 { | 2991 { |
2987 Bytecount len = XSTRING_LENGTH (o1); | 2992 Bytecount len = XSTRING_LENGTH (o1); |
2988 if (len != XSTRING_LENGTH (o2)) | 2993 if (len != XSTRING_LENGTH (o2)) |
2989 return 0; | 2994 return 0; |
2990 if (memcmp (XSTRING_DATA (o1), XSTRING_DATA (o2), len)) | 2995 if (memcmp (XSTRING_DATA (o1), XSTRING_DATA (o2), len)) |
2991 return 0; | 2996 return 0; |
2992 return 1; | 2997 return 1; |
2993 } | 2998 } |
2999 #endif | |
2994 else if (LRECORDP (o1)) | 3000 else if (LRECORDP (o1)) |
2995 { | 3001 { |
2996 CONST struct lrecord_implementation | 3002 CONST struct lrecord_implementation |
2997 *imp1 = XRECORD_LHEADER (o1)->implementation, | 3003 *imp1 = XRECORD_LHEADER (o1)->implementation, |
2998 *imp2 = XRECORD_LHEADER (o2)->implementation; | 3004 *imp2 = XRECORD_LHEADER (o2)->implementation; |
3338 } | 3344 } |
3339 | 3345 |
3340 | 3346 |
3341 Lisp_Object Vfeatures; | 3347 Lisp_Object Vfeatures; |
3342 | 3348 |
3349 DEFUN ("featurep", Ffeaturep, 1, 1, 0, /* | |
3350 Return non-nil if feature FEXP is present in this Emacs. | |
3351 Use this to conditionalize execution of lisp code based on the | |
3352 presence or absence of emacs or environment extensions. | |
3353 FEXP can be a symbol, a number, or a list. | |
3354 If a symbol, it will be looked up in the `features' variable, and | |
3355 non-nil will be returned if it is found. | |
3356 If FEXP is a number, the function will return non-nil if this Emacs | |
3357 has an equal or greater version number than FEXP. | |
3358 If FEXP is a list whose car is the symbol `and', it will return | |
3359 non-nil if all the features in its cdr are non-nil. | |
3360 If FEXP is a list whose car is the symbol `or', it will return non-nil | |
3361 if any of the features in its cdr are non-nil. | |
3362 If FEXP is a list whose car is the symbol `not', it will return | |
3363 non-nil if the feature is not present. | |
3364 */ | |
3365 (fexp)) | |
3366 { | |
3343 #ifndef FEATUREP_SYNTAX | 3367 #ifndef FEATUREP_SYNTAX |
3344 DEFUN ("featurep", Ffeaturep, 1, 1, 0, /* | 3368 CHECK_SYMBOL (fexp); |
3345 Return t if FEATURE is present in this Emacs. | 3369 return NILP (Fmemq (fexp, Vfeatures)) ? Qnil : Qt; |
3346 Use this to conditionalize execution of lisp code based on the | 3370 #else /* FEATUREP_SYNTAX */ |
3347 presence or absence of emacs or environment extensions. | 3371 extern Lisp_Object Vemacs_major_version, Vemacs_minor_version; |
3348 Use `provide' to declare that a feature is available. | |
3349 This function looks at the value of the variable `features'. | |
3350 */ | |
3351 (feature)) | |
3352 { | |
3353 CHECK_SYMBOL (feature); | |
3354 return NILP (Fmemq (feature, Vfeatures)) ? Qnil : Qt; | |
3355 } | |
3356 #else | |
3357 extern Lisp_Object Vemacs_major_version, Vemacs_minor_version; | |
3358 | |
3359 DEFUN ("featurep", Ffeaturep, 1, 1, 0, /* | |
3360 Return non-nil if feature expression FEXP is true. | |
3361 */ | |
3362 (fexp)) | |
3363 { | |
3364 static double featurep_emacs_version; | 3372 static double featurep_emacs_version; |
3365 | 3373 |
3366 /* Brute force translation from Erik Naggum's lisp function. */ | 3374 /* Brute force translation from Erik Naggum's lisp function. */ |
3367 if (SYMBOLP(fexp)) | 3375 if (SYMBOLP(fexp)) |
3368 { | 3376 { |
3385 Lisp_Object tem; | 3393 Lisp_Object tem; |
3386 | 3394 |
3387 tem = XCAR(fexp); | 3395 tem = XCAR(fexp); |
3388 if (EQ(tem, Qnot)) | 3396 if (EQ(tem, Qnot)) |
3389 { | 3397 { |
3390 Lisp_Object negate = XCDR(fexp); | 3398 Lisp_Object negate; |
3391 | 3399 |
3392 if (!NILP(XCDR(fexp))) | 3400 tem = XCDR (fexp); |
3401 negate = Fcar (tem); | |
3402 if (!NILP (tem)) | |
3403 return NILP (Ffeaturep (negate)) ? Qt : Qnil; | |
3404 else | |
3405 return Fsignal (Qinvalid_read_syntax, list1 (tem)); | |
3406 } | |
3407 else if (EQ(tem, Qand)) | |
3408 { | |
3409 tem = XCDR(fexp); | |
3410 /* Use Fcar/Fcdr for error-checking. */ | |
3411 while (!NILP (tem) && !NILP (Ffeaturep (Fcar (tem)))) | |
3393 { | 3412 { |
3394 return Fsignal(Qinvalid_read_syntax, list1(XCDR(fexp))); | 3413 tem = Fcdr (tem); |
3395 } | |
3396 else | |
3397 { | |
3398 return NILP(Ffeaturep(negate)) ? Qt : Qnil; | |
3399 } | |
3400 } | |
3401 else if (EQ(tem, Qand)) | |
3402 { | |
3403 tem = XCDR(fexp); | |
3404 while (!NILP(tem) && !NILP(Ffeaturep(XCAR(tem)))) | |
3405 { | |
3406 tem = XCDR(tem); | |
3407 } | 3414 } |
3408 return NILP(tem) ? Qt : Qnil; | 3415 return NILP(tem) ? Qt : Qnil; |
3409 } | 3416 } |
3410 else if (EQ(tem, Qor)) | 3417 else if (EQ(tem, Qor)) |
3411 { | 3418 { |
3412 tem = XCDR(fexp); | 3419 tem = XCDR (fexp); |
3413 while (!NILP(tem) && NILP(Ffeaturep(XCAR(tem)))) | 3420 /* Use Fcar/Fcdr for error-checking. */ |
3421 while (!NILP (tem) && NILP (Ffeaturep (Fcar (tem)))) | |
3414 { | 3422 { |
3415 tem = XCDR(tem); | 3423 tem = Fcdr (tem); |
3416 } | 3424 } |
3417 return NILP(tem) ? Qnil : Qt; | 3425 return NILP(tem) ? Qnil : Qt; |
3418 } | 3426 } |
3419 else | 3427 else |
3420 { | 3428 { |