comparison src/fns.c @ 21671:c359a549f2d2

(Fcompare_strings): New function. (syms_of_fns): defsubr it.
author Richard M. Stallman <rms@gnu.org>
date Mon, 20 Apr 1998 03:52:46 +0000
parents 061d5d4f7967
children 8a32bf93da04
comparison
equal deleted inserted replaced
21670:808ecc2eaa84 21671:c359a549f2d2
213 213
214 if (XSTRING (s1)->size != XSTRING (s2)->size 214 if (XSTRING (s1)->size != XSTRING (s2)->size
215 || STRING_BYTES (XSTRING (s1)) != STRING_BYTES (XSTRING (s2)) 215 || STRING_BYTES (XSTRING (s1)) != STRING_BYTES (XSTRING (s2))
216 || bcmp (XSTRING (s1)->data, XSTRING (s2)->data, STRING_BYTES (XSTRING (s1)))) 216 || bcmp (XSTRING (s1)->data, XSTRING (s2)->data, STRING_BYTES (XSTRING (s1))))
217 return Qnil; 217 return Qnil;
218 return Qt;
219 }
220
221 DEFUN ("compare-strings", Fcompare_strings,
222 Scompare_strings, 2, 7, 0,
223 "Compare the contents of two strings, converting to multibyte if needed.\n\
224 In string STR1, skip the first START1 characters and stop at END1.\n\
225 In string STR2, skip the first START2 characters and stop at END2.\n\
226 Case is significant in this comparison if IGNORE-CASE is nil.\n\
227 Unibyte strings are converted to multibyte for comparison.\n\
228 \n\
229 The value is t if the strings (or specified portions) match.\n\
230 If string STR1 is less, the value is a negative number N;\n\
231 - 1 - N is the number of characters that match at the beginning.\n\
232 If string STR1 is greater, the value is a positive number N;\n\
233 N - 1 is the number of characters that match at the beginning.")
234 (str1, start1, end1, str2, start2, end2, ignore_case)
235 Lisp_Object str1, start1, end1, start2, str2, end2, ignore_case;
236 {
237 register int end1_char, end2_char;
238 register int i1, i1_byte, i2, i2_byte;
239
240 CHECK_STRING (str1, 0);
241 CHECK_STRING (str2, 1);
242 if (NILP (start1))
243 start1 = make_number (0);
244 if (NILP (start2))
245 start2 = make_number (0);
246 CHECK_NATNUM (start1, 2);
247 CHECK_NATNUM (start2, 3);
248 if (! NILP (end1))
249 CHECK_NATNUM (end1, 4);
250 if (! NILP (end2))
251 CHECK_NATNUM (end2, 4);
252
253 i1 = XINT (start1);
254 i2 = XINT (start2);
255
256 i1_byte = string_char_to_byte (str1, i1);
257 i2_byte = string_char_to_byte (str2, i2);
258
259 end1_char = XSTRING (str1)->size;
260 if (! NILP (end1) && end1_char > XINT (end1))
261 end1_char = XINT (end1);
262
263 end2_char = XSTRING (str2)->size;
264 if (! NILP (end2) && end2_char > XINT (end2))
265 end2_char = XINT (end2);
266
267 while (i1 < end1_char && i2 < end2_char)
268 {
269 /* When we find a mismatch, we must compare the
270 characters, not just the bytes. */
271 int c1, c2;
272
273 if (STRING_MULTIBYTE (str1))
274 FETCH_STRING_CHAR_ADVANCE (c1, str1, i1, i1_byte);
275 else
276 {
277 c1 = XSTRING (str1)->data[i1++];
278 c1 = unibyte_char_to_multibyte (c1);
279 }
280
281 if (STRING_MULTIBYTE (str2))
282 FETCH_STRING_CHAR_ADVANCE (c2, str2, i2, i2_byte);
283 else
284 {
285 c2 = XSTRING (str2)->data[i2++];
286 c2 = unibyte_char_to_multibyte (c2);
287 }
288
289 if (c1 == c2)
290 continue;
291
292 if (! NILP (ignore_case))
293 {
294 Lisp_Object tem;
295
296 tem = Fupcase (make_number (c1));
297 c1 = XINT (tem);
298 tem = Fupcase (make_number (c2));
299 c2 = XINT (tem);
300 }
301
302 if (c1 == c2)
303 continue;
304
305 /* Note that I1 has already been incremented
306 past the character that we are comparing;
307 hence we don't add or subtract 1 here. */
308 if (c1 < c2)
309 return make_number (- i1);
310 else
311 return make_number (i1);
312 }
313
314 if (i1 < end1_char)
315 return make_number (i1 - XINT (start1) + 1);
316 if (i2 < end2_char)
317 return make_number (- i1 + XINT (start1) - 1);
318
218 return Qt; 319 return Qt;
219 } 320 }
220 321
221 DEFUN ("string-lessp", Fstring_lessp, Sstring_lessp, 2, 2, 0, 322 DEFUN ("string-lessp", Fstring_lessp, Sstring_lessp, 2, 2, 0,
222 "Return t if first arg string is less than second in lexicographic order.\n\ 323 "Return t if first arg string is less than second in lexicographic order.\n\
2598 defsubr (&Srandom); 2699 defsubr (&Srandom);
2599 defsubr (&Slength); 2700 defsubr (&Slength);
2600 defsubr (&Ssafe_length); 2701 defsubr (&Ssafe_length);
2601 defsubr (&Sstring_bytes); 2702 defsubr (&Sstring_bytes);
2602 defsubr (&Sstring_equal); 2703 defsubr (&Sstring_equal);
2704 defsubr (&Scompare_strings);
2603 defsubr (&Sstring_lessp); 2705 defsubr (&Sstring_lessp);
2604 defsubr (&Sappend); 2706 defsubr (&Sappend);
2605 defsubr (&Sconcat); 2707 defsubr (&Sconcat);
2606 defsubr (&Svconcat); 2708 defsubr (&Svconcat);
2607 defsubr (&Scopy_sequence); 2709 defsubr (&Scopy_sequence);