Mercurial > hg > xemacs-beta
comparison src/fns.c @ 801:2b676dc88c66
[xemacs-hg @ 2002-04-01 03:58:02 by ben]
bug fixes (e.g. ballooning on X windows)
Makefile.in.in: Try to make the Makefile notice if its source Makefile.in.in is
changed, and regenerate and run itself.
Use a bigger default SHEAP_ADJUSTMENT on Cygwin; otherwise you
can't compile under Mule if a Lisp file has changed. (can't run
temacs)
TODO.ben-mule-21-5: update.
mule/mule-cmds.el: Hash the result of mswindows-get-language-environment-from-locale,
since it's very expensive (and causes huge ballooning of memory
under X Windows, since it's called from x-get-resource).
cl-extra.el, code-files.el, files.el, simple.el, subr.el, x-faces.el: Create new string-equal-ignore-case, based on built-in
compare-strings -- compare strings ignoring case without the need
to generate garbage by calling downcase. Use it in equalp and
elsewhere.
alloc.c, bytecode.c, chartab.c, data.c, elhash.c, emacs.c, eval.c, event-Xt.c, event-unixoid.c, extents.c, file-coding.c, fileio.c, fns.c, glyphs.c, gutter.c, lisp-union.h, lisp.h, mule-charset.c, nt.c, process-unix.c, process.c, specifier.c, symbols.c, sysdep.c, sysdep.h, text.c, toolbar.c: Try to implement GC triggering based on percentage of total memory
usage. Not currently activated (percentage set to 0) because not
quite working. Add `memory-usage' primitive to return XEmacs'
idea of its memory usage.
Add primitive compare-strings, compatible with FSF 21.1 -- can
compare any part of two strings, optionally ignoring case.
Improve qxe() functions in text.c for text comparison.
Use RETURN_NOT_REACHED to try to avoid warnings about unreachable
code.
Add volatile_make_int() to fix warning in unix_send_process().
author | ben |
---|---|
date | Mon, 01 Apr 2002 03:59:04 +0000 |
parents | e38acbeb1cae |
children | a634e3b7acc8 |
comparison
equal
deleted
inserted
replaced
800:a5954632b187 | 801:2b676dc88c66 |
---|---|
296 p2 = string2; | 296 p2 = string2; |
297 } | 297 } |
298 | 298 |
299 return (((len = XSTRING_LENGTH (p1)) == XSTRING_LENGTH (p2)) && | 299 return (((len = XSTRING_LENGTH (p1)) == XSTRING_LENGTH (p2)) && |
300 !memcmp (XSTRING_DATA (p1), XSTRING_DATA (p2), len)) ? Qt : Qnil; | 300 !memcmp (XSTRING_DATA (p1), XSTRING_DATA (p2), len)) ? Qt : Qnil; |
301 } | |
302 | |
303 DEFUN ("compare-strings", Fcompare_strings, 6, 7, 0, /* | |
304 Compare the contents of two strings, maybe ignoring case. | |
305 In string STR1, skip the first START1 characters and stop at END1. | |
306 In string STR2, skip the first START2 characters and stop at END2. | |
307 END1 and END2 default to the full lengths of the respective strings. | |
308 | |
309 Case is significant in this comparison if IGNORE-CASE is nil. | |
310 | |
311 The value is t if the strings (or specified portions) match. | |
312 If string STR1 is less, the value is a negative number N; | |
313 - 1 - N is the number of characters that match at the beginning. | |
314 If string STR1 is greater, the value is a positive number N; | |
315 N - 1 is the number of characters that match at the beginning. | |
316 */ | |
317 (str1, start1, end1, str2, start2, end2, ignore_case)) | |
318 { | |
319 Charcount ccstart1, ccend1, ccstart2, ccend2; | |
320 Bytecount bstart1, blen1, bstart2, blen2; | |
321 Charcount matching; | |
322 int res; | |
323 | |
324 CHECK_STRING (str1); | |
325 CHECK_STRING (str2); | |
326 get_string_range_char (str1, start1, end1, &ccstart1, &ccend1, | |
327 GB_HISTORICAL_STRING_BEHAVIOR); | |
328 get_string_range_char (str2, start2, end2, &ccstart2, &ccend2, | |
329 GB_HISTORICAL_STRING_BEHAVIOR); | |
330 | |
331 bstart1 = string_index_char_to_byte (str1, ccstart1); | |
332 blen1 = string_offset_char_to_byte_len (str1, bstart1, ccend1 - ccstart1); | |
333 bstart2 = string_index_char_to_byte (str2, ccstart2); | |
334 blen2 = string_offset_char_to_byte_len (str2, bstart2, ccend2 - ccstart2); | |
335 | |
336 res = ((NILP (ignore_case) ? qxetextcmp_matching : qxetextcasecmp_matching) | |
337 (XSTRING_DATA (str1) + bstart1, blen1, | |
338 XSTRING_DATA (str2) + bstart2, blen2, | |
339 &matching)); | |
340 | |
341 if (!res) | |
342 return Qt; | |
343 else if (res > 0) | |
344 return make_int (1 + matching); | |
345 else | |
346 return make_int (-1 - matching); | |
301 } | 347 } |
302 | 348 |
303 DEFUN ("string-lessp", Fstring_lessp, 2, 2, 0, /* | 349 DEFUN ("string-lessp", Fstring_lessp, 2, 2, 0, /* |
304 Return t if first arg string is less than second in lexicographic order. | 350 Return t if first arg string is less than second in lexicographic order. |
305 Comparison is simply done on a character-by-character basis using the | 351 Comparison is simply done on a character-by-character basis using the |
2741 } | 2787 } |
2742 | 2788 |
2743 return 0; | 2789 return 0; |
2744 } | 2790 } |
2745 | 2791 |
2792 int | |
2793 internal_equalp (Lisp_Object obj1, Lisp_Object obj2, int depth) | |
2794 { | |
2795 if (depth > 200) | |
2796 stack_overflow ("Stack overflow in equalp", Qunbound); | |
2797 QUIT; | |
2798 if (EQ_WITH_EBOLA_NOTICE (obj1, obj2)) | |
2799 return 1; | |
2800 if ((INTP (obj1) && FLOATP (obj2)) || (FLOATP (obj1) && INTP (obj2))) | |
2801 return extract_float (obj1) == extract_float (obj2); | |
2802 if (CHARP (obj1) && CHARP (obj2)) | |
2803 return DOWNCASE (0, XCHAR (obj1)) == DOWNCASE (0, XCHAR (obj2)); | |
2804 if (XTYPE (obj1) != XTYPE (obj2)) | |
2805 return 0; | |
2806 if (LRECORDP (obj1)) | |
2807 { | |
2808 const struct lrecord_implementation | |
2809 *imp1 = XRECORD_LHEADER_IMPLEMENTATION (obj1), | |
2810 *imp2 = XRECORD_LHEADER_IMPLEMENTATION (obj2); | |
2811 | |
2812 /* #### not yet implemented properly, needs another flag to specify | |
2813 equalp-ness */ | |
2814 return (imp1 == imp2) && | |
2815 /* EQ-ness of the objects was noticed above */ | |
2816 (imp1->equal && (imp1->equal) (obj1, obj2, depth)); | |
2817 } | |
2818 | |
2819 return 0; | |
2820 } | |
2821 | |
2746 /* Note that we may be calling sub-objects that will use | 2822 /* Note that we may be calling sub-objects that will use |
2747 internal_equal() (instead of internal_old_equal()). Oh well. | 2823 internal_equal() (instead of internal_old_equal()). Oh well. |
2748 We will get an Ebola note if there's any possibility of confusion, | 2824 We will get an Ebola note if there's any possibility of confusion, |
2749 but that seems unlikely. */ | 2825 but that seems unlikely. */ |
2750 | 2826 |
3886 DEFSUBR (Fidentity); | 3962 DEFSUBR (Fidentity); |
3887 DEFSUBR (Frandom); | 3963 DEFSUBR (Frandom); |
3888 DEFSUBR (Flength); | 3964 DEFSUBR (Flength); |
3889 DEFSUBR (Fsafe_length); | 3965 DEFSUBR (Fsafe_length); |
3890 DEFSUBR (Fstring_equal); | 3966 DEFSUBR (Fstring_equal); |
3967 DEFSUBR (Fcompare_strings); | |
3891 DEFSUBR (Fstring_lessp); | 3968 DEFSUBR (Fstring_lessp); |
3892 DEFSUBR (Fstring_modified_tick); | 3969 DEFSUBR (Fstring_modified_tick); |
3893 DEFSUBR (Fappend); | 3970 DEFSUBR (Fappend); |
3894 DEFSUBR (Fconcat); | 3971 DEFSUBR (Fconcat); |
3895 DEFSUBR (Fvconcat); | 3972 DEFSUBR (Fvconcat); |