diff options
Diffstat (limited to 'src/fns.c')
| -rw-r--r-- | src/fns.c | 74 |
1 files changed, 38 insertions, 36 deletions
| @@ -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 | ||
| 5 | This file is part of GNU Emacs. | 5 | This 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 | |||
| 495 | static int | ||
| 496 | count_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. */ |
| 514 | struct textprop_rec | 492 | struct 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 | ||
| 1008 | DEFUN ("string-make-multibyte", Fstring_make_multibyte, Sstring_make_multibyte, | 995 | DEFUN ("string-make-multibyte", Fstring_make_multibyte, Sstring_make_multibyte, |
| @@ -1475,7 +1462,7 @@ assq_no_quit (key, list) | |||
| 1475 | DEFUN ("assoc", Fassoc, Sassoc, 2, 2, 0, | 1462 | DEFUN ("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. |
| 1477 | The value is actually the first element of LIST whose car equals KEY. */) | 1464 | The 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 | ||
| 2040 | DEFUN ("eql", Feql, Seql, 2, 2, 0, | ||
| 2041 | doc: /* Return t if the two args are the same Lisp object. | ||
| 2042 | Floating-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 | |||
| 2053 | DEFUN ("equal", Fequal, Sequal, 2, 2, 0, | 2052 | DEFUN ("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. |
| 2055 | They must have the same data type. | 2054 | They 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); |