Mercurial > hg > xemacs-beta

comparison src/fns.c @ 412:697ef44129c6 r21-2-14

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-14
author cvs
date Mon, 13 Aug 2007 11:20:41 +0200
parents de805c49cfc1
children da8ed4261e83
comparison
equal deleted inserted replaced
411:12e008d41344 412:697ef44129c6
34 #undef vector 34 #undef vector
35 #define vector ***** 35 #define vector *****
36 36
37 #include "lisp.h" 37 #include "lisp.h"
38 38
39 #include "sysfile.h" 39 #ifdef HAVE_UNISTD_H
40 #include <unistd.h>
41 #endif
42 #include <errno.h>
40 43
41 #include "buffer.h" 44 #include "buffer.h"
42 #include "bytecode.h" 45 #include "bytecode.h"
43 #include "device.h" 46 #include "device.h"
44 #include "events.h" 47 #include "events.h"
56 Lisp_Object Qidentity; 59 Lisp_Object Qidentity;
57 60
58 static int internal_old_equal (Lisp_Object, Lisp_Object, int); 61 static int internal_old_equal (Lisp_Object, Lisp_Object, int);
59 62
60 static Lisp_Object 63 static Lisp_Object
61 mark_bit_vector (Lisp_Object obj) 64 mark_bit_vector (Lisp_Object obj, void (*markobj) (Lisp_Object))
62 { 65 {
63 return Qnil; 66 return Qnil;
64 } 67 }
65 68
66 static void 69 static void
67 print_bit_vector (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) 70 print_bit_vector (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
68 { 71 {
69 size_t i; 72 int i;
70 Lisp_Bit_Vector *v = XBIT_VECTOR (obj); 73 struct Lisp_Bit_Vector *v = XBIT_VECTOR (obj);
71 size_t len = bit_vector_length (v); 74 int len = bit_vector_length (v);
72 size_t last = len; 75 int last = len;
73 76
74 if (INTP (Vprint_length)) 77 if (INTP (Vprint_length))
75 last = min (len, XINT (Vprint_length)); 78 last = min (len, XINT (Vprint_length));
76 write_c_string ("#*", printcharfun); 79 write_c_string ("#*", printcharfun);
77 for (i = 0; i < last; i++) 80 for (i = 0; i < last; i++)
87 } 90 }
88 91
89 static int 92 static int
90 bit_vector_equal (Lisp_Object obj1, Lisp_Object obj2, int depth) 93 bit_vector_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
91 { 94 {
92 Lisp_Bit_Vector *v1 = XBIT_VECTOR (obj1); 95 struct Lisp_Bit_Vector *v1 = XBIT_VECTOR (obj1);
93 Lisp_Bit_Vector *v2 = XBIT_VECTOR (obj2); 96 struct Lisp_Bit_Vector *v2 = XBIT_VECTOR (obj2);
94 97
95 return ((bit_vector_length (v1) == bit_vector_length (v2)) && 98 return ((bit_vector_length (v1) == bit_vector_length (v2)) &&
96 !memcmp (v1->bits, v2->bits, 99 !memcmp (v1->bits, v2->bits,
97 BIT_VECTOR_LONG_STORAGE (bit_vector_length (v1)) * 100 BIT_VECTOR_LONG_STORAGE (bit_vector_length (v1)) *
98 sizeof (long))); 101 sizeof (long)));
99 } 102 }
100 103
101 static unsigned long 104 static unsigned long
102 bit_vector_hash (Lisp_Object obj, int depth) 105 bit_vector_hash (Lisp_Object obj, int depth)
103 { 106 {
104 Lisp_Bit_Vector *v = XBIT_VECTOR (obj); 107 struct Lisp_Bit_Vector *v = XBIT_VECTOR (obj);
105 return HASH2 (bit_vector_length (v), 108 return HASH2 (bit_vector_length (v),
106 memory_hash (v->bits, 109 memory_hash (v->bits,
107 BIT_VECTOR_LONG_STORAGE (bit_vector_length (v)) * 110 BIT_VECTOR_LONG_STORAGE (bit_vector_length (v)) *
108 sizeof (long))); 111 sizeof (long)));
109 } 112 }
110 113
111 static size_t 114 DEFINE_BASIC_LRECORD_IMPLEMENTATION ("bit-vector", bit_vector,
112 size_bit_vector (const void *lheader) 115 mark_bit_vector, print_bit_vector, 0,
113 { 116 bit_vector_equal, bit_vector_hash,
114 Lisp_Bit_Vector *v = (Lisp_Bit_Vector *) lheader; 117 struct Lisp_Bit_Vector);
115 return FLEXIBLE_ARRAY_STRUCT_SIZEOF (Lisp_Bit_Vector, bits,
116 BIT_VECTOR_LONG_STORAGE (bit_vector_length (v)));
117 }
118
119 static const struct lrecord_description bit_vector_description[] = {
120 { XD_LISP_OBJECT, offsetof (Lisp_Bit_Vector, next) },
121 { XD_END }
122 };
123
124
125 DEFINE_BASIC_LRECORD_SEQUENCE_IMPLEMENTATION ("bit-vector", bit_vector,
126 mark_bit_vector, print_bit_vector, 0,
127 bit_vector_equal, bit_vector_hash,
128 bit_vector_description, size_bit_vector,
129 Lisp_Bit_Vector);
130 118
131 DEFUN ("identity", Fidentity, 1, 1, 0, /* 119 DEFUN ("identity", Fidentity, 1, 1, 0, /*
132 Return the argument unchanged. 120 Return the argument unchanged.
133 */ 121 */
134 (arg)) 122 (arg))
187 { 175 {
188 if (!COMPILED_FUNCTIONP (seq)) 176 if (!COMPILED_FUNCTIONP (seq))
189 return XINT (Flength (seq)); 177 return XINT (Flength (seq));
190 else 178 else
191 { 179 {
192 Lisp_Compiled_Function *f = XCOMPILED_FUNCTION (seq); 180 struct Lisp_Compiled_Function *f = XCOMPILED_FUNCTION (seq);
193 181
194 return (f->flags.interactivep ? COMPILED_INTERACTIVE : 182 return (f->flags.interactivep ? COMPILED_INTERACTIVE :
195 f->flags.domainp ? COMPILED_DOMAIN : 183 f->flags.domainp ? COMPILED_DOMAIN :
196 COMPILED_DOC_STRING) 184 COMPILED_DOC_STRING)
197 + 1; 185 + 1;
199 } 187 }
200 188
201 #endif /* LOSING_BYTECODE */ 189 #endif /* LOSING_BYTECODE */
202 190
203 void 191 void
204 check_losing_bytecode (const char *function, Lisp_Object seq) 192 check_losing_bytecode (CONST char *function, Lisp_Object seq)
205 { 193 {
206 if (COMPILED_FUNCTIONP (seq)) 194 if (COMPILED_FUNCTIONP (seq))
207 error_with_frob 195 error_with_frob
208 (seq, 196 (seq,
209 "As of 20.3, `%s' no longer works with compiled-function objects", 197 "As of 20.3, `%s' no longer works with compiled-function objects",
218 retry: 206 retry:
219 if (STRINGP (sequence)) 207 if (STRINGP (sequence))
220 return make_int (XSTRING_CHAR_LENGTH (sequence)); 208 return make_int (XSTRING_CHAR_LENGTH (sequence));
221 else if (CONSP (sequence)) 209 else if (CONSP (sequence))
222 { 210 {
223 size_t len; 211 int len;
224 GET_EXTERNAL_LIST_LENGTH (sequence, len); 212 GET_EXTERNAL_LIST_LENGTH (sequence, len);
225 return make_int (len); 213 return make_int (len);
226 } 214 }
227 else if (VECTORP (sequence)) 215 else if (VECTORP (sequence))
228 return make_int (XVECTOR_LENGTH (sequence)); 216 return make_int (XVECTOR_LENGTH (sequence));
245 which is at least the number of distinct elements. 233 which is at least the number of distinct elements.
246 */ 234 */
247 (list)) 235 (list))
248 { 236 {
249 Lisp_Object hare, tortoise; 237 Lisp_Object hare, tortoise;
250 size_t len; 238 int len;
251 239
252 for (hare = tortoise = list, len = 0; 240 for (hare = tortoise = list, len = 0;
253 CONSP (hare) && (! EQ (hare, tortoise) || len == 0); 241 CONSP (hare) && (! EQ (hare, tortoise) || len == 0);
254 hare = XCDR (hare), len++) 242 hare = XCDR (hare), len++)
255 { 243 {
271 Symbols are also allowed; their print names are used instead. 259 Symbols are also allowed; their print names are used instead.
272 */ 260 */
273 (s1, s2)) 261 (s1, s2))
274 { 262 {
275 Bytecount len; 263 Bytecount len;
276 Lisp_String *p1, *p2; 264 struct Lisp_String *p1, *p2;
277 265
278 if (SYMBOLP (s1)) 266 if (SYMBOLP (s1))
279 p1 = XSYMBOL (s1)->name; 267 p1 = XSYMBOL (s1)->name;
280 else 268 else
281 { 269 {
318 Unicode. When Unicode support is added to XEmacs/Mule, this problem 306 Unicode. When Unicode support is added to XEmacs/Mule, this problem
319 may be solved. 307 may be solved.
320 */ 308 */
321 (s1, s2)) 309 (s1, s2))
322 { 310 {
323 Lisp_String *p1, *p2; 311 struct Lisp_String *p1, *p2;
324 Charcount end, len2; 312 Charcount end, len2;
325 int i; 313 int i;
326 314
327 if (SYMBOLP (s1)) 315 if (SYMBOLP (s1))
328 p1 = XSYMBOL (s1)->name; 316 p1 = XSYMBOL (s1)->name;
349 /* There is no hope of this working under Mule. Even if we converted 337 /* There is no hope of this working under Mule. Even if we converted
350 the data into an external format so that strcoll() processed it 338 the data into an external format so that strcoll() processed it
351 properly, it would still not work because strcoll() does not 339 properly, it would still not work because strcoll() does not
352 handle multiple locales. This is the fundamental flaw in the 340 handle multiple locales. This is the fundamental flaw in the
353 locale model. */ 341 locale model. */
354 { 342 Bytecount bcend = charcount_to_bytecount (string_data (p1), end);
355 Bytecount bcend = charcount_to_bytecount (string_data (p1), end); 343 /* Compare strings using collation order of locale. */
356 /* Compare strings using collation order of locale. */ 344 /* Need to be tricky to handle embedded nulls. */
357 /* Need to be tricky to handle embedded nulls. */ 345
358 346 for (i = 0; i < bcend; i += strlen((char *) string_data (p1) + i) + 1)
359 for (i = 0; i < bcend; i += strlen((char *) string_data (p1) + i) + 1) 347 {
360 { 348 int val = strcoll ((char *) string_data (p1) + i,
361 int val = strcoll ((char *) string_data (p1) + i, 349 (char *) string_data (p2) + i);
362 (char *) string_data (p2) + i); 350 if (val < 0)
363 if (val < 0) 351 return Qt;
364 return Qt; 352 if (val > 0)
365 if (val > 0) 353 return Qnil;
366 return Qnil; 354 }
367 }
368 }
369 #else /* not I18N2, or MULE */ 355 #else /* not I18N2, or MULE */
370 { 356 /* #### It is not really necessary to do this: We could compare
371 Bufbyte *ptr1 = string_data (p1); 357 byte-by-byte and still get a reasonable comparison, since this
372 Bufbyte *ptr2 = string_data (p2); 358 would compare characters with a charset in the same way.
373 359 With a little rearrangement of the leading bytes, we could
374 /* #### It is not really necessary to do this: We could compare 360 make most inter-charset comparisons work out the same, too;
375 byte-by-byte and still get a reasonable comparison, since this 361 even if some don't, this is not a big deal because inter-charset
376 would compare characters with a charset in the same way. With 362 comparisons aren't really well-defined anyway. */
377 a little rearrangement of the leading bytes, we could make most 363 for (i = 0; i < end; i++)
378 inter-charset comparisons work out the same, too; even if some 364 {
379 don't, this is not a big deal because inter-charset comparisons 365 if (string_char (p1, i) != string_char (p2, i))
380 aren't really well-defined anyway. */ 366 return string_char (p1, i) < string_char (p2, i) ? Qt : Qnil;
381 for (i = 0; i < end; i++) 367 }
382 {
383 if (charptr_emchar (ptr1) != charptr_emchar (ptr2))
384 return charptr_emchar (ptr1) < charptr_emchar (ptr2) ? Qt : Qnil;
385 INC_CHARPTR (ptr1);
386 INC_CHARPTR (ptr2);
387 }
388 }
389 #endif /* not I18N2, or MULE */ 368 #endif /* not I18N2, or MULE */
390 /* Can't do i < len2 because then comparison between "foo" and "foo^@" 369 /* Can't do i < len2 because then comparison between "foo" and "foo^@"
391 won't work right in I18N2 case */ 370 won't work right in I18N2 case */
392 return end < len2 ? Qt : Qnil; 371 return end < len2 ? Qt : Qnil;
393 } 372 }
397 Each string has a tick counter which is incremented each time the contents 376 Each string has a tick counter which is incremented each time the contents
398 of the string are changed (e.g. with `aset'). It wraps around occasionally. 377 of the string are changed (e.g. with `aset'). It wraps around occasionally.
399 */ 378 */
400 (string)) 379 (string))
401 { 380 {
402 Lisp_String *s; 381 struct Lisp_String *s;
403 382
404 CHECK_STRING (string); 383 CHECK_STRING (string);
405 s = XSTRING (string); 384 s = XSTRING (string);
406 if (CONSP (s->plist) && INTP (XCAR (s->plist))) 385 if (CONSP (s->plist) && INTP (XCAR (s->plist)))
407 return XCAR (s->plist); 386 return XCAR (s->plist);
410 } 389 }
411 390
412 void 391 void
413 bump_string_modiff (Lisp_Object str) 392 bump_string_modiff (Lisp_Object str)
414 { 393 {
415 Lisp_String *s = XSTRING (str); 394 struct Lisp_String *s = XSTRING (str);
416 Lisp_Object *ptr = &s->plist; 395 Lisp_Object *ptr = &s->plist;
417 396
418 #ifdef I18N3 397 #ifdef I18N3
419 /* #### remove the `string-translatable' property from the string, 398 /* #### remove the `string-translatable' property from the string,
420 if there is one. */ 399 if there is one. */
525 copy_list (Lisp_Object list) 504 copy_list (Lisp_Object list)
526 { 505 {
527 Lisp_Object list_copy = Fcons (XCAR (list), XCDR (list)); 506 Lisp_Object list_copy = Fcons (XCAR (list), XCDR (list));
528 Lisp_Object last = list_copy; 507 Lisp_Object last = list_copy;
529 Lisp_Object hare, tortoise; 508 Lisp_Object hare, tortoise;
530 size_t len; 509 int len;
531 510
532 for (tortoise = hare = XCDR (list), len = 1; 511 for (tortoise = hare = XCDR (list), len = 1;
533 CONSP (hare); 512 CONSP (hare);
534 hare = XCDR (hare), len++) 513 hare = XCDR (hare), len++)
535 { 514 {
900 Relevant parts of the string-extent-data are copied in the new string. 879 Relevant parts of the string-extent-data are copied in the new string.
901 */ 880 */
902 (string, from, to)) 881 (string, from, to))
903 { 882 {
904 Charcount ccfr, ccto; 883 Charcount ccfr, ccto;
905 Bytecount bfr, blen; 884 Bytecount bfr, bto;
906 Lisp_Object val; 885 Lisp_Object val;
907 886
908 CHECK_STRING (string); 887 CHECK_STRING (string);
909 CHECK_INT (from); 888 CHECK_INT (from);
910 get_string_range_char (string, from, to, &ccfr, &ccto, 889 get_string_range_char (string, from, to, &ccfr, &ccto,
911 GB_HISTORICAL_STRING_BEHAVIOR); 890 GB_HISTORICAL_STRING_BEHAVIOR);
912 bfr = charcount_to_bytecount (XSTRING_DATA (string), ccfr); 891 bfr = charcount_to_bytecount (XSTRING_DATA (string), ccfr);
913 blen = charcount_to_bytecount (XSTRING_DATA (string) + bfr, ccto - ccfr); 892 bto = charcount_to_bytecount (XSTRING_DATA (string), ccto);
914 val = make_string (XSTRING_DATA (string) + bfr, blen); 893 val = make_string (XSTRING_DATA (string) + bfr, bto - bfr);
915 /* Copy any applicable extent information into the new string: */ 894 /* Copy any applicable extent information into the new string: */
916 copy_string_extents (val, string, 0, bfr, blen); 895 copy_string_extents (val, string, 0, bfr, bto - bfr);
917 return val; 896 return val;
918 } 897 }
919 898
920 DEFUN ("subseq", Fsubseq, 2, 3, 0, /* 899 DEFUN ("subseq", Fsubseq, 2, 3, 0, /*
921 Return the subsequence of SEQUENCE starting at START and ending before END. 900 Return a subsequence of SEQ, starting at index FROM and ending before TO.
922 END may be omitted; then the subsequence runs to the end of SEQUENCE. 901 TO may be nil or omitted; then the subsequence runs to the end of SEQ.
923 If START or END is negative, it counts from the end. 902 If FROM or TO is negative, it counts from the end.
924 The returned subsequence is always of the same type as SEQUENCE. 903 The resulting subsequence is always the same type as the original
925 If SEQUENCE is a string, relevant parts of the string-extent-data 904 sequence.
926 are copied to the new string. 905 If SEQ is a string, relevant parts of the string-extent-data are copied
927 */ 906 to the new string.
928 (sequence, start, end)) 907 */
929 { 908 (seq, from, to))
930 EMACS_INT len, s, e; 909 {
931 910 int len, f, t;
932 if (STRINGP (sequence)) 911
933 return Fsubstring (sequence, start, end); 912 if (STRINGP (seq))
934 913 return Fsubstring (seq, from, to);
935 len = XINT (Flength (sequence)); 914
936 915 if (!LISTP (seq) && !VECTORP (seq) && !BIT_VECTORP (seq))
937 CHECK_INT (start); 916 {
938 s = XINT (start); 917 check_losing_bytecode ("subseq", seq);
939 if (s < 0) 918 seq = wrong_type_argument (Qsequencep, seq);
940 s = len + s; 919 }
941 920
942 if (NILP (end)) 921 len = XINT (Flength (seq));
943 e = len; 922
923 CHECK_INT (from);
924 f = XINT (from);
925 if (f < 0)
926 f = len + f;
927
928 if (NILP (to))
929 t = len;
944 else 930 else
945 { 931 {
946 CHECK_INT (end); 932 CHECK_INT (to);
947 e = XINT (end); 933 t = XINT (to);
948 if (e < 0) 934 if (t < 0)
949 e = len + e; 935 t = len + t;
950 } 936 }
951 937
952 if (!(0 <= s && s <= e && e <= len)) 938 if (!(0 <= f && f <= t && t <= len))
953 args_out_of_range_3 (sequence, make_int (s), make_int (e)); 939 args_out_of_range_3 (seq, make_int (f), make_int (t));
954 940
955 if (VECTORP (sequence)) 941 if (VECTORP (seq))
956 { 942 {
957 Lisp_Object result = make_vector (e - s, Qnil); 943 Lisp_Object result = make_vector (t - f, Qnil);
958 EMACS_INT i; 944 int i;
959 Lisp_Object *in_elts = XVECTOR_DATA (sequence); 945 Lisp_Object *in_elts = XVECTOR_DATA (seq);
960 Lisp_Object *out_elts = XVECTOR_DATA (result); 946 Lisp_Object *out_elts = XVECTOR_DATA (result);
961 947
962 for (i = s; i < e; i++) 948 for (i = f; i < t; i++)
963 out_elts[i - s] = in_elts[i]; 949 out_elts[i - f] = in_elts[i];
964 return result; 950 return result;
965 } 951 }
966 else if (LISTP (sequence)) 952
953 if (LISTP (seq))
967 { 954 {
968 Lisp_Object result = Qnil; 955 Lisp_Object result = Qnil;
969 EMACS_INT i; 956 int i;
970 957
971 sequence = Fnthcdr (make_int (s), sequence); 958 seq = Fnthcdr (make_int (f), seq);
972 959
973 for (i = s; i < e; i++) 960 for (i = f; i < t; i++)
974 { 961 {
975 result = Fcons (Fcar (sequence), result); 962 result = Fcons (Fcar (seq), result);
976 sequence = Fcdr (sequence); 963 seq = Fcdr (seq);
977 } 964 }
978 965
979 return Fnreverse (result); 966 return Fnreverse (result);
980 } 967 }
981 else if (BIT_VECTORP (sequence)) 968
982 { 969 /* bit vector */
983 Lisp_Object result = make_bit_vector (e - s, Qzero); 970 {
984 EMACS_INT i; 971 Lisp_Object result = make_bit_vector (t - f, Qzero);
985 972 int i;
986 for (i = s; i < e; i++) 973
987 set_bit_vector_bit (XBIT_VECTOR (result), i - s, 974 for (i = f; i < t; i++)
988 bit_vector_bit (XBIT_VECTOR (sequence), i)); 975 set_bit_vector_bit (XBIT_VECTOR (result), i - f,
989 return result; 976 bit_vector_bit (XBIT_VECTOR (seq), i));
990 } 977 return result;
991 else 978 }
992 {
993 abort (); /* unreachable, since Flength (sequence) did not get
994 an error */
995 return Qnil;
996 }
997 } 979 }
998 980
999 981
1000 DEFUN ("nthcdr", Fnthcdr, 2, 2, 0, /* 982 DEFUN ("nthcdr", Fnthcdr, 2, 2, 0, /*
1001 Take cdr N times on LIST, and return the result. 983 Take cdr N times on LIST, and return the result.
1002 */ 984 */
1003 (n, list)) 985 (n, list))
1004 { 986 {
1005 REGISTER size_t i; 987 REGISTER int i;
1006 REGISTER Lisp_Object tail = list; 988 REGISTER Lisp_Object tail = list;
1007 CHECK_NATNUM (n); 989 CHECK_NATNUM (n);
1008 for (i = XINT (n); i; i--) 990 for (i = XINT (n); i; i--)
1009 { 991 {
1010 if (CONSP (tail)) 992 if (CONSP (tail))
1059 BIT_VECTORP (sequence)) 1041 BIT_VECTORP (sequence))
1060 return Faref (sequence, n); 1042 return Faref (sequence, n);
1061 #ifdef LOSING_BYTECODE 1043 #ifdef LOSING_BYTECODE
1062 else if (COMPILED_FUNCTIONP (sequence)) 1044 else if (COMPILED_FUNCTIONP (sequence))
1063 { 1045 {
1064 EMACS_INT idx = XINT (n); 1046 int idx = XINT (n);
1065 if (idx < 0) 1047 if (idx < 0)
1066 { 1048 {
1067 lose: 1049 lose:
1068 args_out_of_range (sequence, n); 1050 args_out_of_range (sequence, n);
1069 } 1051 }
1111 If N is zero, then the atom that terminates the list is returned. 1093 If N is zero, then the atom that terminates the list is returned.
1112 If N is greater than the length of LIST, then LIST itself is returned. 1094 If N is greater than the length of LIST, then LIST itself is returned.
1113 */ 1095 */
1114 (list, n)) 1096 (list, n))
1115 { 1097 {
1116 EMACS_INT int_n, count; 1098 int int_n, count;
1117 Lisp_Object retval, tortoise, hare; 1099 Lisp_Object retval, tortoise, hare;
1118 1100
1119 CHECK_LIST (list); 1101 CHECK_LIST (list);
1120 1102
1121 if (NILP (n)) 1103 if (NILP (n))
1147 Modify LIST to remove the last N (default 1) elements. 1129 Modify LIST to remove the last N (default 1) elements.
1148 If LIST has N or fewer elements, nil is returned and LIST is unmodified. 1130 If LIST has N or fewer elements, nil is returned and LIST is unmodified.
1149 */ 1131 */
1150 (list, n)) 1132 (list, n))
1151 { 1133 {
1152 EMACS_INT int_n; 1134 int int_n;
1153 1135
1154 CHECK_LIST (list); 1136 CHECK_LIST (list);
1155 1137
1156 if (NILP (n)) 1138 if (NILP (n))
1157 int_n = 1; 1139 int_n = 1;
1850 */ 1832 */
1851 int 1833 int
1852 plists_differ (Lisp_Object a, Lisp_Object b, int nil_means_not_present, 1834 plists_differ (Lisp_Object a, Lisp_Object b, int nil_means_not_present,
1853 int laxp, int depth) 1835 int laxp, int depth)
1854 { 1836 {
1855 int eqp = (depth == -1); /* -1 as depth means use eq, not equal. */ 1837 int eqp = (depth == -1); /* -1 as depth means us eq, not equal. */
1856 int la, lb, m, i, fill; 1838 int la, lb, m, i, fill;
1857 Lisp_Object *keys, *vals; 1839 Lisp_Object *keys, *vals;
1858 char *flags; 1840 char *flags;
1859 Lisp_Object rest; 1841 Lisp_Object rest;
1860 1842
1894 if (nil_means_not_present && NILP (v)) continue; 1876 if (nil_means_not_present && NILP (v)) continue;
1895 for (i = 0; i < fill; i++) 1877 for (i = 0; i < fill; i++)
1896 { 1878 {
1897 if (!laxp ? EQ (k, keys [i]) : internal_equal (k, keys [i], depth)) 1879 if (!laxp ? EQ (k, keys [i]) : internal_equal (k, keys [i], depth))
1898 { 1880 {
1899 if (eqp 1881 if ((eqp
1900 /* We narrowly escaped being Ebolified here. */ 1882 /* We narrowly escaped being Ebolified here. */
1901 ? !EQ_WITH_EBOLA_NOTICE (v, vals [i]) 1883 ? !EQ_WITH_EBOLA_NOTICE (v, vals [i])
1902 : !internal_equal (v, vals [i], depth)) 1884 : !internal_equal (v, vals [i], depth)))
1903 /* a property in B has a different value than in A */ 1885 /* a property in B has a different value than in A */
1904 goto MISMATCH; 1886 goto MISMATCH;
1905 flags [i] = 1; 1887 flags [i] = 1;
1906 break; 1888 break;
1907 } 1889 }
2368 } 2350 }
2369 2351
2370 DEFUN ("valid-plist-p", Fvalid_plist_p, 1, 1, 0, /* 2352 DEFUN ("valid-plist-p", Fvalid_plist_p, 1, 1, 0, /*
2371 Given a plist, return non-nil if its format is correct. 2353 Given a plist, return non-nil if its format is correct.
2372 If it returns nil, `check-valid-plist' will signal an error when given 2354 If it returns nil, `check-valid-plist' will signal an error when given
2373 the plist; that means it's a malformed or circular plist. 2355 the plist; that means it's a malformed or circular plist or has non-symbols
2356 as keywords.
2374 */ 2357 */
2375 (plist)) 2358 (plist))
2376 { 2359 {
2377 Lisp_Object *tortoise; 2360 Lisp_Object *tortoise;
2378 Lisp_Object *hare; 2361 Lisp_Object *hare;
2445 properties on the list. 2428 properties on the list.
2446 */ 2429 */
2447 (lax_plist, prop, default_)) 2430 (lax_plist, prop, default_))
2448 { 2431 {
2449 Lisp_Object val = external_plist_get (&lax_plist, prop, 1, ERROR_ME); 2432 Lisp_Object val = external_plist_get (&lax_plist, prop, 1, ERROR_ME);
2450 return UNBOUNDP (val) ? default_ : val; 2433 if (UNBOUNDP (val))
2434 return default_;
2435 return val;
2451 } 2436 }
2452 2437
2453 DEFUN ("lax-plist-put", Flax_plist_put, 3, 3, 0, /* 2438 DEFUN ("lax-plist-put", Flax_plist_put, 3, 3, 0, /*
2454 Change value in LAX-PLIST of PROP to VAL. 2439 Change value in LAX-PLIST of PROP to VAL.
2455 LAX-PLIST is a lax property list, which is a list of the form \(PROP1 2440 LAX-PLIST is a lax property list, which is a list of the form \(PROP1
2565 } 2550 }
2566 2551
2567 return head; 2552 return head;
2568 } 2553 }
2569 2554
2555 /* Symbol plists are directly accessible, so we need to protect against
2556 invalid property list structure */
2557
2558 static Lisp_Object
2559 symbol_getprop (Lisp_Object sym, Lisp_Object propname, Lisp_Object default_)
2560 {
2561 Lisp_Object val = external_plist_get (&XSYMBOL (sym)->plist, propname,
2562 0, ERROR_ME);
2563 return UNBOUNDP (val) ? default_ : val;
2564 }
2565
2566 static void
2567 symbol_putprop (Lisp_Object sym, Lisp_Object propname, Lisp_Object value)
2568 {
2569 external_plist_put (&XSYMBOL (sym)->plist, propname, value, 0, ERROR_ME);
2570 }
2571
2572 static int
2573 symbol_remprop (Lisp_Object symbol, Lisp_Object propname)
2574 {
2575 return external_remprop (&XSYMBOL (symbol)->plist, propname, 0, ERROR_ME);
2576 }
2577
2578 /* We store the string's extent info as the first element of the string's
2579 property list; and the string's MODIFF as the first or second element
2580 of the string's property list (depending on whether the extent info
2581 is present), but only if the string has been modified. This is ugly
2582 but it reduces the memory allocated for the string in the vast
2583 majority of cases, where the string is never modified and has no
2584 extent info. */
2585
2586
2587 static Lisp_Object *
2588 string_plist_ptr (struct Lisp_String *s)
2589 {
2590 Lisp_Object *ptr = &s->plist;
2591
2592 if (CONSP (*ptr) && EXTENT_INFOP (XCAR (*ptr)))
2593 ptr = &XCDR (*ptr);
2594 if (CONSP (*ptr) && INTP (XCAR (*ptr)))
2595 ptr = &XCDR (*ptr);
2596 return ptr;
2597 }
2598
2599 static Lisp_Object
2600 string_getprop (struct Lisp_String *s, Lisp_Object property,
2601 Lisp_Object default_)
2602 {
2603 Lisp_Object val = external_plist_get (string_plist_ptr (s), property, 0,
2604 ERROR_ME);
2605 return UNBOUNDP (val) ? default_ : val;
2606 }
2607
2608 static void
2609 string_putprop (struct Lisp_String *s, Lisp_Object property,
2610 Lisp_Object value)
2611 {
2612 external_plist_put (string_plist_ptr (s), property, value, 0, ERROR_ME);
2613 }
2614
2615 static int
2616 string_remprop (struct Lisp_String *s, Lisp_Object property)
2617 {
2618 return external_remprop (string_plist_ptr (s), property, 0, ERROR_ME);
2619 }
2620
2621 static Lisp_Object
2622 string_plist (struct Lisp_String *s)
2623 {
2624 return *string_plist_ptr (s);
2625 }
2626
2570 DEFUN ("get", Fget, 2, 3, 0, /* 2627 DEFUN ("get", Fget, 2, 3, 0, /*
2571 Return the value of OBJECT's PROPERTY property. 2628 Return the value of OBJECT's PROPNAME property.
2572 This is the last VALUE stored with `(put OBJECT PROPERTY VALUE)'. 2629 This is the last VALUE stored with `(put OBJECT PROPNAME VALUE)'.
2573 If there is no such property, return optional third arg DEFAULT 2630 If there is no such property, return optional third arg DEFAULT
2574 \(which defaults to `nil'). OBJECT can be a symbol, string, extent, 2631 \(which defaults to `nil'). OBJECT can be a symbol, face, extent,
2575 face, or glyph. See also `put', `remprop', and `object-plist'. 2632 or string. See also `put', `remprop', and `object-plist'.
2576 */ 2633 */
2577 (object, property, default_)) 2634 (object, propname, default_))
2578 { 2635 {
2579 /* Various places in emacs call Fget() and expect it not to quit, 2636 /* Various places in emacs call Fget() and expect it not to quit,
2580 so don't quit. */ 2637 so don't quit. */
2581 Lisp_Object val; 2638
2582 2639 /* It's easiest to treat symbols specially because they may not
2583 if (LRECORDP (object) && XRECORD_LHEADER_IMPLEMENTATION (object)->getprop) 2640 be an lrecord */
2584 val = XRECORD_LHEADER_IMPLEMENTATION (object)->getprop (object, property); 2641 if (SYMBOLP (object))
2642 return symbol_getprop (object, propname, default_);
2643 else if (STRINGP (object))
2644 return string_getprop (XSTRING (object), propname, default_);
2645 else if (LRECORDP (object))
2646 {
2647 CONST struct lrecord_implementation *imp
2648 = XRECORD_LHEADER_IMPLEMENTATION (object);
2649 if (!imp->getprop)
2650 goto noprops;
2651
2652 {
2653 Lisp_Object val = (imp->getprop) (object, propname);
2654 if (UNBOUNDP (val))
2655 val = default_;
2656 return val;
2657 }
2658 }
2585 else 2659 else
2586 signal_simple_error ("Object type has no properties", object); 2660 {
2587 2661 noprops:
2588 return UNBOUNDP (val) ? default_ : val; 2662 signal_simple_error ("Object type has no properties", object);
2663 return Qnil; /* Not reached */
2664 }
2589 } 2665 }
2590 2666
2591 DEFUN ("put", Fput, 3, 3, 0, /* 2667 DEFUN ("put", Fput, 3, 3, 0, /*
2592 Set OBJECT's PROPERTY to VALUE. 2668 Store OBJECT's PROPNAME property with value VALUE.
2593 It can be subsequently retrieved with `(get OBJECT PROPERTY)'. 2669 It can be retrieved with `(get OBJECT PROPNAME)'. OBJECT can be a
2594 OBJECT can be a symbol, face, extent, or string. 2670 symbol, face, extent, or string.
2671
2595 For a string, no properties currently have predefined meanings. 2672 For a string, no properties currently have predefined meanings.
2596 For the predefined properties for extents, see `set-extent-property'. 2673 For the predefined properties for extents, see `set-extent-property'.
2597 For the predefined properties for faces, see `set-face-property'. 2674 For the predefined properties for faces, see `set-face-property'.
2675
2598 See also `get', `remprop', and `object-plist'. 2676 See also `get', `remprop', and `object-plist'.
2599 */ 2677 */
2600 (object, property, value)) 2678 (object, propname, value))
2601 { 2679 {
2680 CHECK_SYMBOL (propname);
2602 CHECK_LISP_WRITEABLE (object); 2681 CHECK_LISP_WRITEABLE (object);
2603 2682
2604 if (LRECORDP (object) && XRECORD_LHEADER_IMPLEMENTATION (object)->putprop) 2683 if (SYMBOLP (object))
2605 { 2684 symbol_putprop (object, propname, value);
2606 if (! XRECORD_LHEADER_IMPLEMENTATION (object)->putprop 2685 else if (STRINGP (object))
2607 (object, property, value)) 2686 string_putprop (XSTRING (object), propname, value);
2608 signal_simple_error ("Can't set property on object", property); 2687 else if (LRECORDP (object))
2688 {
2689 CONST struct lrecord_implementation
2690 *imp = XRECORD_LHEADER_IMPLEMENTATION (object);
2691 if (imp->putprop)
2692 {
2693 if (! (imp->putprop) (object, propname, value))
2694 signal_simple_error ("Can't set property on object", propname);
2695 }
2696 else
2697 goto noprops;
2609 } 2698 }
2610 else 2699 else
2611 signal_simple_error ("Object type has no settable properties", object); 2700 {
2701 noprops:
2702 signal_simple_error ("Object type has no settable properties", object);
2703 }
2612 2704
2613 return value; 2705 return value;
2614 } 2706 }
2615 2707
2708 void
2709 pure_put (Lisp_Object sym, Lisp_Object prop, Lisp_Object val)
2710 {
2711 Fput (sym, prop, Fpurecopy (val));
2712 }
2713
2616 DEFUN ("remprop", Fremprop, 2, 2, 0, /* 2714 DEFUN ("remprop", Fremprop, 2, 2, 0, /*
2617 Remove, from OBJECT's property list, PROPERTY and its corresponding value. 2715 Remove from OBJECT's property list the property PROPNAME and its
2618 OBJECT can be a symbol, string, extent, face, or glyph. Return non-nil 2716 value. OBJECT can be a symbol, face, extent, or string. Returns
2619 if the property list was actually modified (i.e. if PROPERTY was present 2717 non-nil if the property list was actually changed (i.e. if PROPNAME
2620 in the property list). See also `get', `put', and `object-plist'. 2718 was present in the property list). See also `get', `put', and
2621 */ 2719 `object-plist'.
2622 (object, property)) 2720 */
2623 { 2721 (object, propname))
2624 int ret = 0; 2722 {
2625 2723 int retval = 0;
2724
2725 CHECK_SYMBOL (propname);
2626 CHECK_LISP_WRITEABLE (object); 2726 CHECK_LISP_WRITEABLE (object);
2627 2727
2628 if (LRECORDP (object) && XRECORD_LHEADER_IMPLEMENTATION (object)->remprop) 2728 if (SYMBOLP (object))
2629 { 2729 retval = symbol_remprop (object, propname);
2630 ret = XRECORD_LHEADER_IMPLEMENTATION (object)->remprop (object, property); 2730 else if (STRINGP (object))
2631 if (ret == -1) 2731 retval = string_remprop (XSTRING (object), propname);
2632 signal_simple_error ("Can't remove property from object", property); 2732 else if (LRECORDP (object))
2733 {
2734 CONST struct lrecord_implementation
2735 *imp = XRECORD_LHEADER_IMPLEMENTATION (object);
2736 if (imp->remprop)
2737 {
2738 retval = (imp->remprop) (object, propname);
2739 if (retval == -1)
2740 signal_simple_error ("Can't remove property from object",
2741 propname);
2742 }
2743 else
2744 goto noprops;
2633 } 2745 }
2634 else 2746 else
2635 signal_simple_error ("Object type has no removable properties", object); 2747 {
2636 2748 noprops:
2637 return ret ? Qt : Qnil; 2749 signal_simple_error ("Object type has no removable properties", object);
2750 }
2751
2752 return retval ? Qt : Qnil;
2638 } 2753 }
2639 2754
2640 DEFUN ("object-plist", Fobject_plist, 1, 1, 0, /* 2755 DEFUN ("object-plist", Fobject_plist, 1, 1, 0, /*
2641 Return a property list of OBJECT's properties. 2756 Return a property list of OBJECT's props.
2642 For a symbol, this is equivalent to `symbol-plist'. 2757 For a symbol this is equivalent to `symbol-plist'.
2643 OBJECT can be a symbol, string, extent, face, or glyph. 2758 Do not modify the property list directly; this may or may not have
2644 Do not modify the returned property list directly; 2759 the desired effects. (In particular, for a property with a special
2645 this may or may not have the desired effects. Use `put' instead. 2760 interpretation, this will probably have no effect at all.)
2646 */ 2761 */
2647 (object)) 2762 (object))
2648 { 2763 {
2649 if (LRECORDP (object) && XRECORD_LHEADER_IMPLEMENTATION (object)->plist) 2764 if (SYMBOLP (object))
2650 return XRECORD_LHEADER_IMPLEMENTATION (object)->plist (object); 2765 return Fsymbol_plist (object);
2766 else if (STRINGP (object))
2767 return string_plist (XSTRING (object));
2768 else if (LRECORDP (object))
2769 {
2770 CONST struct lrecord_implementation
2771 *imp = XRECORD_LHEADER_IMPLEMENTATION (object);
2772 if (imp->plist)
2773 return (imp->plist) (object);
2774 else
2775 signal_simple_error ("Object type has no properties", object);
2776 }
2651 else 2777 else
2652 signal_simple_error ("Object type has no properties", object); 2778 signal_simple_error ("Object type has no properties", object);
2653 2779
2654 return Qnil; 2780 return Qnil;
2655 } 2781 }
2666 /* Note that (equal 20 20.0) should be nil */ 2792 /* Note that (equal 20 20.0) should be nil */
2667 if (XTYPE (obj1) != XTYPE (obj2)) 2793 if (XTYPE (obj1) != XTYPE (obj2))
2668 return 0; 2794 return 0;
2669 if (LRECORDP (obj1)) 2795 if (LRECORDP (obj1))
2670 { 2796 {
2671 const struct lrecord_implementation 2797 CONST struct lrecord_implementation
2672 *imp1 = XRECORD_LHEADER_IMPLEMENTATION (obj1), 2798 *imp1 = XRECORD_LHEADER_IMPLEMENTATION (obj1),
2673 *imp2 = XRECORD_LHEADER_IMPLEMENTATION (obj2); 2799 *imp2 = XRECORD_LHEADER_IMPLEMENTATION (obj2);
2674 2800
2675 return (imp1 == imp2) && 2801 return (imp1 == imp2) &&
2676 /* EQ-ness of the objects was noticed above */ 2802 /* EQ-ness of the objects was noticed above */
2726 return internal_old_equal (obj1, obj2, 0) ? Qt : Qnil; 2852 return internal_old_equal (obj1, obj2, 0) ? Qt : Qnil;
2727 } 2853 }
2728 2854
2729 2855
2730 DEFUN ("fillarray", Ffillarray, 2, 2, 0, /* 2856 DEFUN ("fillarray", Ffillarray, 2, 2, 0, /*
2731 Destructively modify ARRAY by replacing each element with ITEM. 2857 Store each element of ARRAY with ITEM.
2732 ARRAY is a vector, bit vector, or string. 2858 ARRAY is a vector, bit vector, or string.
2733 */ 2859 */
2734 (array, item)) 2860 (array, item))
2735 { 2861 {
2736 retry: 2862 retry:
2737 if (STRINGP (array)) 2863 if (STRINGP (array))
2738 { 2864 {
2739 Lisp_String *s = XSTRING (array); 2865 Emchar charval;
2740 Bytecount old_bytecount = string_length (s); 2866 struct Lisp_String *s = XSTRING (array);
2741 Bytecount new_bytecount; 2867 Charcount len = string_char_length (s);
2742 Bytecount item_bytecount; 2868 Charcount i;
2743 Bufbyte item_buf[MAX_EMCHAR_LEN];
2744 Bufbyte *p;
2745 Bufbyte *end;
2746
2747 CHECK_CHAR_COERCE_INT (item); 2869 CHECK_CHAR_COERCE_INT (item);
2748 CHECK_LISP_WRITEABLE (array); 2870 CHECK_LISP_WRITEABLE (array);
2749 2871 charval = XCHAR (item);
2750 item_bytecount = set_charptr_emchar (item_buf, XCHAR (item)); 2872 for (i = 0; i < len; i++)
2751 new_bytecount = item_bytecount * string_char_length (s); 2873 set_string_char (s, i, charval);
2752
2753 resize_string (s, -1, new_bytecount - old_bytecount);
2754
2755 for (p = string_data (s), end = p + new_bytecount;
2756 p < end;
2757 p += item_bytecount)
2758 memcpy (p, item_buf, item_bytecount);
2759 *p = '\0';
2760
2761 bump_string_modiff (array); 2874 bump_string_modiff (array);
2762 } 2875 }
2763 else if (VECTORP (array)) 2876 else if (VECTORP (array))
2764 { 2877 {
2765 Lisp_Object *p = XVECTOR_DATA (array); 2878 Lisp_Object *p = XVECTOR_DATA (array);
2768 while (len--) 2881 while (len--)
2769 *p++ = item; 2882 *p++ = item;
2770 } 2883 }
2771 else if (BIT_VECTORP (array)) 2884 else if (BIT_VECTORP (array))
2772 { 2885 {
2773 Lisp_Bit_Vector *v = XBIT_VECTOR (array); 2886 struct Lisp_Bit_Vector *v = XBIT_VECTOR (array);
2774 int len = bit_vector_length (v); 2887 int len = bit_vector_length (v);
2775 int bit; 2888 int bit;
2776 CHECK_BIT (item); 2889 CHECK_BIT (item);
2777 CHECK_LISP_WRITEABLE (array); 2890 CHECK_LISP_WRITEABLE (array);
2778 bit = XINT (item); 2891 bit = XINT (item);
2918 } 3031 }
2919 RETURN_UNGCPRO (Qnil); /* No non-nil args provided. */ 3032 RETURN_UNGCPRO (Qnil); /* No non-nil args provided. */
2920 } 3033 }
2921 3034
2922 3035
2923 /* This is the guts of several mapping functions. 3036 /* This is the guts of all mapping functions.
2924 Apply FUNCTION to each element of SEQUENCE, one by one, 3037 Apply fn to each element of seq, one by one,
2925 storing the results into elements of VALS, a C vector of Lisp_Objects. 3038 storing the results into elements of vals, a C vector of Lisp_Objects.
2926 LENI is the length of VALS, which should also be the length of SEQUENCE. 3039 leni is the length of vals, which should also be the length of seq.
2927 3040
2928 If VALS is a null pointer, do not accumulate the results. */ 3041 If VALS is a null pointer, do not accumulate the results. */
2929 3042
2930 static void 3043 static void
2931 mapcar1 (size_t leni, Lisp_Object *vals, 3044 mapcar1 (size_t leni, Lisp_Object *vals, Lisp_Object fn, Lisp_Object seq)
2932 Lisp_Object function, Lisp_Object sequence)
2933 { 3045 {
2934 Lisp_Object result; 3046 Lisp_Object result;
2935 Lisp_Object args[2]; 3047 Lisp_Object args[2];
2936 int i; 3048 int i;
2937 struct gcpro gcpro1; 3049 struct gcpro gcpro1;
2940 { 3052 {
2941 GCPRO1 (vals[0]); 3053 GCPRO1 (vals[0]);
2942 gcpro1.nvars = 0; 3054 gcpro1.nvars = 0;
2943 } 3055 }
2944 3056
2945 args[0] = function; 3057 args[0] = fn;
2946 3058
2947 if (LISTP (sequence)) 3059 if (LISTP (seq))
2948 { 3060 {
2949 /* A devious `function' could either: 3061 for (i = 0; i < leni; i++)
2950 - insert garbage into the list in front of us, causing XCDR to crash 3062 {
2951 - amputate the list behind us using (setcdr), causing the remaining 3063 args[1] = XCAR (seq);
2952 elts to lose their GCPRO status. 3064 seq = XCDR (seq);
2953 3065 result = Ffuncall (2, args);
2954 if (vals != 0) we avoid this by copying the elts into the 3066 if (vals) vals[gcpro1.nvars++] = result;
2955 `vals' array. By a stroke of luck, `vals' is exactly large 3067 }
2956 enough to hold the elts left to be traversed as well as the 3068 }
2957 results computed so far. 3069 else if (VECTORP (seq))
2958 3070 {
2959 if (vals == 0) we don't have any free space available and 3071 Lisp_Object *objs = XVECTOR_DATA (seq);
2960 don't want to eat up any more stack with alloca().
2961 So we use EXTERNAL_LIST_LOOP_3 and GCPRO the tail. */
2962
2963 if (vals)
2964 {
2965 Lisp_Object *val = vals;
2966 Lisp_Object elt;
2967
2968 LIST_LOOP_2 (elt, sequence)
2969 *val++ = elt;
2970
2971 gcpro1.nvars = leni;
2972
2973 for (i = 0; i < leni; i++)
2974 {
2975 args[1] = vals[i];
2976 vals[i] = Ffuncall (2, args);
2977 }
2978 }
2979 else
2980 {
2981 Lisp_Object elt, tail;
2982 struct gcpro ngcpro1;
2983
2984 NGCPRO1 (tail);
2985
2986 {
2987 EXTERNAL_LIST_LOOP_3 (elt, sequence, tail)
2988 {
2989 args[1] = elt;
2990 Ffuncall (2, args);
2991 }
2992 }
2993
2994 NUNGCPRO;
2995 }
2996 }
2997 else if (VECTORP (sequence))
2998 {
2999 Lisp_Object *objs = XVECTOR_DATA (sequence);
3000 for (i = 0; i < leni; i++) 3072 for (i = 0; i < leni; i++)
3001 { 3073 {
3002 args[1] = *objs++; 3074 args[1] = *objs++;
3003 result = Ffuncall (2, args); 3075 result = Ffuncall (2, args);
3004 if (vals) vals[gcpro1.nvars++] = result; 3076 if (vals) vals[gcpro1.nvars++] = result;
3005 } 3077 }
3006 } 3078 }
3007 else if (STRINGP (sequence)) 3079 else if (STRINGP (seq))
3008 { 3080 {
3009 /* The string data of `sequence' might be relocated during GC. */ 3081 Bufbyte *p = XSTRING_DATA (seq);
3010 Bytecount slen = XSTRING_LENGTH (sequence); 3082 for (i = 0; i < leni; i++)
3011 Bufbyte *p = alloca_array (Bufbyte, slen);
3012 Bufbyte *end = p + slen;
3013
3014 memcpy (p, XSTRING_DATA (sequence), slen);
3015
3016 while (p < end)
3017 { 3083 {
3018 args[1] = make_char (charptr_emchar (p)); 3084 args[1] = make_char (charptr_emchar (p));
3019 INC_CHARPTR (p); 3085 INC_CHARPTR (p);
3020 result = Ffuncall (2, args); 3086 result = Ffuncall (2, args);
3021 if (vals) vals[gcpro1.nvars++] = result; 3087 if (vals) vals[gcpro1.nvars++] = result;
3022 } 3088 }
3023 } 3089 }
3024 else if (BIT_VECTORP (sequence)) 3090 else if (BIT_VECTORP (seq))
3025 { 3091 {
3026 Lisp_Bit_Vector *v = XBIT_VECTOR (sequence); 3092 struct Lisp_Bit_Vector *v = XBIT_VECTOR (seq);
3027 for (i = 0; i < leni; i++) 3093 for (i = 0; i < leni; i++)
3028 { 3094 {
3029 args[1] = make_int (bit_vector_bit (v, i)); 3095 args[1] = make_int (bit_vector_bit (v, i));
3030 result = Ffuncall (2, args); 3096 result = Ffuncall (2, args);
3031 if (vals) vals[gcpro1.nvars++] = result; 3097 if (vals) vals[gcpro1.nvars++] = result;
3032 } 3098 }
3033 } 3099 }
3034 else 3100 else
3035 abort (); /* unreachable, since Flength (sequence) did not get an error */ 3101 abort(); /* cannot get here since Flength(seq) did not get an error */
3036 3102
3037 if (vals) 3103 if (vals)
3038 UNGCPRO; 3104 UNGCPRO;
3039 } 3105 }
3040 3106
3041 DEFUN ("mapconcat", Fmapconcat, 3, 3, 0, /* 3107 DEFUN ("mapconcat", Fmapconcat, 3, 3, 0, /*
3042 Apply FUNCTION to each element of SEQUENCE, and concat the results as strings. 3108 Apply FN to each element of SEQ, and concat the results as strings.
3043 In between each pair of results, insert SEPARATOR. Thus, using " " as 3109 In between each pair of results, stick in SEP.
3044 SEPARATOR results in spaces between the values returned by FUNCTION. 3110 Thus, " " as SEP results in spaces between the values returned by FN.
3045 SEQUENCE may be a list, a vector, a bit vector, or a string. 3111 */
3046 */ 3112 (fn, seq, sep))
3047 (function, sequence, separator)) 3113 {
3048 { 3114 size_t len = XINT (Flength (seq));
3049 size_t len = XINT (Flength (sequence));
3050 Lisp_Object *args; 3115 Lisp_Object *args;
3051 int i; 3116 int i;
3117 struct gcpro gcpro1;
3052 int nargs = len + len - 1; 3118 int nargs = len + len - 1;
3053 3119
3054 if (len == 0) return build_string (""); 3120 if (nargs < 0) return build_string ("");
3055 3121
3056 args = alloca_array (Lisp_Object, nargs); 3122 args = alloca_array (Lisp_Object, nargs);
3057 3123
3058 mapcar1 (len, args, function, sequence); 3124 GCPRO1 (sep);
3125 mapcar1 (len, args, fn, seq);
3126 UNGCPRO;
3059 3127
3060 for (i = len - 1; i >= 0; i--) 3128 for (i = len - 1; i >= 0; i--)
3061 args[i + i] = args[i]; 3129 args[i + i] = args[i];
3062 3130
3063 for (i = 1; i < nargs; i += 2) 3131 for (i = 1; i < nargs; i += 2)
3064 args[i] = separator; 3132 args[i] = sep;
3065 3133
3066 return Fconcat (nargs, args); 3134 return Fconcat (nargs, args);
3067 } 3135 }
3068 3136
3069 DEFUN ("mapcar", Fmapcar, 2, 2, 0, /* 3137 DEFUN ("mapcar", Fmapcar, 2, 2, 0, /*
3070 Apply FUNCTION to each element of SEQUENCE; return a list of the results. 3138 Apply FUNCTION to each element of SEQUENCE, and make a list of the results.
3071 The result is a list of the same length as SEQUENCE. 3139 The result is a list just as long as SEQUENCE.
3072 SEQUENCE may be a list, a vector, a bit vector, or a string. 3140 SEQUENCE may be a list, a vector, a bit vector, or a string.
3073 */ 3141 */
3074 (function, sequence)) 3142 (fn, seq))
3075 { 3143 {
3076 size_t len = XINT (Flength (sequence)); 3144 size_t len = XINT (Flength (seq));
3077 Lisp_Object *args = alloca_array (Lisp_Object, len); 3145 Lisp_Object *args = alloca_array (Lisp_Object, len);
3078 3146
3079 mapcar1 (len, args, function, sequence); 3147 mapcar1 (len, args, fn, seq);
3080 3148
3081 return Flist (len, args); 3149 return Flist (len, args);
3082 } 3150 }
3083 3151
3084 DEFUN ("mapvector", Fmapvector, 2, 2, 0, /* 3152 DEFUN ("mapvector", Fmapvector, 2, 2, 0, /*
3085 Apply FUNCTION to each element of SEQUENCE; return a vector of the results. 3153 Apply FUNCTION to each element of SEQUENCE, making a vector of the results.
3086 The result is a vector of the same length as SEQUENCE. 3154 The result is a vector of the same length as SEQUENCE.
3087 SEQUENCE may be a list, a vector, a bit vector, or a string. 3155 SEQUENCE may be a list, a vector or a string.
3088 */ 3156 */
3089 (function, sequence)) 3157 (fn, seq))
3090 { 3158 {
3091 size_t len = XINT (Flength (sequence)); 3159 size_t len = XINT (Flength (seq));
3092 Lisp_Object result = make_vector (len, Qnil); 3160 Lisp_Object result = make_vector (len, Qnil);
3093 struct gcpro gcpro1; 3161 struct gcpro gcpro1;
3094 3162
3095 GCPRO1 (result); 3163 GCPRO1 (result);
3096 mapcar1 (len, XVECTOR_DATA (result), function, sequence); 3164 mapcar1 (len, XVECTOR_DATA (result), fn, seq);
3097 UNGCPRO; 3165 UNGCPRO;
3098 3166
3099 return result; 3167 return result;
3100 } 3168 }
3101 3169
3102 DEFUN ("mapc-internal", Fmapc_internal, 2, 2, 0, /* 3170 DEFUN ("mapc", Fmapc, 2, 2, 0, /*
3103 Apply FUNCTION to each element of SEQUENCE. 3171 Apply FUNCTION to each element of SEQUENCE.
3104 SEQUENCE may be a list, a vector, a bit vector, or a string. 3172 SEQUENCE may be a list, a vector, a bit vector, or a string.
3105 This function is like `mapcar' but does not accumulate the results, 3173 This function is like `mapcar' but does not accumulate the results,
3106 which is more efficient if you do not use the results. 3174 which is more efficient if you do not use the results.
3107 3175 */
3108 The difference between this and `mapc' is that `mapc' supports all 3176 (fn, seq))
3109 the spiffy Common Lisp arguments. You should normally use `mapc'. 3177 {
3110 */ 3178 mapcar1 (XINT (Flength (seq)), 0, fn, seq);
3111 (function, sequence)) 3179
3112 { 3180 return seq;
3113 mapcar1 (XINT (Flength (sequence)), 0, function, sequence);
3114
3115 return sequence;
3116 }
3117
3118
3119
3120
3121 DEFUN ("replace-list", Freplace_list, 2, 2, 0, /*
3122 Destructively replace the list OLD with NEW.
3123 This is like (copy-sequence NEW) except that it reuses the
3124 conses in OLD as much as possible. If OLD and NEW are the same
3125 length, no consing will take place.
3126 */
3127 (old, new))
3128 {
3129 Lisp_Object tail, oldtail = old, prevoldtail = Qnil;
3130
3131 EXTERNAL_LIST_LOOP (tail, new)
3132 {
3133 if (!NILP (oldtail))
3134 {
3135 CHECK_CONS (oldtail);
3136 XCAR (oldtail) = XCAR (tail);
3137 }
3138 else if (!NILP (prevoldtail))
3139 {
3140 XCDR (prevoldtail) = Fcons (XCAR (tail), Qnil);
3141 prevoldtail = XCDR (prevoldtail);
3142 }
3143 else
3144 old = oldtail = Fcons (XCAR (tail), Qnil);
3145
3146 if (!NILP (oldtail))
3147 {
3148 prevoldtail = oldtail;
3149 oldtail = XCDR (oldtail);
3150 }
3151 }
3152
3153 if (!NILP (prevoldtail))
3154 XCDR (prevoldtail) = Qnil;
3155 else
3156 old = Qnil;
3157
3158 return old;
3159 } 3181 }
3160 3182
3161 3183
3162 /* #### this function doesn't belong in this file! */ 3184 /* #### this function doesn't belong in this file! */
3163 3185
3228 => ; Non-nil if this Emacs supports TTY frames. 3250 => ; Non-nil if this Emacs supports TTY frames.
3229 3251
3230 (featurep '(or (and xemacs 19.15) (and emacs 19.34))) 3252 (featurep '(or (and xemacs 19.15) (and emacs 19.34)))
3231 => ; Non-nil on XEmacs 19.15 and later, or FSF Emacs 19.34 and later. 3253 => ; Non-nil on XEmacs 19.15 and later, or FSF Emacs 19.34 and later.
3232 3254
3233 (featurep '(and xemacs 21.02))
3234 => ; Non-nil on XEmacs 21.2 and later.
3235
3236 NOTE: The advanced arguments of this function (anything other than a 3255 NOTE: The advanced arguments of this function (anything other than a
3237 symbol) are not yet supported by FSF Emacs. If you feel they are useful 3256 symbol) are not yet supported by FSF Emacs. If you feel they are useful
3238 for supporting multiple Emacs variants, lobby Richard Stallman at 3257 for supporting multiple Emacs variants, lobby Richard Stallman at
3239 <bug-gnu-emacs@gnu.org>. 3258 <bug-gnu-emacs@prep.ai.mit.edu>.
3240 */ 3259 */
3241 (fexp)) 3260 (fexp))
3242 { 3261 {
3243 #ifndef FEATUREP_SYNTAX 3262 #ifndef FEATUREP_SYNTAX
3244 CHECK_SYMBOL (fexp); 3263 CHECK_SYMBOL (fexp);
3361 return unbind_to (speccount, feature); 3380 return unbind_to (speccount, feature);
3362 } 3381 }
3363 } 3382 }
3364 3383
3365 /* base64 encode/decode functions. 3384 /* base64 encode/decode functions.
3366 3385 Based on code from GNU recode. */
3367 Originally based on code from GNU recode. Ported to FSF Emacs by 3386
3368 Lars Magne Ingebrigtsen and Karl Heuer. Ported to XEmacs and 3387 #define MIME_LINE_LENGTH 76
3369 subsequently heavily hacked by Hrvoje Niksic. */
3370
3371 #define MIME_LINE_LENGTH 72
3372 3388
3373 #define IS_ASCII(Character) \ 3389 #define IS_ASCII(Character) \
3374 ((Character) < 128) 3390 ((Character) < 128)
3375 #define IS_BASE64(Character) \ 3391 #define IS_BASE64(Character) \
3376 (IS_ASCII (Character) && base64_char_to_value[Character] >= 0) 3392 (IS_ASCII (Character) && base64_char_to_value[Character] >= 0)
3422 3438
3423 The octets are divided into 6 bit chunks, which are then encoded into 3439 The octets are divided into 6 bit chunks, which are then encoded into
3424 base64 characters. */ 3440 base64 characters. */
3425 3441
3426 #define ADVANCE_INPUT(c, stream) \ 3442 #define ADVANCE_INPUT(c, stream) \
3427 ((ec = Lstream_get_emchar (stream)) == -1 ? 0 : \ 3443 (ec = Lstream_get_emchar (stream), \
3444 ec == -1 ? 0 : \
3428 ((ec > 255) ? \ 3445 ((ec > 255) ? \
3429 (signal_simple_error ("Non-ascii character in base64 input", \ 3446 (error ("Non-ascii character detected in base64 input"), 0) \
3430 make_char (ec)), 0) \ 3447 : (c = (Bufbyte)ec, 1)))
3431 : (c = (Bufbyte)ec), 1))
3432 3448
3433 static Bytind 3449 static Bytind
3434 base64_encode_1 (Lstream *istream, Bufbyte *to, int line_break) 3450 base64_encode_1 (Lstream *istream, Bufbyte *to, int line_break)
3435 { 3451 {
3436 EMACS_INT counter = 0; 3452 EMACS_INT counter = 0;
3486 3502
3487 return e - to; 3503 return e - to;
3488 } 3504 }
3489 #undef ADVANCE_INPUT 3505 #undef ADVANCE_INPUT
3490 3506
3491 /* Get next character from the stream, except that non-base64 3507 #define ADVANCE_INPUT(c, stream) \
3492 characters are ignored. This is in accordance with rfc2045. EC 3508 (ec = Lstream_get_emchar (stream), \
3493 should be an Emchar, so that it can hold -1 as the value for EOF. */ 3509 ec == -1 ? 0 : (c = (Bufbyte)ec, 1))
3494 #define ADVANCE_INPUT_IGNORE_NONBASE64(ec, stream, streampos) do { \ 3510
3495 ec = Lstream_get_emchar (stream); \ 3511 #define STORE_BYTE(pos, val) do { \
3496 ++streampos; \
3497 /* IS_BASE64 may not be called with negative arguments so check for \
3498 EOF first. */ \
3499 if (ec < 0 || IS_BASE64 (ec) || ec == '=') \
3500 break; \
3501 } while (1)
3502
3503 #define STORE_BYTE(pos, val, ccnt) do { \
3504 pos += set_charptr_emchar (pos, (Emchar)((unsigned char)(val))); \ 3512 pos += set_charptr_emchar (pos, (Emchar)((unsigned char)(val))); \
3505 ++ccnt; \ 3513 ++*ccptr; \
3506 } while (0) 3514 } while (0)
3507 3515
3508 static Bytind 3516 static Bytind
3509 base64_decode_1 (Lstream *istream, Bufbyte *to, Charcount *ccptr) 3517 base64_decode_1 (Lstream *istream, Bufbyte *to, Charcount *ccptr)
3510 { 3518 {
3511 Charcount ccnt = 0; 3519 Emchar ec;
3512 Bufbyte *e = to; 3520 Bufbyte *e = to;
3513 EMACS_INT streampos = 0; 3521 unsigned long value;
3514 3522
3523 *ccptr = 0;
3515 while (1) 3524 while (1)
3516 { 3525 {
3517 Emchar ec; 3526 Bufbyte c;
3518 unsigned long value; 3527
3528 if (!ADVANCE_INPUT (c, istream))
3529 break;
3530
3531 /* Accept wrapping lines. */
3532 if (c == '\r')
3533 {
3534 if (!ADVANCE_INPUT (c, istream)
3535 || c != '\n')
3536 return -1;
3537 }
3538 if (c == '\n')
3539 {
3540 if (!ADVANCE_INPUT (c, istream))
3541 break;
3542 /* FSF checks for end of text here, but that's wrong. */
3543 /* FSF checks for correct line length here; that's also
3544 wrong; some MIME encoders use different line lengths. */
3545 }
3519 3546
3520 /* Process first byte of a quadruplet. */ 3547 /* Process first byte of a quadruplet. */
3521 ADVANCE_INPUT_IGNORE_NONBASE64 (ec, istream, streampos); 3548 if (!IS_BASE64 (c))
3522 if (ec < 0) 3549 return -1;
3523 break; 3550 value = base64_char_to_value[c] << 18;
3524 if (ec == '=')
3525 signal_simple_error ("Illegal `=' character while decoding base64",
3526 make_int (streampos));
3527 value = base64_char_to_value[ec] << 18;
3528 3551
3529 /* Process second byte of a quadruplet. */ 3552 /* Process second byte of a quadruplet. */
3530 ADVANCE_INPUT_IGNORE_NONBASE64 (ec, istream, streampos); 3553 if (!ADVANCE_INPUT (c, istream))
3531 if (ec < 0) 3554 return -1;
3532 error ("Premature EOF while decoding base64"); 3555
3533 if (ec == '=') 3556 if (!IS_BASE64 (c))
3534 signal_simple_error ("Illegal `=' character while decoding base64", 3557 return -1;
3535 make_int (streampos)); 3558 value |= base64_char_to_value[c] << 12;
3536 value |= base64_char_to_value[ec] << 12; 3559
3537 STORE_BYTE (e, value >> 16, ccnt); 3560 STORE_BYTE (e, value >> 16);
3538 3561
3539 /* Process third byte of a quadruplet. */ 3562 /* Process third byte of a quadruplet. */
3540 ADVANCE_INPUT_IGNORE_NONBASE64 (ec, istream, streampos); 3563 if (!ADVANCE_INPUT (c, istream))
3541 if (ec < 0) 3564 return -1;
3542 error ("Premature EOF while decoding base64"); 3565
3543 3566 if (c == '=')
3544 if (ec == '=') 3567 {
3545 { 3568 if (!ADVANCE_INPUT (c, istream))
3546 ADVANCE_INPUT_IGNORE_NONBASE64 (ec, istream, streampos); 3569 return -1;
3547 if (ec < 0) 3570 if (c != '=')
3548 error ("Premature EOF while decoding base64"); 3571 return -1;
3549 if (ec != '=')
3550 signal_simple_error ("Padding `=' expected but not found while decoding base64",
3551 make_int (streampos));
3552 continue; 3572 continue;
3553 } 3573 }
3554 3574
3555 value |= base64_char_to_value[ec] << 6; 3575 if (!IS_BASE64 (c))
3556 STORE_BYTE (e, 0xff & value >> 8, ccnt); 3576 return -1;
3577 value |= base64_char_to_value[c] << 6;
3578
3579 STORE_BYTE (e, 0xff & value >> 8);
3557 3580
3558 /* Process fourth byte of a quadruplet. */ 3581 /* Process fourth byte of a quadruplet. */
3559 ADVANCE_INPUT_IGNORE_NONBASE64 (ec, istream, streampos); 3582 if (!ADVANCE_INPUT (c, istream))
3560 if (ec < 0) 3583 return -1;
3561 error ("Premature EOF while decoding base64"); 3584
3562 if (ec == '=') 3585 if (c == '=')
3563 continue; 3586 continue;
3564 3587
3565 value |= base64_char_to_value[ec]; 3588 if (!IS_BASE64 (c))
3566 STORE_BYTE (e, 0xff & value, ccnt); 3589 return -1;
3567 } 3590 value |= base64_char_to_value[c];
3568 3591
3569 *ccptr = ccnt; 3592 STORE_BYTE (e, 0xff & value);
3593 }
3594
3570 return e - to; 3595 return e - to;
3571 } 3596 }
3572 #undef ADVANCE_INPUT 3597 #undef ADVANCE_INPUT
3573 #undef ADVANCE_INPUT_IGNORE_NONBASE64 3598 #undef INPUT_EOF_P
3574 #undef STORE_BYTE
3575 3599
3576 static Lisp_Object 3600 static Lisp_Object
3577 free_malloced_ptr (Lisp_Object unwind_obj) 3601 free_malloced_ptr (Lisp_Object unwind_obj)
3578 { 3602 {
3579 void *ptr = (void *)get_opaque_ptr (unwind_obj); 3603 void *ptr = (void *)get_opaque_ptr (unwind_obj);
3646 and delete the old. (Insert first in order to preserve markers.) */ 3670 and delete the old. (Insert first in order to preserve markers.) */
3647 buffer_insert_raw_string_1 (buf, begv, encoded, encoded_length, 0); 3671 buffer_insert_raw_string_1 (buf, begv, encoded, encoded_length, 0);
3648 XMALLOC_UNBIND (encoded, allength, speccount); 3672 XMALLOC_UNBIND (encoded, allength, speccount);
3649 buffer_delete_range (buf, begv + encoded_length, zv + encoded_length, 0); 3673 buffer_delete_range (buf, begv + encoded_length, zv + encoded_length, 0);
3650 3674
3651 /* Simulate FSF Emacs implementation of this function: if point was 3675 /* Simulate FSF Emacs: if point was in the region, place it at the
3652 in the region, place it at the beginning. */ 3676 beginning. */
3653 if (old_pt >= begv && old_pt < zv) 3677 if (old_pt >= begv && old_pt < zv)
3654 BUF_SET_PT (buf, begv); 3678 BUF_SET_PT (buf, begv);
3655 3679
3656 /* We return the length of the encoded text. */ 3680 /* We return the length of the encoded text. */
3657 return make_int (encoded_length); 3681 return make_int (encoded_length);
3688 3712
3689 DEFUN ("base64-decode-region", Fbase64_decode_region, 2, 2, "r", /* 3713 DEFUN ("base64-decode-region", Fbase64_decode_region, 2, 2, "r", /*
3690 Base64-decode the region between BEG and END. 3714 Base64-decode the region between BEG and END.
3691 Return the length of the decoded text. 3715 Return the length of the decoded text.
3692 If the region can't be decoded, return nil and don't modify the buffer. 3716 If the region can't be decoded, return nil and don't modify the buffer.
3693 Characters out of the base64 alphabet are ignored.
3694 */ 3717 */
3695 (beg, end)) 3718 (beg, end))
3696 { 3719 {
3697 struct buffer *buf = current_buffer; 3720 struct buffer *buf = current_buffer;
3698 Bufpos begv, zv, old_pt = BUF_PT (buf); 3721 Bufpos begv, zv, old_pt = BUF_PT (buf);
3713 decoded_length = base64_decode_1 (XLSTREAM (input), decoded, &cc_decoded_length); 3736 decoded_length = base64_decode_1 (XLSTREAM (input), decoded, &cc_decoded_length);
3714 if (decoded_length > length * MAX_EMCHAR_LEN) 3737 if (decoded_length > length * MAX_EMCHAR_LEN)
3715 abort (); 3738 abort ();
3716 Lstream_delete (XLSTREAM (input)); 3739 Lstream_delete (XLSTREAM (input));
3717 3740
3741 if (decoded_length < 0)
3742 {
3743 /* The decoding wasn't possible. */
3744 XMALLOC_UNBIND (decoded, length * MAX_EMCHAR_LEN, speccount);
3745 return Qnil;
3746 }
3747
3718 /* Now we have decoded the region, so we insert the new contents 3748 /* Now we have decoded the region, so we insert the new contents
3719 and delete the old. (Insert first in order to preserve markers.) */ 3749 and delete the old. (Insert first in order to preserve markers.) */
3720 BUF_SET_PT (buf, begv); 3750 BUF_SET_PT (buf, begv);
3721 buffer_insert_raw_string_1 (buf, begv, decoded, decoded_length, 0); 3751 buffer_insert_raw_string_1 (buf, begv, decoded, decoded_length, 0);
3722 XMALLOC_UNBIND (decoded, length * MAX_EMCHAR_LEN, speccount); 3752 XMALLOC_UNBIND (decoded, length * MAX_EMCHAR_LEN, speccount);
3723 buffer_delete_range (buf, begv + cc_decoded_length, 3753 buffer_delete_range (buf, begv + cc_decoded_length,
3724 zv + cc_decoded_length, 0); 3754 zv + cc_decoded_length, 0);
3725 3755
3726 /* Simulate FSF Emacs implementation of this function: if point was 3756 /* Simulate FSF Emacs: if point was in the region, place it at the
3727 in the region, place it at the beginning. */ 3757 beginning. */
3728 if (old_pt >= begv && old_pt < zv) 3758 if (old_pt >= begv && old_pt < zv)
3729 BUF_SET_PT (buf, begv); 3759 BUF_SET_PT (buf, begv);
3730 3760
3731 return make_int (cc_decoded_length); 3761 return make_int (cc_decoded_length);
3732 } 3762 }
3733 3763
3734 DEFUN ("base64-decode-string", Fbase64_decode_string, 1, 1, 0, /* 3764 DEFUN ("base64-decode-string", Fbase64_decode_string, 1, 1, 0, /*
3735 Base64-decode STRING and return the result. 3765 Base64-decode STRING and return the result.
3736 Characters out of the base64 alphabet are ignored.
3737 */ 3766 */
3738 (string)) 3767 (string))
3739 { 3768 {
3740 Bufbyte *decoded; 3769 Bufbyte *decoded;
3741 Bytind decoded_length; 3770 Bytind decoded_length;
3754 &cc_decoded_length); 3783 &cc_decoded_length);
3755 if (decoded_length > length * MAX_EMCHAR_LEN) 3784 if (decoded_length > length * MAX_EMCHAR_LEN)
3756 abort (); 3785 abort ();
3757 Lstream_delete (XLSTREAM (input)); 3786 Lstream_delete (XLSTREAM (input));
3758 3787
3788 if (decoded_length < 0)
3789 {
3790 /* The decoding wasn't possible. */
3791 XMALLOC_UNBIND (decoded, length * MAX_EMCHAR_LEN, speccount);
3792 return Qnil;
3793 }
3794
3759 result = make_string (decoded, decoded_length); 3795 result = make_string (decoded, decoded_length);
3760 XMALLOC_UNBIND (decoded, length * MAX_EMCHAR_LEN, speccount); 3796 XMALLOC_UNBIND (decoded, length * MAX_EMCHAR_LEN, speccount);
3761 return result; 3797 return result;
3762 } 3798 }
3763 3799
3764 Lisp_Object Qyes_or_no_p; 3800 Lisp_Object Qyes_or_no_p;
3765 3801
3766 void 3802 void
3767 syms_of_fns (void) 3803 syms_of_fns (void)
3768 { 3804 {
3769 INIT_LRECORD_IMPLEMENTATION (bit_vector);
3770
3771 defsymbol (&Qstring_lessp, "string-lessp"); 3805 defsymbol (&Qstring_lessp, "string-lessp");
3772 defsymbol (&Qidentity, "identity"); 3806 defsymbol (&Qidentity, "identity");
3773 defsymbol (&Qyes_or_no_p, "yes-or-no-p"); 3807 defsymbol (&Qyes_or_no_p, "yes-or-no-p");
3774 3808
3775 DEFSUBR (Fidentity); 3809 DEFSUBR (Fidentity);
3843 DEFSUBR (Fold_equal); 3877 DEFSUBR (Fold_equal);
3844 DEFSUBR (Ffillarray); 3878 DEFSUBR (Ffillarray);
3845 DEFSUBR (Fnconc); 3879 DEFSUBR (Fnconc);
3846 DEFSUBR (Fmapcar); 3880 DEFSUBR (Fmapcar);
3847 DEFSUBR (Fmapvector); 3881 DEFSUBR (Fmapvector);
3848 DEFSUBR (Fmapc_internal); 3882 DEFSUBR (Fmapc);
3849 DEFSUBR (Fmapconcat); 3883 DEFSUBR (Fmapconcat);
3850 DEFSUBR (Freplace_list);
3851 DEFSUBR (Fload_average); 3884 DEFSUBR (Fload_average);
3852 DEFSUBR (Ffeaturep); 3885 DEFSUBR (Ffeaturep);
3853 DEFSUBR (Frequire); 3886 DEFSUBR (Frequire);
3854 DEFSUBR (Fprovide); 3887 DEFSUBR (Fprovide);
3855 DEFSUBR (Fbase64_encode_region); 3888 DEFSUBR (Fbase64_encode_region);