1 /* Random utility Lisp functions.
2 Copyright (C) 1985, 86, 87, 93, 94, 95, 97, 1998 Free Software Foundation, Inc.
4 This file is part of GNU Emacs.
6 GNU Emacs is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 2, or (at your option)
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs; see the file COPYING. If not, write to
18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
19 Boston, MA 02111-1307, USA. */
24 /* Note on some machines this defines `vector' as a typedef,
25 so make sure we don't use that name in this file. */
35 #include "intervals.h"
40 #define NULL (void *)0
43 #define DEFAULT_NONASCII_INSERT_OFFSET 0x800
45 /* Nonzero enables use of dialog boxes for questions
46 asked by mouse commands. */
49 extern Lisp_Object
Flookup_key ();
51 extern int minibuffer_auto_raise
;
52 extern Lisp_Object minibuf_window
;
54 Lisp_Object Qstring_lessp
, Qprovide
, Qrequire
;
55 Lisp_Object Qyes_or_no_p_history
;
56 Lisp_Object Qcursor_in_echo_area
;
57 Lisp_Object Qwidget_type
;
59 static int internal_equal ();
61 DEFUN ("identity", Fidentity
, Sidentity
, 1, 1, 0,
62 "Return the argument unchanged.")
69 extern long get_random ();
70 extern void seed_random ();
73 DEFUN ("random", Frandom
, Srandom
, 0, 1, 0,
74 "Return a pseudo-random number.\n\
75 All integers representable in Lisp are equally likely.\n\
76 On most systems, this is 28 bits' worth.\n\
77 With positive integer argument N, return random number in interval [0,N).\n\
78 With argument t, set the random number seed from the current time and pid.")
83 Lisp_Object lispy_val
;
84 unsigned long denominator
;
87 seed_random (getpid () + time (NULL
));
88 if (NATNUMP (n
) && XFASTINT (n
) != 0)
90 /* Try to take our random number from the higher bits of VAL,
91 not the lower, since (says Gentzel) the low bits of `random'
92 are less random than the higher ones. We do this by using the
93 quotient rather than the remainder. At the high end of the RNG
94 it's possible to get a quotient larger than n; discarding
95 these values eliminates the bias that would otherwise appear
96 when using a large n. */
97 denominator
= ((unsigned long)1 << VALBITS
) / XFASTINT (n
);
99 val
= get_random () / denominator
;
100 while (val
>= XFASTINT (n
));
104 XSETINT (lispy_val
, val
);
108 /* Random data-structure functions */
110 DEFUN ("length", Flength
, Slength
, 1, 1, 0,
111 "Return the length of vector, list or string SEQUENCE.\n\
112 A byte-code function object is also allowed.\n\
113 If the string contains multibyte characters, this is not the necessarily\n\
114 the number of characters in the string; it is the number of bytes.\n\
115 To get the number of characters, use `chars-in-string'")
117 register Lisp_Object sequence
;
119 register Lisp_Object tail
, val
;
123 if (STRINGP (sequence
))
124 XSETFASTINT (val
, XSTRING (sequence
)->size
);
125 else if (VECTORP (sequence
))
126 XSETFASTINT (val
, XVECTOR (sequence
)->size
);
127 else if (CHAR_TABLE_P (sequence
))
128 XSETFASTINT (val
, CHAR_TABLE_ORDINARY_SLOTS
);
129 else if (BOOL_VECTOR_P (sequence
))
130 XSETFASTINT (val
, XBOOL_VECTOR (sequence
)->size
);
131 else if (COMPILEDP (sequence
))
132 XSETFASTINT (val
, XVECTOR (sequence
)->size
& PSEUDOVECTOR_SIZE_MASK
);
133 else if (CONSP (sequence
))
135 for (i
= 0, tail
= sequence
; !NILP (tail
); i
++)
141 XSETFASTINT (val
, i
);
143 else if (NILP (sequence
))
144 XSETFASTINT (val
, 0);
147 sequence
= wrong_type_argument (Qsequencep
, sequence
);
153 /* This does not check for quits. That is safe
154 since it must terminate. */
156 DEFUN ("safe-length", Fsafe_length
, Ssafe_length
, 1, 1, 0,
157 "Return the length of a list, but avoid error or infinite loop.\n\
158 This function never gets an error. If LIST is not really a list,\n\
159 it returns 0. If LIST is circular, it returns a finite value\n\
160 which is at least the number of distinct elements.")
164 Lisp_Object tail
, halftail
, length
;
167 /* halftail is used to detect circular lists. */
169 for (tail
= list
; CONSP (tail
); tail
= XCONS (tail
)->cdr
)
171 if (EQ (tail
, halftail
) && len
!= 0)
175 halftail
= XCONS (halftail
)->cdr
;
178 XSETINT (length
, len
);
182 DEFUN ("string-equal", Fstring_equal
, Sstring_equal
, 2, 2, 0,
183 "Return t if two strings have identical contents.\n\
184 Case is significant, but text properties are ignored.\n\
185 Symbols are also allowed; their print names are used instead.")
187 register Lisp_Object s1
, s2
;
190 XSETSTRING (s1
, XSYMBOL (s1
)->name
);
192 XSETSTRING (s2
, XSYMBOL (s2
)->name
);
193 CHECK_STRING (s1
, 0);
194 CHECK_STRING (s2
, 1);
196 if (XSTRING (s1
)->size
!= XSTRING (s2
)->size
197 || XSTRING (s1
)->size_byte
!= XSTRING (s2
)->size_byte
198 || bcmp (XSTRING (s1
)->data
, XSTRING (s2
)->data
, XSTRING (s1
)->size_byte
))
203 DEFUN ("string-lessp", Fstring_lessp
, Sstring_lessp
, 2, 2, 0,
204 "Return t if first arg string is less than second in lexicographic order.\n\
205 Case is significant.\n\
206 Symbols are also allowed; their print names are used instead.")
208 register Lisp_Object s1
, s2
;
211 register int i1
, i1_byte
, i2
, i2_byte
;
214 XSETSTRING (s1
, XSYMBOL (s1
)->name
);
216 XSETSTRING (s2
, XSYMBOL (s2
)->name
);
217 CHECK_STRING (s1
, 0);
218 CHECK_STRING (s2
, 1);
220 i1
= i1_byte
= i2
= i2_byte
= 0;
222 end
= XSTRING (s1
)->size
;
223 if (end
> XSTRING (s2
)->size
)
224 end
= XSTRING (s2
)->size
;
228 /* When we find a mismatch, we must compare the
229 characters, not just the bytes. */
232 if (STRING_MULTIBYTE (s1
))
233 FETCH_STRING_CHAR_ADVANCE (c1
, s1
, i1
, i1_byte
);
235 c1
= XSTRING (s1
)->data
[i1
++];
237 if (STRING_MULTIBYTE (s2
))
238 FETCH_STRING_CHAR_ADVANCE (c2
, s2
, i2
, i2_byte
);
240 c2
= XSTRING (s2
)->data
[i2
++];
243 return c1
< c2
? Qt
: Qnil
;
245 return i1
< XSTRING (s2
)->size
? Qt
: Qnil
;
248 static Lisp_Object
concat ();
259 return concat (2, args
, Lisp_String
, 0);
261 return concat (2, &s1
, Lisp_String
, 0);
262 #endif /* NO_ARG_ARRAY */
268 Lisp_Object s1
, s2
, s3
;
275 return concat (3, args
, Lisp_String
, 0);
277 return concat (3, &s1
, Lisp_String
, 0);
278 #endif /* NO_ARG_ARRAY */
281 DEFUN ("append", Fappend
, Sappend
, 0, MANY
, 0,
282 "Concatenate all the arguments and make the result a list.\n\
283 The result is a list whose elements are the elements of all the arguments.\n\
284 Each argument may be a list, vector or string.\n\
285 The last argument is not copied, just used as the tail of the new list.")
290 return concat (nargs
, args
, Lisp_Cons
, 1);
293 DEFUN ("concat", Fconcat
, Sconcat
, 0, MANY
, 0,
294 "Concatenate all the arguments and make the result a string.\n\
295 The result is a string whose elements are the elements of all the arguments.\n\
296 Each argument may be a string or a list or vector of characters (integers).\n\
298 Do not use individual integers as arguments!\n\
299 The behavior of `concat' in that case will be changed later!\n\
300 If your program passes an integer as an argument to `concat',\n\
301 you should change it right away not to do so.")
306 return concat (nargs
, args
, Lisp_String
, 0);
309 DEFUN ("vconcat", Fvconcat
, Svconcat
, 0, MANY
, 0,
310 "Concatenate all the arguments and make the result a vector.\n\
311 The result is a vector whose elements are the elements of all the arguments.\n\
312 Each argument may be a list, vector or string.")
317 return concat (nargs
, args
, Lisp_Vectorlike
, 0);
320 /* Retrun a copy of a sub char table ARG. The elements except for a
321 nested sub char table are not copied. */
323 copy_sub_char_table (arg
)
326 Lisp_Object copy
= make_sub_char_table (XCHAR_TABLE (arg
)->defalt
);
329 /* Copy all the contents. */
330 bcopy (XCHAR_TABLE (arg
)->contents
, XCHAR_TABLE (copy
)->contents
,
331 SUB_CHAR_TABLE_ORDINARY_SLOTS
* sizeof (Lisp_Object
));
332 /* Recursively copy any sub char-tables in the ordinary slots. */
333 for (i
= 32; i
< SUB_CHAR_TABLE_ORDINARY_SLOTS
; i
++)
334 if (SUB_CHAR_TABLE_P (XCHAR_TABLE (arg
)->contents
[i
]))
335 XCHAR_TABLE (copy
)->contents
[i
]
336 = copy_sub_char_table (XCHAR_TABLE (copy
)->contents
[i
]);
342 DEFUN ("copy-sequence", Fcopy_sequence
, Scopy_sequence
, 1, 1, 0,
343 "Return a copy of a list, vector or string.\n\
344 The elements of a list or vector are not copied; they are shared\n\
349 if (NILP (arg
)) return arg
;
351 if (CHAR_TABLE_P (arg
))
356 copy
= Fmake_char_table (XCHAR_TABLE (arg
)->purpose
, Qnil
);
357 /* Copy all the slots, including the extra ones. */
358 bcopy (XVECTOR (arg
)->contents
, XVECTOR (copy
)->contents
,
359 ((XCHAR_TABLE (arg
)->size
& PSEUDOVECTOR_SIZE_MASK
)
360 * sizeof (Lisp_Object
)));
362 /* Recursively copy any sub char tables in the ordinary slots
363 for multibyte characters. */
364 for (i
= CHAR_TABLE_SINGLE_BYTE_SLOTS
;
365 i
< CHAR_TABLE_ORDINARY_SLOTS
; i
++)
366 if (SUB_CHAR_TABLE_P (XCHAR_TABLE (arg
)->contents
[i
]))
367 XCHAR_TABLE (copy
)->contents
[i
]
368 = copy_sub_char_table (XCHAR_TABLE (copy
)->contents
[i
]);
373 if (BOOL_VECTOR_P (arg
))
377 = (XBOOL_VECTOR (arg
)->size
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
;
379 val
= Fmake_bool_vector (Flength (arg
), Qnil
);
380 bcopy (XBOOL_VECTOR (arg
)->data
, XBOOL_VECTOR (val
)->data
,
385 if (!CONSP (arg
) && !VECTORP (arg
) && !STRINGP (arg
))
386 arg
= wrong_type_argument (Qsequencep
, arg
);
387 return concat (1, &arg
, CONSP (arg
) ? Lisp_Cons
: XTYPE (arg
), 0);
391 concat (nargs
, args
, target_type
, last_special
)
394 enum Lisp_Type target_type
;
398 register Lisp_Object tail
;
399 register Lisp_Object
this;
402 register int result_len
;
403 register int result_len_byte
;
405 Lisp_Object last_tail
;
409 /* In append, the last arg isn't treated like the others */
410 if (last_special
&& nargs
> 0)
413 last_tail
= args
[nargs
];
418 /* Canonicalize each argument. */
419 for (argnum
= 0; argnum
< nargs
; argnum
++)
422 if (!(CONSP (this) || NILP (this) || VECTORP (this) || STRINGP (this)
423 || COMPILEDP (this) || BOOL_VECTOR_P (this)))
426 args
[argnum
] = Fnumber_to_string (this);
428 args
[argnum
] = wrong_type_argument (Qsequencep
, this);
432 /* Compute total length in chars of arguments in RESULT_LEN.
433 If desired output is a string, also compute length in bytes
434 in RESULT_LEN_BYTE, and determine in SOME_MULTIBYTE
435 whether the result should be a multibyte string. */
439 for (argnum
= 0; argnum
< nargs
; argnum
++)
443 len
= XFASTINT (Flength (this));
444 if (target_type
== Lisp_String
)
446 /* We must count the number of bytes needed in the string
447 as well as the number of characters. */
453 for (i
= 0; i
< len
; i
++)
455 ch
= XVECTOR (this)->contents
[i
];
457 wrong_type_argument (Qintegerp
, ch
);
458 this_len_byte
= XFASTINT (Fchar_bytes (ch
));
459 result_len_byte
+= this_len_byte
;
460 if (this_len_byte
> 1)
463 else if (BOOL_VECTOR_P (this) && XBOOL_VECTOR (this)->size
> 0)
464 wrong_type_argument (Qintegerp
, Faref (this, make_number (0)));
465 else if (CONSP (this))
466 for (; CONSP (this); this = XCONS (this)->cdr
)
468 ch
= XCONS (this)->car
;
470 wrong_type_argument (Qintegerp
, ch
);
471 this_len_byte
= XFASTINT (Fchar_bytes (ch
));
472 result_len_byte
+= this_len_byte
;
473 if (this_len_byte
> 1)
476 else if (STRINGP (this))
478 if (STRING_MULTIBYTE (this))
481 result_len_byte
+= XSTRING (this)->size_byte
;
484 result_len_byte
+= count_size_as_multibyte (XSTRING (this)->data
,
485 XSTRING (this)->size
);
492 if (! some_multibyte
)
493 result_len_byte
= result_len
;
495 /* Create the output object. */
496 if (target_type
== Lisp_Cons
)
497 val
= Fmake_list (make_number (result_len
), Qnil
);
498 else if (target_type
== Lisp_Vectorlike
)
499 val
= Fmake_vector (make_number (result_len
), Qnil
);
501 val
= make_uninit_multibyte_string (result_len
, result_len_byte
);
503 /* In `append', if all but last arg are nil, return last arg. */
504 if (target_type
== Lisp_Cons
&& EQ (val
, Qnil
))
507 /* Copy the contents of the args into the result. */
509 tail
= val
, toindex
= -1; /* -1 in toindex is flag we are making a list */
511 toindex
= 0, toindex_byte
= 0;
515 for (argnum
= 0; argnum
< nargs
; argnum
++)
519 register unsigned int thisindex
= 0;
520 register unsigned int thisindex_byte
= 0;
524 thislen
= Flength (this), thisleni
= XINT (thislen
);
526 if (STRINGP (this) && STRINGP (val
)
527 && ! NULL_INTERVAL_P (XSTRING (this)->intervals
))
528 copy_text_properties (make_number (0), thislen
, this,
529 make_number (toindex
), val
, Qnil
);
531 /* Between strings of the same kind, copy fast. */
532 if (STRINGP (this) && STRINGP (val
)
533 && STRING_MULTIBYTE (this) == some_multibyte
)
535 int thislen_byte
= XSTRING (this)->size_byte
;
536 bcopy (XSTRING (this)->data
, XSTRING (val
)->data
+ toindex_byte
,
537 XSTRING (this)->size_byte
);
538 toindex_byte
+= thislen_byte
;
541 /* Copy a single-byte string to a multibyte string. */
542 else if (STRINGP (this) && STRINGP (val
))
544 toindex_byte
+= copy_text (XSTRING (this)->data
,
545 XSTRING (val
)->data
+ toindex_byte
,
546 XSTRING (this)->size
, 0, 1);
550 /* Copy element by element. */
553 register Lisp_Object elt
;
555 /* Fetch next element of `this' arg into `elt', or break if
556 `this' is exhausted. */
557 if (NILP (this)) break;
559 elt
= XCONS (this)->car
, this = XCONS (this)->cdr
;
560 else if (thisindex
>= thisleni
)
562 else if (STRINGP (this))
564 if (STRING_MULTIBYTE (this))
567 FETCH_STRING_CHAR_ADVANCE (c
, this,
570 XSETFASTINT (elt
, c
);
575 XSETFASTINT (elt
, XSTRING (this)->data
[thisindex
++]);
576 if (some_multibyte
&& XINT (elt
) >= 0200
577 && XINT (elt
) < 0400)
580 if (nonascii_insert_offset
> 0)
581 c
+= nonascii_insert_offset
;
583 c
+= DEFAULT_NONASCII_INSERT_OFFSET
;
589 else if (BOOL_VECTOR_P (this))
592 byte
= XBOOL_VECTOR (this)->data
[thisindex
/ BITS_PER_CHAR
];
593 if (byte
& (1 << (thisindex
% BITS_PER_CHAR
)))
600 elt
= XVECTOR (this)->contents
[thisindex
++];
602 /* Store this element into the result. */
605 XCONS (tail
)->car
= elt
;
607 tail
= XCONS (tail
)->cdr
;
609 else if (VECTORP (val
))
610 XVECTOR (val
)->contents
[toindex
++] = elt
;
613 CHECK_NUMBER (elt
, 0);
614 if (SINGLE_BYTE_CHAR_P (XINT (elt
)))
616 XSTRING (val
)->data
[toindex
++] = XINT (elt
);
620 /* If we have any multibyte characters,
621 we already decided to make a multibyte string. */
624 unsigned char work
[4], *str
;
625 int i
= CHAR_STRING (c
, work
, str
);
627 /* P exists as a variable
628 to avoid a bug on the Masscomp C compiler. */
629 unsigned char *p
= & XSTRING (val
)->data
[toindex_byte
];
638 XCONS (prev
)->cdr
= last_tail
;
643 static Lisp_Object string_char_byte_cache_string
;
644 static int string_char_byte_cache_charpos
;
645 static int string_char_byte_cache_bytepos
;
647 /* Return the character index corresponding to CHAR_INDEX in STRING. */
650 string_char_to_byte (string
, char_index
)
655 int best_below
, best_below_byte
;
656 int best_above
, best_above_byte
;
658 if (! STRING_MULTIBYTE (string
))
661 best_below
= best_below_byte
= 0;
662 best_above
= XSTRING (string
)->size
;
663 best_above_byte
= XSTRING (string
)->size_byte
;
665 if (EQ (string
, string_char_byte_cache_string
))
667 if (string_char_byte_cache_charpos
< char_index
)
669 best_below
= string_char_byte_cache_charpos
;
670 best_below_byte
= string_char_byte_cache_bytepos
;
674 best_above
= string_char_byte_cache_charpos
;
675 best_above_byte
= string_char_byte_cache_bytepos
;
679 if (char_index
- best_below
< best_above
- char_index
)
681 while (best_below
< char_index
)
684 FETCH_STRING_CHAR_ADVANCE (c
, string
, best_below
, best_below_byte
);
687 i_byte
= best_below_byte
;
691 while (best_above
> char_index
)
693 int best_above_byte_saved
= --best_above_byte
;
695 while (best_above_byte
> 0
696 && !CHAR_HEAD_P (XSTRING (string
)->data
[best_above_byte
]))
698 if (XSTRING (string
)->data
[best_above_byte
] < 0x80)
699 best_above_byte
= best_above_byte_saved
;
703 i_byte
= best_above_byte
;
706 string_char_byte_cache_bytepos
= i_byte
;
707 string_char_byte_cache_charpos
= i
;
708 string_char_byte_cache_string
= string
;
713 /* Return the character index corresponding to BYTE_INDEX in STRING. */
716 string_byte_to_char (string
, byte_index
)
721 int best_below
, best_below_byte
;
722 int best_above
, best_above_byte
;
724 if (! STRING_MULTIBYTE (string
))
727 best_below
= best_below_byte
= 0;
728 best_above
= XSTRING (string
)->size
;
729 best_above_byte
= XSTRING (string
)->size_byte
;
731 if (EQ (string
, string_char_byte_cache_string
))
733 if (string_char_byte_cache_bytepos
< byte_index
)
735 best_below
= string_char_byte_cache_charpos
;
736 best_below_byte
= string_char_byte_cache_bytepos
;
740 best_above
= string_char_byte_cache_charpos
;
741 best_above_byte
= string_char_byte_cache_bytepos
;
745 if (byte_index
- best_below_byte
< best_above_byte
- byte_index
)
747 while (best_below_byte
< byte_index
)
750 FETCH_STRING_CHAR_ADVANCE (c
, string
, best_below
, best_below_byte
);
753 i_byte
= best_below_byte
;
757 while (best_above_byte
> byte_index
)
759 int best_above_byte_saved
= --best_above_byte
;
761 while (best_above_byte
> 0
762 && !CHAR_HEAD_P (XSTRING (string
)->data
[best_above_byte
]))
764 if (XSTRING (string
)->data
[best_above_byte
] < 0x80)
765 best_above_byte
= best_above_byte_saved
;
769 i_byte
= best_above_byte
;
772 string_char_byte_cache_bytepos
= i_byte
;
773 string_char_byte_cache_charpos
= i
;
774 string_char_byte_cache_string
= string
;
779 /* Convert STRING to a multibyte string.
780 Single-byte characters 0200 through 0377 are converted
781 by adding nonascii_insert_offset to each. */
784 string_make_multibyte (string
)
790 if (STRING_MULTIBYTE (string
))
793 nbytes
= count_size_as_multibyte (XSTRING (string
)->data
,
794 XSTRING (string
)->size
);
795 /* If all the chars are ASCII, they won't need any more bytes
796 once converted. In that case, we can return STRING itself. */
797 if (nbytes
== XSTRING (string
)->size_byte
)
800 buf
= (unsigned char *) alloca (nbytes
);
801 copy_text (XSTRING (string
)->data
, buf
, XSTRING (string
)->size_byte
,
804 return make_multibyte_string (buf
, XSTRING (string
)->size
, nbytes
);
807 /* Convert STRING to a single-byte string. */
810 string_make_unibyte (string
)
815 if (! STRING_MULTIBYTE (string
))
818 buf
= (unsigned char *) alloca (XSTRING (string
)->size
);
820 copy_text (XSTRING (string
)->data
, buf
, XSTRING (string
)->size_byte
,
823 return make_unibyte_string (buf
, XSTRING (string
)->size
);
826 DEFUN ("string-make-multibyte", Fstring_make_multibyte
, Sstring_make_multibyte
,
828 "Return the multibyte equivalent of STRING.")
832 return string_make_multibyte (string
);
835 DEFUN ("string-make-unibyte", Fstring_make_unibyte
, Sstring_make_unibyte
,
837 "Return the unibyte equivalent of STRING.")
841 return string_make_unibyte (string
);
844 DEFUN ("string-as-unibyte", Fstring_as_unibyte
, Sstring_as_unibyte
,
846 "Return a unibyte string with the same individual bytes as STRING.\n\
847 If STRING is unibyte, the result is STRING itself.")
851 if (STRING_MULTIBYTE (string
))
853 string
= Fcopy_sequence (string
);
854 XSTRING (string
)->size
= XSTRING (string
)->size_byte
;
859 DEFUN ("string-as-multibyte", Fstring_as_multibyte
, Sstring_as_multibyte
,
861 "Return a multibyte string with the same individual bytes as STRING.\n\
862 If STRING is multibyte, the result is STRING itself.")
866 if (! STRING_MULTIBYTE (string
))
868 int newlen
= chars_in_text (XSTRING (string
)->data
,
869 XSTRING (string
)->size_byte
);
870 /* If all the chars are ASCII, STRING is already suitable. */
871 if (newlen
!= XSTRING (string
)->size_byte
)
873 string
= Fcopy_sequence (string
);
874 XSTRING (string
)->size
= newlen
;
880 DEFUN ("copy-alist", Fcopy_alist
, Scopy_alist
, 1, 1, 0,
881 "Return a copy of ALIST.\n\
882 This is an alist which represents the same mapping from objects to objects,\n\
883 but does not share the alist structure with ALIST.\n\
884 The objects mapped (cars and cdrs of elements of the alist)\n\
885 are shared, however.\n\
886 Elements of ALIST that are not conses are also shared.")
890 register Lisp_Object tem
;
892 CHECK_LIST (alist
, 0);
895 alist
= concat (1, &alist
, Lisp_Cons
, 0);
896 for (tem
= alist
; CONSP (tem
); tem
= XCONS (tem
)->cdr
)
898 register Lisp_Object car
;
899 car
= XCONS (tem
)->car
;
902 XCONS (tem
)->car
= Fcons (XCONS (car
)->car
, XCONS (car
)->cdr
);
907 DEFUN ("substring", Fsubstring
, Ssubstring
, 2, 3, 0,
908 "Return a substring of STRING, starting at index FROM and ending before TO.\n\
909 TO may be nil or omitted; then the substring runs to the end of STRING.\n\
910 If FROM or TO is negative, it counts from the end.\n\
912 This function allows vectors as well as strings.")
915 register Lisp_Object from
, to
;
920 int from_char
, to_char
;
921 int from_byte
, to_byte
;
923 if (! (STRINGP (string
) || VECTORP (string
)))
924 wrong_type_argument (Qarrayp
, string
);
926 CHECK_NUMBER (from
, 1);
928 if (STRINGP (string
))
930 size
= XSTRING (string
)->size
;
931 size_byte
= XSTRING (string
)->size_byte
;
934 size
= XVECTOR (string
)->size
;
943 CHECK_NUMBER (to
, 2);
949 if (STRINGP (string
))
950 to_byte
= string_char_to_byte (string
, to_char
);
953 from_char
= XINT (from
);
956 if (STRINGP (string
))
957 from_byte
= string_char_to_byte (string
, from_char
);
959 if (!(0 <= from_char
&& from_char
<= to_char
&& to_char
<= size
))
960 args_out_of_range_3 (string
, make_number (from_char
),
961 make_number (to_char
));
963 if (STRINGP (string
))
965 res
= make_multibyte_string (XSTRING (string
)->data
+ from_byte
,
966 to_char
- from_char
, to_byte
- from_byte
);
967 copy_text_properties (from_char
, to_char
, string
,
968 make_number (0), res
, Qnil
);
971 res
= Fvector (to_char
- from_char
,
972 XVECTOR (string
)->contents
+ from_char
);
977 /* Extract a substring of STRING, giving start and end positions
978 both in characters and in bytes. */
981 substring_both (string
, from
, from_byte
, to
, to_byte
)
983 int from
, from_byte
, to
, to_byte
;
989 if (! (STRINGP (string
) || VECTORP (string
)))
990 wrong_type_argument (Qarrayp
, string
);
992 if (STRINGP (string
))
994 size
= XSTRING (string
)->size
;
995 size_byte
= XSTRING (string
)->size_byte
;
998 size
= XVECTOR (string
)->size
;
1000 if (!(0 <= from
&& from
<= to
&& to
<= size
))
1001 args_out_of_range_3 (string
, make_number (from
), make_number (to
));
1003 if (STRINGP (string
))
1005 res
= make_multibyte_string (XSTRING (string
)->data
+ from_byte
,
1006 to
- from
, to_byte
- from_byte
);
1007 copy_text_properties (from
, to
, string
, make_number (0), res
, Qnil
);
1010 res
= Fvector (to
- from
,
1011 XVECTOR (string
)->contents
+ from
);
1016 DEFUN ("nthcdr", Fnthcdr
, Snthcdr
, 2, 2, 0,
1017 "Take cdr N times on LIST, returns the result.")
1020 register Lisp_Object list
;
1022 register int i
, num
;
1023 CHECK_NUMBER (n
, 0);
1025 for (i
= 0; i
< num
&& !NILP (list
); i
++)
1033 DEFUN ("nth", Fnth
, Snth
, 2, 2, 0,
1034 "Return the Nth element of LIST.\n\
1035 N counts from zero. If LIST is not that long, nil is returned.")
1037 Lisp_Object n
, list
;
1039 return Fcar (Fnthcdr (n
, list
));
1042 DEFUN ("elt", Felt
, Selt
, 2, 2, 0,
1043 "Return element of SEQUENCE at index N.")
1045 register Lisp_Object sequence
, n
;
1047 CHECK_NUMBER (n
, 0);
1050 if (CONSP (sequence
) || NILP (sequence
))
1051 return Fcar (Fnthcdr (n
, sequence
));
1052 else if (STRINGP (sequence
) || VECTORP (sequence
)
1053 || BOOL_VECTOR_P (sequence
) || CHAR_TABLE_P (sequence
))
1054 return Faref (sequence
, n
);
1056 sequence
= wrong_type_argument (Qsequencep
, sequence
);
1060 DEFUN ("member", Fmember
, Smember
, 2, 2, 0,
1061 "Return non-nil if ELT is an element of LIST. Comparison done with `equal'.\n\
1062 The value is actually the tail of LIST whose car is ELT.")
1064 register Lisp_Object elt
;
1067 register Lisp_Object tail
;
1068 for (tail
= list
; !NILP (tail
); tail
= XCONS (tail
)->cdr
)
1070 register Lisp_Object tem
;
1072 if (! NILP (Fequal (elt
, tem
)))
1079 DEFUN ("memq", Fmemq
, Smemq
, 2, 2, 0,
1080 "Return non-nil if ELT is an element of LIST. Comparison done with EQ.\n\
1081 The value is actually the tail of LIST whose car is ELT.")
1083 register Lisp_Object elt
;
1086 register Lisp_Object tail
;
1087 for (tail
= list
; !NILP (tail
); tail
= XCONS (tail
)->cdr
)
1089 register Lisp_Object tem
;
1091 if (EQ (elt
, tem
)) return tail
;
1097 DEFUN ("assq", Fassq
, Sassq
, 2, 2, 0,
1098 "Return non-nil if KEY is `eq' to the car of an element of LIST.\n\
1099 The value is actually the element of LIST whose car is KEY.\n\
1100 Elements of LIST that are not conses are ignored.")
1102 register Lisp_Object key
;
1105 register Lisp_Object tail
;
1106 for (tail
= list
; !NILP (tail
); tail
= XCONS (tail
)->cdr
)
1108 register Lisp_Object elt
, tem
;
1110 if (!CONSP (elt
)) continue;
1111 tem
= XCONS (elt
)->car
;
1112 if (EQ (key
, tem
)) return elt
;
1118 /* Like Fassq but never report an error and do not allow quits.
1119 Use only on lists known never to be circular. */
1122 assq_no_quit (key
, list
)
1123 register Lisp_Object key
;
1126 register Lisp_Object tail
;
1127 for (tail
= list
; CONSP (tail
); tail
= XCONS (tail
)->cdr
)
1129 register Lisp_Object elt
, tem
;
1131 if (!CONSP (elt
)) continue;
1132 tem
= XCONS (elt
)->car
;
1133 if (EQ (key
, tem
)) return elt
;
1138 DEFUN ("assoc", Fassoc
, Sassoc
, 2, 2, 0,
1139 "Return non-nil if KEY is `equal' to the car of an element of LIST.\n\
1140 The value is actually the element of LIST whose car equals KEY.")
1142 register Lisp_Object key
;
1145 register Lisp_Object tail
;
1146 for (tail
= list
; !NILP (tail
); tail
= XCONS (tail
)->cdr
)
1148 register Lisp_Object elt
, tem
;
1150 if (!CONSP (elt
)) continue;
1151 tem
= Fequal (XCONS (elt
)->car
, key
);
1152 if (!NILP (tem
)) return elt
;
1158 DEFUN ("rassq", Frassq
, Srassq
, 2, 2, 0,
1159 "Return non-nil if ELT is `eq' to the cdr of an element of LIST.\n\
1160 The value is actually the element of LIST whose cdr is ELT.")
1162 register Lisp_Object key
;
1165 register Lisp_Object tail
;
1166 for (tail
= list
; !NILP (tail
); tail
= XCONS (tail
)->cdr
)
1168 register Lisp_Object elt
, tem
;
1170 if (!CONSP (elt
)) continue;
1171 tem
= XCONS (elt
)->cdr
;
1172 if (EQ (key
, tem
)) return elt
;
1178 DEFUN ("rassoc", Frassoc
, Srassoc
, 2, 2, 0,
1179 "Return non-nil if KEY is `equal' to the cdr of an element of LIST.\n\
1180 The value is actually the element of LIST whose cdr equals KEY.")
1182 register Lisp_Object key
;
1185 register Lisp_Object tail
;
1186 for (tail
= list
; !NILP (tail
); tail
= XCONS (tail
)->cdr
)
1188 register Lisp_Object elt
, tem
;
1190 if (!CONSP (elt
)) continue;
1191 tem
= Fequal (XCONS (elt
)->cdr
, key
);
1192 if (!NILP (tem
)) return elt
;
1198 DEFUN ("delq", Fdelq
, Sdelq
, 2, 2, 0,
1199 "Delete by side effect any occurrences of ELT as a member of LIST.\n\
1200 The modified LIST is returned. Comparison is done with `eq'.\n\
1201 If the first member of LIST is ELT, there is no way to remove it by side effect;\n\
1202 therefore, write `(setq foo (delq element foo))'\n\
1203 to be sure of changing the value of `foo'.")
1205 register Lisp_Object elt
;
1208 register Lisp_Object tail
, prev
;
1209 register Lisp_Object tem
;
1213 while (!NILP (tail
))
1219 list
= XCONS (tail
)->cdr
;
1221 Fsetcdr (prev
, XCONS (tail
)->cdr
);
1225 tail
= XCONS (tail
)->cdr
;
1231 DEFUN ("delete", Fdelete
, Sdelete
, 2, 2, 0,
1232 "Delete by side effect any occurrences of ELT as a member of LIST.\n\
1233 The modified LIST is returned. Comparison is done with `equal'.\n\
1234 If the first member of LIST is ELT, deleting it is not a side effect;\n\
1235 it is simply using a different list.\n\
1236 Therefore, write `(setq foo (delete element foo))'\n\
1237 to be sure of changing the value of `foo'.")
1239 register Lisp_Object elt
;
1242 register Lisp_Object tail
, prev
;
1243 register Lisp_Object tem
;
1247 while (!NILP (tail
))
1250 if (! NILP (Fequal (elt
, tem
)))
1253 list
= XCONS (tail
)->cdr
;
1255 Fsetcdr (prev
, XCONS (tail
)->cdr
);
1259 tail
= XCONS (tail
)->cdr
;
1265 DEFUN ("nreverse", Fnreverse
, Snreverse
, 1, 1, 0,
1266 "Reverse LIST by modifying cdr pointers.\n\
1267 Returns the beginning of the reversed list.")
1271 register Lisp_Object prev
, tail
, next
;
1273 if (NILP (list
)) return list
;
1276 while (!NILP (tail
))
1280 Fsetcdr (tail
, prev
);
1287 DEFUN ("reverse", Freverse
, Sreverse
, 1, 1, 0,
1288 "Reverse LIST, copying. Returns the beginning of the reversed list.\n\
1289 See also the function `nreverse', which is used more often.")
1295 for (new = Qnil
; CONSP (list
); list
= XCONS (list
)->cdr
)
1296 new = Fcons (XCONS (list
)->car
, new);
1298 wrong_type_argument (Qconsp
, list
);
1302 Lisp_Object
merge ();
1304 DEFUN ("sort", Fsort
, Ssort
, 2, 2, 0,
1305 "Sort LIST, stably, comparing elements using PREDICATE.\n\
1306 Returns the sorted list. LIST is modified by side effects.\n\
1307 PREDICATE is called with two elements of LIST, and should return T\n\
1308 if the first element is \"less\" than the second.")
1310 Lisp_Object list
, predicate
;
1312 Lisp_Object front
, back
;
1313 register Lisp_Object len
, tem
;
1314 struct gcpro gcpro1
, gcpro2
;
1315 register int length
;
1318 len
= Flength (list
);
1319 length
= XINT (len
);
1323 XSETINT (len
, (length
/ 2) - 1);
1324 tem
= Fnthcdr (len
, list
);
1326 Fsetcdr (tem
, Qnil
);
1328 GCPRO2 (front
, back
);
1329 front
= Fsort (front
, predicate
);
1330 back
= Fsort (back
, predicate
);
1332 return merge (front
, back
, predicate
);
1336 merge (org_l1
, org_l2
, pred
)
1337 Lisp_Object org_l1
, org_l2
;
1341 register Lisp_Object tail
;
1343 register Lisp_Object l1
, l2
;
1344 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
1351 /* It is sufficient to protect org_l1 and org_l2.
1352 When l1 and l2 are updated, we copy the new values
1353 back into the org_ vars. */
1354 GCPRO4 (org_l1
, org_l2
, pred
, value
);
1374 tem
= call2 (pred
, Fcar (l2
), Fcar (l1
));
1390 Fsetcdr (tail
, tem
);
1396 DEFUN ("plist-get", Fplist_get
, Splist_get
, 2, 2, 0,
1397 "Extract a value from a property list.\n\
1398 PLIST is a property list, which is a list of the form\n\
1399 \(PROP1 VALUE1 PROP2 VALUE2...). This function returns the value\n\
1400 corresponding to the given PROP, or nil if PROP is not\n\
1401 one of the properties on the list.")
1404 register Lisp_Object prop
;
1406 register Lisp_Object tail
;
1407 for (tail
= plist
; !NILP (tail
); tail
= Fcdr (XCONS (tail
)->cdr
))
1409 register Lisp_Object tem
;
1412 return Fcar (XCONS (tail
)->cdr
);
1417 DEFUN ("get", Fget
, Sget
, 2, 2, 0,
1418 "Return the value of SYMBOL's PROPNAME property.\n\
1419 This is the last value stored with `(put SYMBOL PROPNAME VALUE)'.")
1421 Lisp_Object symbol
, propname
;
1423 CHECK_SYMBOL (symbol
, 0);
1424 return Fplist_get (XSYMBOL (symbol
)->plist
, propname
);
1427 DEFUN ("plist-put", Fplist_put
, Splist_put
, 3, 3, 0,
1428 "Change value in PLIST of PROP to VAL.\n\
1429 PLIST is a property list, which is a list of the form\n\
1430 \(PROP1 VALUE1 PROP2 VALUE2 ...). PROP is a symbol and VAL is any object.\n\
1431 If PROP is already a property on the list, its value is set to VAL,\n\
1432 otherwise the new PROP VAL pair is added. The new plist is returned;\n\
1433 use `(setq x (plist-put x prop val))' to be sure to use the new value.\n\
1434 The PLIST is modified by side effects.")
1437 register Lisp_Object prop
;
1440 register Lisp_Object tail
, prev
;
1441 Lisp_Object newcell
;
1443 for (tail
= plist
; CONSP (tail
) && CONSP (XCONS (tail
)->cdr
);
1444 tail
= XCONS (XCONS (tail
)->cdr
)->cdr
)
1446 if (EQ (prop
, XCONS (tail
)->car
))
1448 Fsetcar (XCONS (tail
)->cdr
, val
);
1453 newcell
= Fcons (prop
, Fcons (val
, Qnil
));
1457 Fsetcdr (XCONS (prev
)->cdr
, newcell
);
1461 DEFUN ("put", Fput
, Sput
, 3, 3, 0,
1462 "Store SYMBOL's PROPNAME property with value VALUE.\n\
1463 It can be retrieved with `(get SYMBOL PROPNAME)'.")
1464 (symbol
, propname
, value
)
1465 Lisp_Object symbol
, propname
, value
;
1467 CHECK_SYMBOL (symbol
, 0);
1468 XSYMBOL (symbol
)->plist
1469 = Fplist_put (XSYMBOL (symbol
)->plist
, propname
, value
);
1473 DEFUN ("equal", Fequal
, Sequal
, 2, 2, 0,
1474 "Return t if two Lisp objects have similar structure and contents.\n\
1475 They must have the same data type.\n\
1476 Conses are compared by comparing the cars and the cdrs.\n\
1477 Vectors and strings are compared element by element.\n\
1478 Numbers are compared by value, but integers cannot equal floats.\n\
1479 (Use `=' if you want integers and floats to be able to be equal.)\n\
1480 Symbols must match exactly.")
1482 register Lisp_Object o1
, o2
;
1484 return internal_equal (o1
, o2
, 0) ? Qt
: Qnil
;
1488 internal_equal (o1
, o2
, depth
)
1489 register Lisp_Object o1
, o2
;
1493 error ("Stack overflow in equal");
1499 if (XTYPE (o1
) != XTYPE (o2
))
1504 #ifdef LISP_FLOAT_TYPE
1506 return (extract_float (o1
) == extract_float (o2
));
1510 if (!internal_equal (XCONS (o1
)->car
, XCONS (o2
)->car
, depth
+ 1))
1512 o1
= XCONS (o1
)->cdr
;
1513 o2
= XCONS (o2
)->cdr
;
1517 if (XMISCTYPE (o1
) != XMISCTYPE (o2
))
1521 if (!internal_equal (OVERLAY_START (o1
), OVERLAY_START (o1
),
1523 || !internal_equal (OVERLAY_END (o1
), OVERLAY_END (o1
),
1526 o1
= XOVERLAY (o1
)->plist
;
1527 o2
= XOVERLAY (o2
)->plist
;
1532 return (XMARKER (o1
)->buffer
== XMARKER (o2
)->buffer
1533 && (XMARKER (o1
)->buffer
== 0
1534 || XMARKER (o1
)->bytepos
== XMARKER (o2
)->bytepos
));
1538 case Lisp_Vectorlike
:
1540 register int i
, size
;
1541 size
= XVECTOR (o1
)->size
;
1542 /* Pseudovectors have the type encoded in the size field, so this test
1543 actually checks that the objects have the same type as well as the
1545 if (XVECTOR (o2
)->size
!= size
)
1547 /* Boolvectors are compared much like strings. */
1548 if (BOOL_VECTOR_P (o1
))
1551 = (XBOOL_VECTOR (o1
)->size
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
;
1553 if (XBOOL_VECTOR (o1
)->size
!= XBOOL_VECTOR (o2
)->size
)
1555 if (bcmp (XBOOL_VECTOR (o1
)->data
, XBOOL_VECTOR (o2
)->data
,
1560 if (WINDOW_CONFIGURATIONP (o1
))
1561 return compare_window_configurations (o1
, o2
);
1563 /* Aside from them, only true vectors, char-tables, and compiled
1564 functions are sensible to compare, so eliminate the others now. */
1565 if (size
& PSEUDOVECTOR_FLAG
)
1567 if (!(size
& (PVEC_COMPILED
| PVEC_CHAR_TABLE
)))
1569 size
&= PSEUDOVECTOR_SIZE_MASK
;
1571 for (i
= 0; i
< size
; i
++)
1574 v1
= XVECTOR (o1
)->contents
[i
];
1575 v2
= XVECTOR (o2
)->contents
[i
];
1576 if (!internal_equal (v1
, v2
, depth
+ 1))
1584 if (XSTRING (o1
)->size
!= XSTRING (o2
)->size
)
1586 if (XSTRING (o1
)->size_byte
!= XSTRING (o2
)->size_byte
)
1588 if (bcmp (XSTRING (o1
)->data
, XSTRING (o2
)->data
,
1589 XSTRING (o1
)->size_byte
))
1596 extern Lisp_Object
Fmake_char_internal ();
1598 DEFUN ("fillarray", Ffillarray
, Sfillarray
, 2, 2, 0,
1599 "Store each element of ARRAY with ITEM.\n\
1600 ARRAY is a vector, string, char-table, or bool-vector.")
1602 Lisp_Object array
, item
;
1604 register int size
, index
, charval
;
1606 if (VECTORP (array
))
1608 register Lisp_Object
*p
= XVECTOR (array
)->contents
;
1609 size
= XVECTOR (array
)->size
;
1610 for (index
= 0; index
< size
; index
++)
1613 else if (CHAR_TABLE_P (array
))
1615 register Lisp_Object
*p
= XCHAR_TABLE (array
)->contents
;
1616 size
= CHAR_TABLE_ORDINARY_SLOTS
;
1617 for (index
= 0; index
< size
; index
++)
1619 XCHAR_TABLE (array
)->defalt
= Qnil
;
1621 else if (STRINGP (array
))
1623 register unsigned char *p
= XSTRING (array
)->data
;
1624 CHECK_NUMBER (item
, 1);
1625 charval
= XINT (item
);
1626 size
= XSTRING (array
)->size
;
1627 for (index
= 0; index
< size
; index
++)
1630 else if (BOOL_VECTOR_P (array
))
1632 register unsigned char *p
= XBOOL_VECTOR (array
)->data
;
1634 = (XBOOL_VECTOR (array
)->size
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
;
1636 charval
= (! NILP (item
) ? -1 : 0);
1637 for (index
= 0; index
< size_in_chars
; index
++)
1642 array
= wrong_type_argument (Qarrayp
, array
);
1648 DEFUN ("char-table-subtype", Fchar_table_subtype
, Schar_table_subtype
,
1650 "Return the subtype of char-table CHAR-TABLE. The value is a symbol.")
1652 Lisp_Object char_table
;
1654 CHECK_CHAR_TABLE (char_table
, 0);
1656 return XCHAR_TABLE (char_table
)->purpose
;
1659 DEFUN ("char-table-parent", Fchar_table_parent
, Schar_table_parent
,
1661 "Return the parent char-table of CHAR-TABLE.\n\
1662 The value is either nil or another char-table.\n\
1663 If CHAR-TABLE holds nil for a given character,\n\
1664 then the actual applicable value is inherited from the parent char-table\n\
1665 \(or from its parents, if necessary).")
1667 Lisp_Object char_table
;
1669 CHECK_CHAR_TABLE (char_table
, 0);
1671 return XCHAR_TABLE (char_table
)->parent
;
1674 DEFUN ("set-char-table-parent", Fset_char_table_parent
, Sset_char_table_parent
,
1676 "Set the parent char-table of CHAR-TABLE to PARENT.\n\
1677 PARENT must be either nil or another char-table.")
1678 (char_table
, parent
)
1679 Lisp_Object char_table
, parent
;
1683 CHECK_CHAR_TABLE (char_table
, 0);
1687 CHECK_CHAR_TABLE (parent
, 0);
1689 for (temp
= parent
; !NILP (temp
); temp
= XCHAR_TABLE (temp
)->parent
)
1690 if (EQ (temp
, char_table
))
1691 error ("Attempt to make a chartable be its own parent");
1694 XCHAR_TABLE (char_table
)->parent
= parent
;
1699 DEFUN ("char-table-extra-slot", Fchar_table_extra_slot
, Schar_table_extra_slot
,
1701 "Return the value of CHAR-TABLE's extra-slot number N.")
1703 Lisp_Object char_table
, n
;
1705 CHECK_CHAR_TABLE (char_table
, 1);
1706 CHECK_NUMBER (n
, 2);
1708 || XINT (n
) >= CHAR_TABLE_EXTRA_SLOTS (XCHAR_TABLE (char_table
)))
1709 args_out_of_range (char_table
, n
);
1711 return XCHAR_TABLE (char_table
)->extras
[XINT (n
)];
1714 DEFUN ("set-char-table-extra-slot", Fset_char_table_extra_slot
,
1715 Sset_char_table_extra_slot
,
1717 "Set CHAR-TABLE's extra-slot number N to VALUE.")
1718 (char_table
, n
, value
)
1719 Lisp_Object char_table
, n
, value
;
1721 CHECK_CHAR_TABLE (char_table
, 1);
1722 CHECK_NUMBER (n
, 2);
1724 || XINT (n
) >= CHAR_TABLE_EXTRA_SLOTS (XCHAR_TABLE (char_table
)))
1725 args_out_of_range (char_table
, n
);
1727 return XCHAR_TABLE (char_table
)->extras
[XINT (n
)] = value
;
1730 DEFUN ("char-table-range", Fchar_table_range
, Schar_table_range
,
1732 "Return the value in CHAR-TABLE for a range of characters RANGE.\n\
1733 RANGE should be nil (for the default value)\n\
1734 a vector which identifies a character set or a row of a character set,\n\
1735 a character set name, or a character code.")
1737 Lisp_Object char_table
, range
;
1741 CHECK_CHAR_TABLE (char_table
, 0);
1743 if (EQ (range
, Qnil
))
1744 return XCHAR_TABLE (char_table
)->defalt
;
1745 else if (INTEGERP (range
))
1746 return Faref (char_table
, range
);
1747 else if (SYMBOLP (range
))
1749 Lisp_Object charset_info
;
1751 charset_info
= Fget (range
, Qcharset
);
1752 CHECK_VECTOR (charset_info
, 0);
1754 return Faref (char_table
, XVECTOR (charset_info
)->contents
[0] + 128);
1756 else if (VECTORP (range
))
1758 if (XVECTOR (range
)->size
== 1)
1759 return Faref (char_table
, XVECTOR (range
)->contents
[0] + 128);
1762 int size
= XVECTOR (range
)->size
;
1763 Lisp_Object
*val
= XVECTOR (range
)->contents
;
1764 Lisp_Object ch
= Fmake_char_internal (size
<= 0 ? Qnil
: val
[0],
1765 size
<= 1 ? Qnil
: val
[1],
1766 size
<= 2 ? Qnil
: val
[2]);
1767 return Faref (char_table
, ch
);
1771 error ("Invalid RANGE argument to `char-table-range'");
1774 DEFUN ("set-char-table-range", Fset_char_table_range
, Sset_char_table_range
,
1776 "Set the value in CHAR-TABLE for a range of characters RANGE to VALUE.\n\
1777 RANGE should be t (for all characters), nil (for the default value)\n\
1778 a vector which identifies a character set or a row of a character set,\n\
1779 a coding system, or a character code.")
1780 (char_table
, range
, value
)
1781 Lisp_Object char_table
, range
, value
;
1785 CHECK_CHAR_TABLE (char_table
, 0);
1788 for (i
= 0; i
< CHAR_TABLE_ORDINARY_SLOTS
; i
++)
1789 XCHAR_TABLE (char_table
)->contents
[i
] = value
;
1790 else if (EQ (range
, Qnil
))
1791 XCHAR_TABLE (char_table
)->defalt
= value
;
1792 else if (SYMBOLP (range
))
1794 Lisp_Object charset_info
;
1796 charset_info
= Fget (range
, Qcharset
);
1797 CHECK_VECTOR (charset_info
, 0);
1799 return Faset (char_table
, XVECTOR (charset_info
)->contents
[0] + 128,
1802 else if (INTEGERP (range
))
1803 Faset (char_table
, range
, value
);
1804 else if (VECTORP (range
))
1806 if (XVECTOR (range
)->size
== 1)
1807 return Faset (char_table
, XVECTOR (range
)->contents
[0] + 128, value
);
1810 int size
= XVECTOR (range
)->size
;
1811 Lisp_Object
*val
= XVECTOR (range
)->contents
;
1812 Lisp_Object ch
= Fmake_char_internal (size
<= 0 ? Qnil
: val
[0],
1813 size
<= 1 ? Qnil
: val
[1],
1814 size
<= 2 ? Qnil
: val
[2]);
1815 return Faset (char_table
, ch
, value
);
1819 error ("Invalid RANGE argument to `set-char-table-range'");
1824 DEFUN ("set-char-table-default", Fset_char_table_default
,
1825 Sset_char_table_default
, 3, 3, 0,
1826 "Set the default value in CHAR-TABLE for a generic character CHAR to VALUE.\n\
1827 The generic character specifies the group of characters.\n\
1828 See also the documentation of make-char.")
1829 (char_table
, ch
, value
)
1830 Lisp_Object char_table
, ch
, value
;
1832 int c
, i
, charset
, code1
, code2
;
1835 CHECK_CHAR_TABLE (char_table
, 0);
1836 CHECK_NUMBER (ch
, 1);
1839 SPLIT_NON_ASCII_CHAR (c
, charset
, code1
, code2
);
1840 if (! CHARSET_DEFINED_P (charset
))
1841 error ("Invalid character: %d", c
);
1843 if (charset
== CHARSET_ASCII
)
1844 return (XCHAR_TABLE (char_table
)->defalt
= value
);
1846 /* Even if C is not a generic char, we had better behave as if a
1847 generic char is specified. */
1848 if (CHARSET_DIMENSION (charset
) == 1)
1850 temp
= XCHAR_TABLE (char_table
)->contents
[charset
+ 128];
1853 if (SUB_CHAR_TABLE_P (temp
))
1854 XCHAR_TABLE (temp
)->defalt
= value
;
1856 XCHAR_TABLE (char_table
)->contents
[charset
+ 128] = value
;
1860 if (! SUB_CHAR_TABLE_P (char_table
))
1861 char_table
= (XCHAR_TABLE (char_table
)->contents
[charset
+ 128]
1862 = make_sub_char_table (temp
));
1863 temp
= XCHAR_TABLE (char_table
)->contents
[code1
];
1864 if (SUB_CHAR_TABLE_P (temp
))
1865 XCHAR_TABLE (temp
)->defalt
= value
;
1867 XCHAR_TABLE (char_table
)->contents
[code1
] = value
;
1871 /* Map C_FUNCTION or FUNCTION over SUBTABLE, calling it for each
1872 character or group of characters that share a value.
1873 DEPTH is the current depth in the originally specified
1874 chartable, and INDICES contains the vector indices
1875 for the levels our callers have descended.
1877 ARG is passed to C_FUNCTION when that is called. */
1880 map_char_table (c_function
, function
, subtable
, arg
, depth
, indices
)
1881 void (*c_function
) P_ ((Lisp_Object
, Lisp_Object
, Lisp_Object
));
1882 Lisp_Object function
, subtable
, arg
, *indices
;
1889 /* At first, handle ASCII and 8-bit European characters. */
1890 for (i
= 0; i
< CHAR_TABLE_SINGLE_BYTE_SLOTS
; i
++)
1892 Lisp_Object elt
= XCHAR_TABLE (subtable
)->contents
[i
];
1894 (*c_function
) (arg
, make_number (i
), elt
);
1896 call2 (function
, make_number (i
), elt
);
1898 #if 0 /* If the char table has entries for higher characters,
1899 we should report them. */
1900 if (NILP (current_buffer
->enable_multibyte_characters
))
1903 to
= CHAR_TABLE_ORDINARY_SLOTS
;
1908 to
= SUB_CHAR_TABLE_ORDINARY_SLOTS
;
1913 Lisp_Object elt
= XCHAR_TABLE (subtable
)->contents
[i
];
1915 XSETFASTINT (indices
[depth
], i
);
1917 if (SUB_CHAR_TABLE_P (elt
))
1920 error ("Too deep char table");
1921 map_char_table (c_function
, function
, elt
, arg
, depth
+ 1, indices
);
1925 int charset
= XFASTINT (indices
[0]) - 128, c1
, c2
, c
;
1927 if (CHARSET_DEFINED_P (charset
))
1929 c1
= depth
>= 1 ? XFASTINT (indices
[1]) : 0;
1930 c2
= depth
>= 2 ? XFASTINT (indices
[2]) : 0;
1931 c
= MAKE_NON_ASCII_CHAR (charset
, c1
, c2
);
1933 (*c_function
) (arg
, make_number (c
), elt
);
1935 call2 (function
, make_number (c
), elt
);
1941 DEFUN ("map-char-table", Fmap_char_table
, Smap_char_table
,
1943 "Call FUNCTION for each (normal and generic) characters in CHAR-TABLE.\n\
1944 FUNCTION is called with two arguments--a key and a value.\n\
1945 The key is always a possible IDX argument to `aref'.")
1946 (function
, char_table
)
1947 Lisp_Object function
, char_table
;
1949 /* The depth of char table is at most 3. */
1950 Lisp_Object indices
[3];
1952 CHECK_CHAR_TABLE (char_table
, 1);
1954 map_char_table (NULL
, function
, char_table
, char_table
, 0, indices
);
1964 Lisp_Object args
[2];
1967 return Fnconc (2, args
);
1969 return Fnconc (2, &s1
);
1970 #endif /* NO_ARG_ARRAY */
1973 DEFUN ("nconc", Fnconc
, Snconc
, 0, MANY
, 0,
1974 "Concatenate any number of lists by altering them.\n\
1975 Only the last argument is not altered, and need not be a list.")
1980 register int argnum
;
1981 register Lisp_Object tail
, tem
, val
;
1985 for (argnum
= 0; argnum
< nargs
; argnum
++)
1988 if (NILP (tem
)) continue;
1993 if (argnum
+ 1 == nargs
) break;
1996 tem
= wrong_type_argument (Qlistp
, tem
);
2005 tem
= args
[argnum
+ 1];
2006 Fsetcdr (tail
, tem
);
2008 args
[argnum
+ 1] = tail
;
2014 /* This is the guts of all mapping functions.
2015 Apply FN to each element of SEQ, one by one,
2016 storing the results into elements of VALS, a C vector of Lisp_Objects.
2017 LENI is the length of VALS, which should also be the length of SEQ. */
2020 mapcar1 (leni
, vals
, fn
, seq
)
2023 Lisp_Object fn
, seq
;
2025 register Lisp_Object tail
;
2028 struct gcpro gcpro1
, gcpro2
, gcpro3
;
2030 /* Don't let vals contain any garbage when GC happens. */
2031 for (i
= 0; i
< leni
; i
++)
2034 GCPRO3 (dummy
, fn
, seq
);
2036 gcpro1
.nvars
= leni
;
2037 /* We need not explicitly protect `tail' because it is used only on lists, and
2038 1) lists are not relocated and 2) the list is marked via `seq' so will not be freed */
2042 for (i
= 0; i
< leni
; i
++)
2044 dummy
= XVECTOR (seq
)->contents
[i
];
2045 vals
[i
] = call1 (fn
, dummy
);
2048 else if (STRINGP (seq
) && ! STRING_MULTIBYTE (seq
))
2050 /* Single-byte string. */
2051 for (i
= 0; i
< leni
; i
++)
2053 XSETFASTINT (dummy
, XSTRING (seq
)->data
[i
]);
2054 vals
[i
] = call1 (fn
, dummy
);
2057 else if (STRINGP (seq
))
2059 /* Multi-byte string. */
2060 int len_byte
= XSTRING (seq
)->size_byte
;
2063 for (i
= 0, i_byte
= 0; i
< leni
;)
2068 FETCH_STRING_CHAR_ADVANCE (c
, seq
, i
, i_byte
);
2069 XSETFASTINT (dummy
, c
);
2070 vals
[i_before
] = call1 (fn
, dummy
);
2073 else /* Must be a list, since Flength did not get an error */
2076 for (i
= 0; i
< leni
; i
++)
2078 vals
[i
] = call1 (fn
, Fcar (tail
));
2079 tail
= XCONS (tail
)->cdr
;
2086 DEFUN ("mapconcat", Fmapconcat
, Smapconcat
, 3, 3, 0,
2087 "Apply FUNCTION to each element of SEQUENCE, and concat the results as strings.\n\
2088 In between each pair of results, stick in SEPARATOR. Thus, \" \" as\n\
2089 SEPARATOR results in spaces between the values returned by FUNCTION.")
2090 (function
, sequence
, separator
)
2091 Lisp_Object function
, sequence
, separator
;
2096 register Lisp_Object
*args
;
2098 struct gcpro gcpro1
;
2100 len
= Flength (sequence
);
2102 nargs
= leni
+ leni
- 1;
2103 if (nargs
< 0) return build_string ("");
2105 args
= (Lisp_Object
*) alloca (nargs
* sizeof (Lisp_Object
));
2108 mapcar1 (leni
, args
, function
, sequence
);
2111 for (i
= leni
- 1; i
>= 0; i
--)
2112 args
[i
+ i
] = args
[i
];
2114 for (i
= 1; i
< nargs
; i
+= 2)
2115 args
[i
] = separator
;
2117 return Fconcat (nargs
, args
);
2120 DEFUN ("mapcar", Fmapcar
, Smapcar
, 2, 2, 0,
2121 "Apply FUNCTION to each element of SEQUENCE, and make a list of the results.\n\
2122 The result is a list just as long as SEQUENCE.\n\
2123 SEQUENCE may be a list, a vector or a string.")
2124 (function
, sequence
)
2125 Lisp_Object function
, sequence
;
2127 register Lisp_Object len
;
2129 register Lisp_Object
*args
;
2131 len
= Flength (sequence
);
2132 leni
= XFASTINT (len
);
2133 args
= (Lisp_Object
*) alloca (leni
* sizeof (Lisp_Object
));
2135 mapcar1 (leni
, args
, function
, sequence
);
2137 return Flist (leni
, args
);
2140 /* Anything that calls this function must protect from GC! */
2142 DEFUN ("y-or-n-p", Fy_or_n_p
, Sy_or_n_p
, 1, 1, 0,
2143 "Ask user a \"y or n\" question. Return t if answer is \"y\".\n\
2144 Takes one argument, which is the string to display to ask the question.\n\
2145 It should end in a space; `y-or-n-p' adds `(y or n) ' to it.\n\
2146 No confirmation of the answer is requested; a single character is enough.\n\
2147 Also accepts Space to mean yes, or Delete to mean no.")
2151 register Lisp_Object obj
, key
, def
, answer_string
, map
;
2152 register int answer
;
2153 Lisp_Object xprompt
;
2154 Lisp_Object args
[2];
2155 struct gcpro gcpro1
, gcpro2
;
2156 int count
= specpdl_ptr
- specpdl
;
2158 specbind (Qcursor_in_echo_area
, Qt
);
2160 map
= Fsymbol_value (intern ("query-replace-map"));
2162 CHECK_STRING (prompt
, 0);
2164 GCPRO2 (prompt
, xprompt
);
2170 if ((NILP (last_nonmenu_event
) || CONSP (last_nonmenu_event
))
2174 Lisp_Object pane
, menu
;
2175 redisplay_preserve_echo_area ();
2176 pane
= Fcons (Fcons (build_string ("Yes"), Qt
),
2177 Fcons (Fcons (build_string ("No"), Qnil
),
2179 menu
= Fcons (prompt
, pane
);
2180 obj
= Fx_popup_dialog (Qt
, menu
);
2181 answer
= !NILP (obj
);
2184 #endif /* HAVE_MENUS */
2185 cursor_in_echo_area
= 1;
2186 choose_minibuf_frame ();
2187 message_with_string ("%s(y or n) ", xprompt
, 0);
2189 if (minibuffer_auto_raise
)
2191 Lisp_Object mini_frame
;
2193 mini_frame
= WINDOW_FRAME (XWINDOW (minibuf_window
));
2195 Fraise_frame (mini_frame
);
2198 obj
= read_filtered_event (1, 0, 0);
2199 cursor_in_echo_area
= 0;
2200 /* If we need to quit, quit with cursor_in_echo_area = 0. */
2203 key
= Fmake_vector (make_number (1), obj
);
2204 def
= Flookup_key (map
, key
, Qt
);
2205 answer_string
= Fsingle_key_description (obj
);
2207 if (EQ (def
, intern ("skip")))
2212 else if (EQ (def
, intern ("act")))
2217 else if (EQ (def
, intern ("recenter")))
2223 else if (EQ (def
, intern ("quit")))
2225 /* We want to exit this command for exit-prefix,
2226 and this is the only way to do it. */
2227 else if (EQ (def
, intern ("exit-prefix")))
2232 /* If we don't clear this, then the next call to read_char will
2233 return quit_char again, and we'll enter an infinite loop. */
2238 if (EQ (xprompt
, prompt
))
2240 args
[0] = build_string ("Please answer y or n. ");
2242 xprompt
= Fconcat (2, args
);
2247 if (! noninteractive
)
2249 cursor_in_echo_area
= -1;
2250 message_with_string (answer
? "%s(y or n) y" : "%s(y or n) n",
2254 unbind_to (count
, Qnil
);
2255 return answer
? Qt
: Qnil
;
2258 /* This is how C code calls `yes-or-no-p' and allows the user
2261 Anything that calls this function must protect from GC! */
2264 do_yes_or_no_p (prompt
)
2267 return call1 (intern ("yes-or-no-p"), prompt
);
2270 /* Anything that calls this function must protect from GC! */
2272 DEFUN ("yes-or-no-p", Fyes_or_no_p
, Syes_or_no_p
, 1, 1, 0,
2273 "Ask user a yes-or-no question. Return t if answer is yes.\n\
2274 Takes one argument, which is the string to display to ask the question.\n\
2275 It should end in a space; `yes-or-no-p' adds `(yes or no) ' to it.\n\
2276 The user must confirm the answer with RET,\n\
2277 and can edit it until it has been confirmed.")
2281 register Lisp_Object ans
;
2282 Lisp_Object args
[2];
2283 struct gcpro gcpro1
;
2286 CHECK_STRING (prompt
, 0);
2289 if ((NILP (last_nonmenu_event
) || CONSP (last_nonmenu_event
))
2293 Lisp_Object pane
, menu
, obj
;
2294 redisplay_preserve_echo_area ();
2295 pane
= Fcons (Fcons (build_string ("Yes"), Qt
),
2296 Fcons (Fcons (build_string ("No"), Qnil
),
2299 menu
= Fcons (prompt
, pane
);
2300 obj
= Fx_popup_dialog (Qt
, menu
);
2304 #endif /* HAVE_MENUS */
2307 args
[1] = build_string ("(yes or no) ");
2308 prompt
= Fconcat (2, args
);
2314 ans
= Fdowncase (Fread_from_minibuffer (prompt
, Qnil
, Qnil
, Qnil
,
2315 Qyes_or_no_p_history
, Qnil
,
2317 if (XSTRING (ans
)->size
== 3 && !strcmp (XSTRING (ans
)->data
, "yes"))
2322 if (XSTRING (ans
)->size
== 2 && !strcmp (XSTRING (ans
)->data
, "no"))
2330 message ("Please answer yes or no.");
2331 Fsleep_for (make_number (2), Qnil
);
2335 DEFUN ("load-average", Fload_average
, Sload_average
, 0, 0, 0,
2336 "Return list of 1 minute, 5 minute and 15 minute load averages.\n\
2337 Each of the three load averages is multiplied by 100,\n\
2338 then converted to integer.\n\
2339 If the 5-minute or 15-minute load averages are not available, return a\n\
2340 shortened list, containing only those averages which are available.")
2344 int loads
= getloadavg (load_ave
, 3);
2348 error ("load-average not implemented for this operating system");
2352 ret
= Fcons (make_number ((int) (load_ave
[--loads
] * 100.0)), ret
);
2357 Lisp_Object Vfeatures
;
2359 DEFUN ("featurep", Ffeaturep
, Sfeaturep
, 1, 1, 0,
2360 "Returns t if FEATURE is present in this Emacs.\n\
2361 Use this to conditionalize execution of lisp code based on the presence or\n\
2362 absence of emacs or environment extensions.\n\
2363 Use `provide' to declare that a feature is available.\n\
2364 This function looks at the value of the variable `features'.")
2366 Lisp_Object feature
;
2368 register Lisp_Object tem
;
2369 CHECK_SYMBOL (feature
, 0);
2370 tem
= Fmemq (feature
, Vfeatures
);
2371 return (NILP (tem
)) ? Qnil
: Qt
;
2374 DEFUN ("provide", Fprovide
, Sprovide
, 1, 1, 0,
2375 "Announce that FEATURE is a feature of the current Emacs.")
2377 Lisp_Object feature
;
2379 register Lisp_Object tem
;
2380 CHECK_SYMBOL (feature
, 0);
2381 if (!NILP (Vautoload_queue
))
2382 Vautoload_queue
= Fcons (Fcons (Vfeatures
, Qnil
), Vautoload_queue
);
2383 tem
= Fmemq (feature
, Vfeatures
);
2385 Vfeatures
= Fcons (feature
, Vfeatures
);
2386 LOADHIST_ATTACH (Fcons (Qprovide
, feature
));
2390 DEFUN ("require", Frequire
, Srequire
, 1, 2, 0,
2391 "If feature FEATURE is not loaded, load it from FILENAME.\n\
2392 If FEATURE is not a member of the list `features', then the feature\n\
2393 is not loaded; so load the file FILENAME.\n\
2394 If FILENAME is omitted, the printname of FEATURE is used as the file name.")
2395 (feature
, file_name
)
2396 Lisp_Object feature
, file_name
;
2398 register Lisp_Object tem
;
2399 CHECK_SYMBOL (feature
, 0);
2400 tem
= Fmemq (feature
, Vfeatures
);
2401 LOADHIST_ATTACH (Fcons (Qrequire
, feature
));
2404 int count
= specpdl_ptr
- specpdl
;
2406 /* Value saved here is to be restored into Vautoload_queue */
2407 record_unwind_protect (un_autoload
, Vautoload_queue
);
2408 Vautoload_queue
= Qt
;
2410 Fload (NILP (file_name
) ? Fsymbol_name (feature
) : file_name
,
2411 Qnil
, Qt
, Qnil
, (NILP (file_name
) ? Qt
: Qnil
));
2413 tem
= Fmemq (feature
, Vfeatures
);
2415 error ("Required feature %s was not provided",
2416 XSYMBOL (feature
)->name
->data
);
2418 /* Once loading finishes, don't undo it. */
2419 Vautoload_queue
= Qt
;
2420 feature
= unbind_to (count
, feature
);
2425 /* Primitives for work of the "widget" library.
2426 In an ideal world, this section would not have been necessary.
2427 However, lisp function calls being as slow as they are, it turns
2428 out that some functions in the widget library (wid-edit.el) are the
2429 bottleneck of Widget operation. Here is their translation to C,
2430 for the sole reason of efficiency. */
2432 DEFUN ("widget-plist-member", Fwidget_plist_member
, Swidget_plist_member
, 2, 2, 0,
2433 "Return non-nil if PLIST has the property PROP.\n\
2434 PLIST is a property list, which is a list of the form\n\
2435 \(PROP1 VALUE1 PROP2 VALUE2 ...\). PROP is a symbol.\n\
2436 Unlike `plist-get', this allows you to distinguish between a missing\n\
2437 property and a property with the value nil.\n\
2438 The value is actually the tail of PLIST whose car is PROP.")
2440 Lisp_Object plist
, prop
;
2442 while (CONSP (plist
) && !EQ (XCAR (plist
), prop
))
2445 plist
= XCDR (plist
);
2446 plist
= CDR (plist
);
2451 DEFUN ("widget-put", Fwidget_put
, Swidget_put
, 3, 3, 0,
2452 "In WIDGET, set PROPERTY to VALUE.\n\
2453 The value can later be retrieved with `widget-get'.")
2454 (widget
, property
, value
)
2455 Lisp_Object widget
, property
, value
;
2457 CHECK_CONS (widget
, 1);
2458 XCDR (widget
) = Fplist_put (XCDR (widget
), property
, value
);
2461 DEFUN ("widget-get", Fwidget_get
, Swidget_get
, 2, 2, 0,
2462 "In WIDGET, get the value of PROPERTY.\n\
2463 The value could either be specified when the widget was created, or\n\
2464 later with `widget-put'.")
2466 Lisp_Object widget
, property
;
2474 CHECK_CONS (widget
, 1);
2475 tmp
= Fwidget_plist_member (XCDR (widget
), property
);
2481 tmp
= XCAR (widget
);
2484 widget
= Fget (tmp
, Qwidget_type
);
2488 DEFUN ("widget-apply", Fwidget_apply
, Swidget_apply
, 2, MANY
, 0,
2489 "Apply the value of WIDGET's PROPERTY to the widget itself.\n\
2490 ARGS are passed as extra arguments to the function.")
2495 /* This function can GC. */
2496 Lisp_Object newargs
[3];
2497 struct gcpro gcpro1
, gcpro2
;
2500 newargs
[0] = Fwidget_get (args
[0], args
[1]);
2501 newargs
[1] = args
[0];
2502 newargs
[2] = Flist (nargs
- 2, args
+ 2);
2503 GCPRO2 (newargs
[0], newargs
[2]);
2504 result
= Fapply (3, newargs
);
2511 Qstring_lessp
= intern ("string-lessp");
2512 staticpro (&Qstring_lessp
);
2513 Qprovide
= intern ("provide");
2514 staticpro (&Qprovide
);
2515 Qrequire
= intern ("require");
2516 staticpro (&Qrequire
);
2517 Qyes_or_no_p_history
= intern ("yes-or-no-p-history");
2518 staticpro (&Qyes_or_no_p_history
);
2519 Qcursor_in_echo_area
= intern ("cursor-in-echo-area");
2520 staticpro (&Qcursor_in_echo_area
);
2521 Qwidget_type
= intern ("widget-type");
2522 staticpro (&Qwidget_type
);
2524 staticpro (&string_char_byte_cache_string
);
2525 string_char_byte_cache_string
= Qnil
;
2527 Fset (Qyes_or_no_p_history
, Qnil
);
2529 DEFVAR_LISP ("features", &Vfeatures
,
2530 "A list of symbols which are the features of the executing emacs.\n\
2531 Used by `featurep' and `require', and altered by `provide'.");
2534 DEFVAR_BOOL ("use-dialog-box", &use_dialog_box
,
2535 "*Non-nil means mouse commands use dialog boxes to ask questions.\n\
2536 This applies to y-or-n and yes-or-no questions asked by commands\n\
2537 invoked by mouse clicks and mouse menu items.");
2540 defsubr (&Sidentity
);
2543 defsubr (&Ssafe_length
);
2544 defsubr (&Sstring_equal
);
2545 defsubr (&Sstring_lessp
);
2548 defsubr (&Svconcat
);
2549 defsubr (&Scopy_sequence
);
2550 defsubr (&Sstring_make_multibyte
);
2551 defsubr (&Sstring_make_unibyte
);
2552 defsubr (&Sstring_as_multibyte
);
2553 defsubr (&Sstring_as_unibyte
);
2554 defsubr (&Scopy_alist
);
2555 defsubr (&Ssubstring
);
2567 defsubr (&Snreverse
);
2568 defsubr (&Sreverse
);
2570 defsubr (&Splist_get
);
2572 defsubr (&Splist_put
);
2575 defsubr (&Sfillarray
);
2576 defsubr (&Schar_table_subtype
);
2577 defsubr (&Schar_table_parent
);
2578 defsubr (&Sset_char_table_parent
);
2579 defsubr (&Schar_table_extra_slot
);
2580 defsubr (&Sset_char_table_extra_slot
);
2581 defsubr (&Schar_table_range
);
2582 defsubr (&Sset_char_table_range
);
2583 defsubr (&Sset_char_table_default
);
2584 defsubr (&Smap_char_table
);
2587 defsubr (&Smapconcat
);
2588 defsubr (&Sy_or_n_p
);
2589 defsubr (&Syes_or_no_p
);
2590 defsubr (&Sload_average
);
2591 defsubr (&Sfeaturep
);
2592 defsubr (&Srequire
);
2593 defsubr (&Sprovide
);
2594 defsubr (&Swidget_plist_member
);
2595 defsubr (&Swidget_put
);
2596 defsubr (&Swidget_get
);
2597 defsubr (&Swidget_apply
);