aboutsummaryrefslogtreecommitdiffstats
path: root/src/fns.c
diff options
context:
space:
mode:
Diffstat (limited to 'src/fns.c')
-rw-r--r--src/fns.c74
1 files changed, 38 insertions, 36 deletions
diff --git a/src/fns.c b/src/fns.c
index 017f8124013..5e20687494c 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -1,5 +1,5 @@
1/* Random utility Lisp functions. 1/* Random utility Lisp functions.
2 Copyright (C) 1985, 86, 87, 93, 94, 95, 97, 98, 99, 2000, 2001, 02, 2003 2 Copyright (C) 1985, 86, 87, 93, 94, 95, 97, 98, 99, 2000, 2001, 02, 03, 2004
3 Free Software Foundation, Inc. 3 Free Software Foundation, Inc.
4 4
5This file is part of GNU Emacs. 5This file is part of GNU Emacs.
@@ -473,7 +473,8 @@ with the original. */)
473 { 473 {
474 Lisp_Object val; 474 Lisp_Object val;
475 int size_in_chars 475 int size_in_chars
476 = (XBOOL_VECTOR (arg)->size + BITS_PER_CHAR - 1) / BITS_PER_CHAR; 476 = ((XBOOL_VECTOR (arg)->size + BOOL_VECTOR_BITS_PER_CHAR - 1)
477 / BOOL_VECTOR_BITS_PER_CHAR);
477 478
478 val = Fmake_bool_vector (Flength (arg), Qnil); 479 val = Fmake_bool_vector (Flength (arg), Qnil);
479 bcopy (XBOOL_VECTOR (arg)->data, XBOOL_VECTOR (val)->data, 480 bcopy (XBOOL_VECTOR (arg)->data, XBOOL_VECTOR (val)->data,
@@ -486,29 +487,6 @@ with the original. */)
486 return concat (1, &arg, CONSP (arg) ? Lisp_Cons : XTYPE (arg), 0); 487 return concat (1, &arg, CONSP (arg) ? Lisp_Cons : XTYPE (arg), 0);
487} 488}
488 489
489#if 0 /* unused */
490/* In string STR of length LEN, see if bytes before STR[I] combine
491 with bytes after STR[I] to form a single character. If so, return
492 the number of bytes after STR[I] which combine in this way.
493 Otherwize, return 0. */
494
495static int
496count_combining (str, len, i)
497 unsigned char *str;
498 int len, i;
499{
500 int j = i - 1, bytes;
501
502 if (i == 0 || i == len || CHAR_HEAD_P (str[i]))
503 return 0;
504 while (j >= 0 && !CHAR_HEAD_P (str[j])) j--;
505 if (j < 0 || ! BASE_LEADING_CODE_P (str[j]))
506 return 0;
507 PARSE_MULTIBYTE_SEQ (str + j, len - j, bytes);
508 return (bytes <= i - j ? 0 : bytes - (i - j));
509}
510#endif
511
512/* This structure holds information of an argument of `concat' that is 490/* This structure holds information of an argument of `concat' that is
513 a string and has text properties to be copied. */ 491 a string and has text properties to be copied. */
514struct textprop_rec 492struct textprop_rec
@@ -682,6 +660,7 @@ concat (nargs, args, target_type, last_special)
682 } 660 }
683 toindex_byte += thislen_byte; 661 toindex_byte += thislen_byte;
684 toindex += thisleni; 662 toindex += thisleni;
663 STRING_SET_CHARS (val, SCHARS (val));
685 } 664 }
686 /* Copy a single-byte string to a multibyte string. */ 665 /* Copy a single-byte string to a multibyte string. */
687 else if (STRINGP (this) && STRINGP (val)) 666 else if (STRINGP (this) && STRINGP (val))
@@ -735,8 +714,8 @@ concat (nargs, args, target_type, last_special)
735 else if (BOOL_VECTOR_P (this)) 714 else if (BOOL_VECTOR_P (this))
736 { 715 {
737 int byte; 716 int byte;
738 byte = XBOOL_VECTOR (this)->data[thisindex / BITS_PER_CHAR]; 717 byte = XBOOL_VECTOR (this)->data[thisindex / BOOL_VECTOR_BITS_PER_CHAR];
739 if (byte & (1 << (thisindex % BITS_PER_CHAR))) 718 if (byte & (1 << (thisindex % BOOL_VECTOR_BITS_PER_CHAR)))
740 elt = Qt; 719 elt = Qt;
741 else 720 else
742 elt = Qnil; 721 elt = Qnil;
@@ -993,16 +972,24 @@ string_make_unibyte (string)
993 Lisp_Object string; 972 Lisp_Object string;
994{ 973{
995 unsigned char *buf; 974 unsigned char *buf;
975 Lisp_Object ret;
996 976
997 if (! STRING_MULTIBYTE (string)) 977 if (! STRING_MULTIBYTE (string))
998 return string; 978 return string;
999 979
1000 buf = (unsigned char *) alloca (SCHARS (string)); 980 /* We can not use alloca here, because string might be very long.
981 For example when selecting megabytes of text and then pasting it to
982 another application. */
983 buf = (unsigned char *) xmalloc (SCHARS (string));
1001 984
1002 copy_text (SDATA (string), buf, SBYTES (string), 985 copy_text (SDATA (string), buf, SBYTES (string),
1003 1, 0); 986 1, 0);
1004 987
1005 return make_unibyte_string (buf, SCHARS (string)); 988 ret = make_unibyte_string (buf, SCHARS (string));
989
990 xfree (buf);
991
992 return ret;
1006} 993}
1007 994
1008DEFUN ("string-make-multibyte", Fstring_make_multibyte, Sstring_make_multibyte, 995DEFUN ("string-make-multibyte", Fstring_make_multibyte, Sstring_make_multibyte,
@@ -1475,7 +1462,7 @@ assq_no_quit (key, list)
1475DEFUN ("assoc", Fassoc, Sassoc, 2, 2, 0, 1462DEFUN ("assoc", Fassoc, Sassoc, 2, 2, 0,
1476 doc: /* Return non-nil if KEY is `equal' to the car of an element of LIST. 1463 doc: /* Return non-nil if KEY is `equal' to the car of an element of LIST.
1477The value is actually the first element of LIST whose car equals KEY. */) 1464The value is actually the first element of LIST whose car equals KEY. */)
1478 (key, list) 1465 (key, list)
1479 Lisp_Object key, list; 1466 Lisp_Object key, list;
1480{ 1467{
1481 Lisp_Object result, car; 1468 Lisp_Object result, car;
@@ -2050,6 +2037,18 @@ The PLIST is modified by side effects. */)
2050 return plist; 2037 return plist;
2051} 2038}
2052 2039
2040DEFUN ("eql", Feql, Seql, 2, 2, 0,
2041 doc: /* Return t if the two args are the same Lisp object.
2042Floating-point numbers of equal value are `eql', but they may not be `eq'. */)
2043 (obj1, obj2)
2044 Lisp_Object obj1, obj2;
2045{
2046 if (FLOATP (obj1))
2047 return internal_equal (obj1, obj2, 0, 0) ? Qt : Qnil;
2048 else
2049 return EQ (obj1, obj2) ? Qt : Qnil;
2050}
2051
2053DEFUN ("equal", Fequal, Sequal, 2, 2, 0, 2052DEFUN ("equal", Fequal, Sequal, 2, 2, 0,
2054 doc: /* Return t if two Lisp objects have similar structure and contents. 2053 doc: /* Return t if two Lisp objects have similar structure and contents.
2055They must have the same data type. 2054They must have the same data type.
@@ -2148,7 +2147,8 @@ internal_equal (o1, o2, depth, props)
2148 if (BOOL_VECTOR_P (o1)) 2147 if (BOOL_VECTOR_P (o1))
2149 { 2148 {
2150 int size_in_chars 2149 int size_in_chars
2151 = (XBOOL_VECTOR (o1)->size + BITS_PER_CHAR - 1) / BITS_PER_CHAR; 2150 = ((XBOOL_VECTOR (o1)->size + BOOL_VECTOR_BITS_PER_CHAR - 1)
2151 / BOOL_VECTOR_BITS_PER_CHAR);
2152 2152
2153 if (XBOOL_VECTOR (o1)->size != XBOOL_VECTOR (o2)->size) 2153 if (XBOOL_VECTOR (o1)->size != XBOOL_VECTOR (o2)->size)
2154 return 0; 2154 return 0;
@@ -2260,7 +2260,8 @@ ARRAY is a vector, string, char-table, or bool-vector. */)
2260 { 2260 {
2261 register unsigned char *p = XBOOL_VECTOR (array)->data; 2261 register unsigned char *p = XBOOL_VECTOR (array)->data;
2262 int size_in_chars 2262 int size_in_chars
2263 = (XBOOL_VECTOR (array)->size + BITS_PER_CHAR - 1) / BITS_PER_CHAR; 2263 = ((XBOOL_VECTOR (array)->size + BOOL_VECTOR_BITS_PER_CHAR - 1)
2264 / BOOL_VECTOR_BITS_PER_CHAR);
2264 2265
2265 charval = (! NILP (item) ? -1 : 0); 2266 charval = (! NILP (item) ? -1 : 0);
2266 for (index = 0; index < size_in_chars - 1; index++) 2267 for (index = 0; index < size_in_chars - 1; index++)
@@ -2268,8 +2269,8 @@ ARRAY is a vector, string, char-table, or bool-vector. */)
2268 if (index < size_in_chars) 2269 if (index < size_in_chars)
2269 { 2270 {
2270 /* Mask out bits beyond the vector size. */ 2271 /* Mask out bits beyond the vector size. */
2271 if (XBOOL_VECTOR (array)->size % BITS_PER_CHAR) 2272 if (XBOOL_VECTOR (array)->size % BOOL_VECTOR_BITS_PER_CHAR)
2272 charval &= (1 << (XBOOL_VECTOR (array)->size % BITS_PER_CHAR)) - 1; 2273 charval &= (1 << (XBOOL_VECTOR (array)->size % BOOL_VECTOR_BITS_PER_CHAR)) - 1;
2273 p[index] = charval; 2274 p[index] = charval;
2274 } 2275 }
2275 } 2276 }
@@ -2398,8 +2399,8 @@ mapcar1 (leni, vals, fn, seq)
2398 for (i = 0; i < leni; i++) 2399 for (i = 0; i < leni; i++)
2399 { 2400 {
2400 int byte; 2401 int byte;
2401 byte = XBOOL_VECTOR (seq)->data[i / BITS_PER_CHAR]; 2402 byte = XBOOL_VECTOR (seq)->data[i / BOOL_VECTOR_BITS_PER_CHAR];
2402 if (byte & (1 << (i % BITS_PER_CHAR))) 2403 if (byte & (1 << (i % BOOL_VECTOR_BITS_PER_CHAR)))
2403 dummy = Qt; 2404 dummy = Qt;
2404 else 2405 else
2405 dummy = Qnil; 2406 dummy = Qnil;
@@ -5203,6 +5204,7 @@ used if both `use-dialog-box' and this variable are non-nil. */);
5203 defsubr (&Sput); 5204 defsubr (&Sput);
5204 defsubr (&Slax_plist_get); 5205 defsubr (&Slax_plist_get);
5205 defsubr (&Slax_plist_put); 5206 defsubr (&Slax_plist_put);
5207 defsubr (&Seql);
5206 defsubr (&Sequal); 5208 defsubr (&Sequal);
5207 defsubr (&Sequal_including_properties); 5209 defsubr (&Sequal_including_properties);
5208 defsubr (&Sfillarray); 5210 defsubr (&Sfillarray);