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
, (MIN_CHAR_COMPOSITION
129 + (CHAR_FIELD2_MASK
| CHAR_FIELD3_MASK
)
131 else if (BOOL_VECTOR_P (sequence
))
132 XSETFASTINT (val
, XBOOL_VECTOR (sequence
)->size
);
133 else if (COMPILEDP (sequence
))
134 XSETFASTINT (val
, XVECTOR (sequence
)->size
& PSEUDOVECTOR_SIZE_MASK
);
135 else if (CONSP (sequence
))
137 for (i
= 0, tail
= sequence
; !NILP (tail
); i
++)
143 XSETFASTINT (val
, i
);
145 else if (NILP (sequence
))
146 XSETFASTINT (val
, 0);
149 sequence
= wrong_type_argument (Qsequencep
, sequence
);
155 /* This does not check for quits. That is safe
156 since it must terminate. */
158 DEFUN ("safe-length", Fsafe_length
, Ssafe_length
, 1, 1, 0,
159 "Return the length of a list, but avoid error or infinite loop.\n\
160 This function never gets an error. If LIST is not really a list,\n\
161 it returns 0. If LIST is circular, it returns a finite value\n\
162 which is at least the number of distinct elements.")
166 Lisp_Object tail
, halftail
, length
;
169 /* halftail is used to detect circular lists. */
171 for (tail
= list
; CONSP (tail
); tail
= XCONS (tail
)->cdr
)
173 if (EQ (tail
, halftail
) && len
!= 0)
177 halftail
= XCONS (halftail
)->cdr
;
180 XSETINT (length
, len
);
184 DEFUN ("string-bytes", Fstring_bytes
, Sstring_bytes
, 1, 1, 0,
185 "Return the number of bytes in STRING.\n\
186 If STRING is a multibyte string, this is greater than the length of STRING.")
190 CHECK_STRING (string
, 1);
191 return make_number (XSTRING (string
)->size_byte
);
194 DEFUN ("string-equal", Fstring_equal
, Sstring_equal
, 2, 2, 0,
195 "Return t if two strings have identical contents.\n\
196 Case is significant, but text properties are ignored.\n\
197 Symbols are also allowed; their print names are used instead.")
199 register Lisp_Object s1
, s2
;
202 XSETSTRING (s1
, XSYMBOL (s1
)->name
);
204 XSETSTRING (s2
, XSYMBOL (s2
)->name
);
205 CHECK_STRING (s1
, 0);
206 CHECK_STRING (s2
, 1);
208 if (XSTRING (s1
)->size
!= XSTRING (s2
)->size
209 || XSTRING (s1
)->size_byte
!= XSTRING (s2
)->size_byte
210 || bcmp (XSTRING (s1
)->data
, XSTRING (s2
)->data
, XSTRING (s1
)->size_byte
))
215 DEFUN ("string-lessp", Fstring_lessp
, Sstring_lessp
, 2, 2, 0,
216 "Return t if first arg string is less than second in lexicographic order.\n\
217 Case is significant.\n\
218 Symbols are also allowed; their print names are used instead.")
220 register Lisp_Object s1
, s2
;
223 register int i1
, i1_byte
, i2
, i2_byte
;
226 XSETSTRING (s1
, XSYMBOL (s1
)->name
);
228 XSETSTRING (s2
, XSYMBOL (s2
)->name
);
229 CHECK_STRING (s1
, 0);
230 CHECK_STRING (s2
, 1);
232 i1
= i1_byte
= i2
= i2_byte
= 0;
234 end
= XSTRING (s1
)->size
;
235 if (end
> XSTRING (s2
)->size
)
236 end
= XSTRING (s2
)->size
;
240 /* When we find a mismatch, we must compare the
241 characters, not just the bytes. */
244 if (STRING_MULTIBYTE (s1
))
245 FETCH_STRING_CHAR_ADVANCE (c1
, s1
, i1
, i1_byte
);
247 c1
= XSTRING (s1
)->data
[i1
++];
249 if (STRING_MULTIBYTE (s2
))
250 FETCH_STRING_CHAR_ADVANCE (c2
, s2
, i2
, i2_byte
);
252 c2
= XSTRING (s2
)->data
[i2
++];
255 return c1
< c2
? Qt
: Qnil
;
257 return i1
< XSTRING (s2
)->size
? Qt
: Qnil
;
260 static Lisp_Object
concat ();
271 return concat (2, args
, Lisp_String
, 0);
273 return concat (2, &s1
, Lisp_String
, 0);
274 #endif /* NO_ARG_ARRAY */
280 Lisp_Object s1
, s2
, s3
;
287 return concat (3, args
, Lisp_String
, 0);
289 return concat (3, &s1
, Lisp_String
, 0);
290 #endif /* NO_ARG_ARRAY */
293 DEFUN ("append", Fappend
, Sappend
, 0, MANY
, 0,
294 "Concatenate all the arguments and make the result a list.\n\
295 The result is a list whose elements are the elements of all the arguments.\n\
296 Each argument may be a list, vector or string.\n\
297 The last argument is not copied, just used as the tail of the new list.")
302 return concat (nargs
, args
, Lisp_Cons
, 1);
305 DEFUN ("concat", Fconcat
, Sconcat
, 0, MANY
, 0,
306 "Concatenate all the arguments and make the result a string.\n\
307 The result is a string whose elements are the elements of all the arguments.\n\
308 Each argument may be a string or a list or vector of characters (integers).\n\
310 Do not use individual integers as arguments!\n\
311 The behavior of `concat' in that case will be changed later!\n\
312 If your program passes an integer as an argument to `concat',\n\
313 you should change it right away not to do so.")
318 return concat (nargs
, args
, Lisp_String
, 0);
321 DEFUN ("vconcat", Fvconcat
, Svconcat
, 0, MANY
, 0,
322 "Concatenate all the arguments and make the result a vector.\n\
323 The result is a vector whose elements are the elements of all the arguments.\n\
324 Each argument may be a list, vector or string.")
329 return concat (nargs
, args
, Lisp_Vectorlike
, 0);
332 /* Retrun a copy of a sub char table ARG. The elements except for a
333 nested sub char table are not copied. */
335 copy_sub_char_table (arg
)
338 Lisp_Object copy
= make_sub_char_table (XCHAR_TABLE (arg
)->defalt
);
341 /* Copy all the contents. */
342 bcopy (XCHAR_TABLE (arg
)->contents
, XCHAR_TABLE (copy
)->contents
,
343 SUB_CHAR_TABLE_ORDINARY_SLOTS
* sizeof (Lisp_Object
));
344 /* Recursively copy any sub char-tables in the ordinary slots. */
345 for (i
= 32; i
< SUB_CHAR_TABLE_ORDINARY_SLOTS
; i
++)
346 if (SUB_CHAR_TABLE_P (XCHAR_TABLE (arg
)->contents
[i
]))
347 XCHAR_TABLE (copy
)->contents
[i
]
348 = copy_sub_char_table (XCHAR_TABLE (copy
)->contents
[i
]);
354 DEFUN ("copy-sequence", Fcopy_sequence
, Scopy_sequence
, 1, 1, 0,
355 "Return a copy of a list, vector or string.\n\
356 The elements of a list or vector are not copied; they are shared\n\
361 if (NILP (arg
)) return arg
;
363 if (CHAR_TABLE_P (arg
))
368 copy
= Fmake_char_table (XCHAR_TABLE (arg
)->purpose
, Qnil
);
369 /* Copy all the slots, including the extra ones. */
370 bcopy (XVECTOR (arg
)->contents
, XVECTOR (copy
)->contents
,
371 ((XCHAR_TABLE (arg
)->size
& PSEUDOVECTOR_SIZE_MASK
)
372 * sizeof (Lisp_Object
)));
374 /* Recursively copy any sub char tables in the ordinary slots
375 for multibyte characters. */
376 for (i
= CHAR_TABLE_SINGLE_BYTE_SLOTS
;
377 i
< CHAR_TABLE_ORDINARY_SLOTS
; i
++)
378 if (SUB_CHAR_TABLE_P (XCHAR_TABLE (arg
)->contents
[i
]))
379 XCHAR_TABLE (copy
)->contents
[i
]
380 = copy_sub_char_table (XCHAR_TABLE (copy
)->contents
[i
]);
385 if (BOOL_VECTOR_P (arg
))
389 = (XBOOL_VECTOR (arg
)->size
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
;
391 val
= Fmake_bool_vector (Flength (arg
), Qnil
);
392 bcopy (XBOOL_VECTOR (arg
)->data
, XBOOL_VECTOR (val
)->data
,
397 if (!CONSP (arg
) && !VECTORP (arg
) && !STRINGP (arg
))
398 arg
= wrong_type_argument (Qsequencep
, arg
);
399 return concat (1, &arg
, CONSP (arg
) ? Lisp_Cons
: XTYPE (arg
), 0);
403 concat (nargs
, args
, target_type
, last_special
)
406 enum Lisp_Type target_type
;
410 register Lisp_Object tail
;
411 register Lisp_Object
this;
414 register int result_len
;
415 register int result_len_byte
;
417 Lisp_Object last_tail
;
421 /* In append, the last arg isn't treated like the others */
422 if (last_special
&& nargs
> 0)
425 last_tail
= args
[nargs
];
430 /* Canonicalize each argument. */
431 for (argnum
= 0; argnum
< nargs
; argnum
++)
434 if (!(CONSP (this) || NILP (this) || VECTORP (this) || STRINGP (this)
435 || COMPILEDP (this) || BOOL_VECTOR_P (this)))
438 args
[argnum
] = Fnumber_to_string (this);
440 args
[argnum
] = wrong_type_argument (Qsequencep
, this);
444 /* Compute total length in chars of arguments in RESULT_LEN.
445 If desired output is a string, also compute length in bytes
446 in RESULT_LEN_BYTE, and determine in SOME_MULTIBYTE
447 whether the result should be a multibyte string. */
451 for (argnum
= 0; argnum
< nargs
; argnum
++)
455 len
= XFASTINT (Flength (this));
456 if (target_type
== Lisp_String
)
458 /* We must count the number of bytes needed in the string
459 as well as the number of characters. */
465 for (i
= 0; i
< len
; i
++)
467 ch
= XVECTOR (this)->contents
[i
];
469 wrong_type_argument (Qintegerp
, ch
);
470 this_len_byte
= XFASTINT (Fchar_bytes (ch
));
471 result_len_byte
+= this_len_byte
;
472 if (this_len_byte
> 1)
475 else if (BOOL_VECTOR_P (this) && XBOOL_VECTOR (this)->size
> 0)
476 wrong_type_argument (Qintegerp
, Faref (this, make_number (0)));
477 else if (CONSP (this))
478 for (; CONSP (this); this = XCONS (this)->cdr
)
480 ch
= XCONS (this)->car
;
482 wrong_type_argument (Qintegerp
, ch
);
483 this_len_byte
= XFASTINT (Fchar_bytes (ch
));
484 result_len_byte
+= this_len_byte
;
485 if (this_len_byte
> 1)
488 else if (STRINGP (this))
490 if (STRING_MULTIBYTE (this))
493 result_len_byte
+= XSTRING (this)->size_byte
;
496 result_len_byte
+= count_size_as_multibyte (XSTRING (this)->data
,
497 XSTRING (this)->size
);
504 if (! some_multibyte
)
505 result_len_byte
= result_len
;
507 /* Create the output object. */
508 if (target_type
== Lisp_Cons
)
509 val
= Fmake_list (make_number (result_len
), Qnil
);
510 else if (target_type
== Lisp_Vectorlike
)
511 val
= Fmake_vector (make_number (result_len
), Qnil
);
513 val
= make_uninit_multibyte_string (result_len
, result_len_byte
);
515 /* In `append', if all but last arg are nil, return last arg. */
516 if (target_type
== Lisp_Cons
&& EQ (val
, Qnil
))
519 /* Copy the contents of the args into the result. */
521 tail
= val
, toindex
= -1; /* -1 in toindex is flag we are making a list */
523 toindex
= 0, toindex_byte
= 0;
527 for (argnum
= 0; argnum
< nargs
; argnum
++)
531 register unsigned int thisindex
= 0;
532 register unsigned int thisindex_byte
= 0;
536 thislen
= Flength (this), thisleni
= XINT (thislen
);
538 if (STRINGP (this) && STRINGP (val
)
539 && ! NULL_INTERVAL_P (XSTRING (this)->intervals
))
540 copy_text_properties (make_number (0), thislen
, this,
541 make_number (toindex
), val
, Qnil
);
543 /* Between strings of the same kind, copy fast. */
544 if (STRINGP (this) && STRINGP (val
)
545 && STRING_MULTIBYTE (this) == some_multibyte
)
547 int thislen_byte
= XSTRING (this)->size_byte
;
548 bcopy (XSTRING (this)->data
, XSTRING (val
)->data
+ toindex_byte
,
549 XSTRING (this)->size_byte
);
550 toindex_byte
+= thislen_byte
;
553 /* Copy a single-byte string to a multibyte string. */
554 else if (STRINGP (this) && STRINGP (val
))
556 toindex_byte
+= copy_text (XSTRING (this)->data
,
557 XSTRING (val
)->data
+ toindex_byte
,
558 XSTRING (this)->size
, 0, 1);
562 /* Copy element by element. */
565 register Lisp_Object elt
;
567 /* Fetch next element of `this' arg into `elt', or break if
568 `this' is exhausted. */
569 if (NILP (this)) break;
571 elt
= XCONS (this)->car
, this = XCONS (this)->cdr
;
572 else if (thisindex
>= thisleni
)
574 else if (STRINGP (this))
576 if (STRING_MULTIBYTE (this))
579 FETCH_STRING_CHAR_ADVANCE (c
, this,
582 XSETFASTINT (elt
, c
);
587 XSETFASTINT (elt
, XSTRING (this)->data
[thisindex
++]);
588 if (some_multibyte
&& XINT (elt
) >= 0200
589 && XINT (elt
) < 0400)
593 if (! NILP (Vnonascii_translate_table
))
594 c
= XINT (Faref (Vnonascii_translate_table
,
596 else if (nonascii_insert_offset
> 0)
597 c
+= nonascii_insert_offset
;
599 c
+= DEFAULT_NONASCII_INSERT_OFFSET
;
605 else if (BOOL_VECTOR_P (this))
608 byte
= XBOOL_VECTOR (this)->data
[thisindex
/ BITS_PER_CHAR
];
609 if (byte
& (1 << (thisindex
% BITS_PER_CHAR
)))
616 elt
= XVECTOR (this)->contents
[thisindex
++];
618 /* Store this element into the result. */
621 XCONS (tail
)->car
= elt
;
623 tail
= XCONS (tail
)->cdr
;
625 else if (VECTORP (val
))
626 XVECTOR (val
)->contents
[toindex
++] = elt
;
629 CHECK_NUMBER (elt
, 0);
630 if (SINGLE_BYTE_CHAR_P (XINT (elt
)))
632 XSTRING (val
)->data
[toindex
++] = XINT (elt
);
636 /* If we have any multibyte characters,
637 we already decided to make a multibyte string. */
640 unsigned char work
[4], *str
;
641 int i
= CHAR_STRING (c
, work
, str
);
643 /* P exists as a variable
644 to avoid a bug on the Masscomp C compiler. */
645 unsigned char *p
= & XSTRING (val
)->data
[toindex_byte
];
654 XCONS (prev
)->cdr
= last_tail
;
659 static Lisp_Object string_char_byte_cache_string
;
660 static int string_char_byte_cache_charpos
;
661 static int string_char_byte_cache_bytepos
;
663 /* Return the character index corresponding to CHAR_INDEX in STRING. */
666 string_char_to_byte (string
, char_index
)
671 int best_below
, best_below_byte
;
672 int best_above
, best_above_byte
;
674 if (! STRING_MULTIBYTE (string
))
677 best_below
= best_below_byte
= 0;
678 best_above
= XSTRING (string
)->size
;
679 best_above_byte
= XSTRING (string
)->size_byte
;
681 if (EQ (string
, string_char_byte_cache_string
))
683 if (string_char_byte_cache_charpos
< char_index
)
685 best_below
= string_char_byte_cache_charpos
;
686 best_below_byte
= string_char_byte_cache_bytepos
;
690 best_above
= string_char_byte_cache_charpos
;
691 best_above_byte
= string_char_byte_cache_bytepos
;
695 if (char_index
- best_below
< best_above
- char_index
)
697 while (best_below
< char_index
)
700 FETCH_STRING_CHAR_ADVANCE (c
, string
, best_below
, best_below_byte
);
703 i_byte
= best_below_byte
;
707 while (best_above
> char_index
)
709 int best_above_byte_saved
= --best_above_byte
;
711 while (best_above_byte
> 0
712 && !CHAR_HEAD_P (XSTRING (string
)->data
[best_above_byte
]))
714 if (XSTRING (string
)->data
[best_above_byte
] < 0x80)
715 best_above_byte
= best_above_byte_saved
;
719 i_byte
= best_above_byte
;
722 string_char_byte_cache_bytepos
= i_byte
;
723 string_char_byte_cache_charpos
= i
;
724 string_char_byte_cache_string
= string
;
729 /* Return the character index corresponding to BYTE_INDEX in STRING. */
732 string_byte_to_char (string
, byte_index
)
737 int best_below
, best_below_byte
;
738 int best_above
, best_above_byte
;
740 if (! STRING_MULTIBYTE (string
))
743 best_below
= best_below_byte
= 0;
744 best_above
= XSTRING (string
)->size
;
745 best_above_byte
= XSTRING (string
)->size_byte
;
747 if (EQ (string
, string_char_byte_cache_string
))
749 if (string_char_byte_cache_bytepos
< byte_index
)
751 best_below
= string_char_byte_cache_charpos
;
752 best_below_byte
= string_char_byte_cache_bytepos
;
756 best_above
= string_char_byte_cache_charpos
;
757 best_above_byte
= string_char_byte_cache_bytepos
;
761 if (byte_index
- best_below_byte
< best_above_byte
- byte_index
)
763 while (best_below_byte
< byte_index
)
766 FETCH_STRING_CHAR_ADVANCE (c
, string
, best_below
, best_below_byte
);
769 i_byte
= best_below_byte
;
773 while (best_above_byte
> byte_index
)
775 int best_above_byte_saved
= --best_above_byte
;
777 while (best_above_byte
> 0
778 && !CHAR_HEAD_P (XSTRING (string
)->data
[best_above_byte
]))
780 if (XSTRING (string
)->data
[best_above_byte
] < 0x80)
781 best_above_byte
= best_above_byte_saved
;
785 i_byte
= best_above_byte
;
788 string_char_byte_cache_bytepos
= i_byte
;
789 string_char_byte_cache_charpos
= i
;
790 string_char_byte_cache_string
= string
;
795 /* Convert STRING to a multibyte string.
796 Single-byte characters 0200 through 0377 are converted
797 by adding nonascii_insert_offset to each. */
800 string_make_multibyte (string
)
806 if (STRING_MULTIBYTE (string
))
809 nbytes
= count_size_as_multibyte (XSTRING (string
)->data
,
810 XSTRING (string
)->size
);
811 /* If all the chars are ASCII, they won't need any more bytes
812 once converted. In that case, we can return STRING itself. */
813 if (nbytes
== XSTRING (string
)->size_byte
)
816 buf
= (unsigned char *) alloca (nbytes
);
817 copy_text (XSTRING (string
)->data
, buf
, XSTRING (string
)->size_byte
,
820 return make_multibyte_string (buf
, XSTRING (string
)->size
, nbytes
);
823 /* Convert STRING to a single-byte string. */
826 string_make_unibyte (string
)
831 if (! STRING_MULTIBYTE (string
))
834 buf
= (unsigned char *) alloca (XSTRING (string
)->size
);
836 copy_text (XSTRING (string
)->data
, buf
, XSTRING (string
)->size_byte
,
839 return make_unibyte_string (buf
, XSTRING (string
)->size
);
842 DEFUN ("string-make-multibyte", Fstring_make_multibyte
, Sstring_make_multibyte
,
844 "Return the multibyte equivalent of STRING.")
848 return string_make_multibyte (string
);
851 DEFUN ("string-make-unibyte", Fstring_make_unibyte
, Sstring_make_unibyte
,
853 "Return the unibyte equivalent of STRING.")
857 return string_make_unibyte (string
);
860 DEFUN ("string-as-unibyte", Fstring_as_unibyte
, Sstring_as_unibyte
,
862 "Return a unibyte string with the same individual bytes as STRING.\n\
863 If STRING is unibyte, the result is STRING itself.")
867 if (STRING_MULTIBYTE (string
))
869 string
= Fcopy_sequence (string
);
870 XSTRING (string
)->size
= XSTRING (string
)->size_byte
;
875 DEFUN ("string-as-multibyte", Fstring_as_multibyte
, Sstring_as_multibyte
,
877 "Return a multibyte string with the same individual bytes as STRING.\n\
878 If STRING is multibyte, the result is STRING itself.")
882 if (! STRING_MULTIBYTE (string
))
884 int newlen
= chars_in_text (XSTRING (string
)->data
,
885 XSTRING (string
)->size_byte
);
886 /* If all the chars are ASCII, STRING is already suitable. */
887 if (newlen
!= XSTRING (string
)->size_byte
)
889 string
= Fcopy_sequence (string
);
890 XSTRING (string
)->size
= newlen
;
896 DEFUN ("copy-alist", Fcopy_alist
, Scopy_alist
, 1, 1, 0,
897 "Return a copy of ALIST.\n\
898 This is an alist which represents the same mapping from objects to objects,\n\
899 but does not share the alist structure with ALIST.\n\
900 The objects mapped (cars and cdrs of elements of the alist)\n\
901 are shared, however.\n\
902 Elements of ALIST that are not conses are also shared.")
906 register Lisp_Object tem
;
908 CHECK_LIST (alist
, 0);
911 alist
= concat (1, &alist
, Lisp_Cons
, 0);
912 for (tem
= alist
; CONSP (tem
); tem
= XCONS (tem
)->cdr
)
914 register Lisp_Object car
;
915 car
= XCONS (tem
)->car
;
918 XCONS (tem
)->car
= Fcons (XCONS (car
)->car
, XCONS (car
)->cdr
);
923 DEFUN ("substring", Fsubstring
, Ssubstring
, 2, 3, 0,
924 "Return a substring of STRING, starting at index FROM and ending before TO.\n\
925 TO may be nil or omitted; then the substring runs to the end of STRING.\n\
926 If FROM or TO is negative, it counts from the end.\n\
928 This function allows vectors as well as strings.")
931 register Lisp_Object from
, to
;
936 int from_char
, to_char
;
937 int from_byte
, to_byte
;
939 if (! (STRINGP (string
) || VECTORP (string
)))
940 wrong_type_argument (Qarrayp
, string
);
942 CHECK_NUMBER (from
, 1);
944 if (STRINGP (string
))
946 size
= XSTRING (string
)->size
;
947 size_byte
= XSTRING (string
)->size_byte
;
950 size
= XVECTOR (string
)->size
;
959 CHECK_NUMBER (to
, 2);
965 if (STRINGP (string
))
966 to_byte
= string_char_to_byte (string
, to_char
);
969 from_char
= XINT (from
);
972 if (STRINGP (string
))
973 from_byte
= string_char_to_byte (string
, from_char
);
975 if (!(0 <= from_char
&& from_char
<= to_char
&& to_char
<= size
))
976 args_out_of_range_3 (string
, make_number (from_char
),
977 make_number (to_char
));
979 if (STRINGP (string
))
981 res
= make_multibyte_string (XSTRING (string
)->data
+ from_byte
,
982 to_char
- from_char
, to_byte
- from_byte
);
983 copy_text_properties (from_char
, to_char
, string
,
984 make_number (0), res
, Qnil
);
987 res
= Fvector (to_char
- from_char
,
988 XVECTOR (string
)->contents
+ from_char
);
993 /* Extract a substring of STRING, giving start and end positions
994 both in characters and in bytes. */
997 substring_both (string
, from
, from_byte
, to
, to_byte
)
999 int from
, from_byte
, to
, to_byte
;
1005 if (! (STRINGP (string
) || VECTORP (string
)))
1006 wrong_type_argument (Qarrayp
, string
);
1008 if (STRINGP (string
))
1010 size
= XSTRING (string
)->size
;
1011 size_byte
= XSTRING (string
)->size_byte
;
1014 size
= XVECTOR (string
)->size
;
1016 if (!(0 <= from
&& from
<= to
&& to
<= size
))
1017 args_out_of_range_3 (string
, make_number (from
), make_number (to
));
1019 if (STRINGP (string
))
1021 res
= make_multibyte_string (XSTRING (string
)->data
+ from_byte
,
1022 to
- from
, to_byte
- from_byte
);
1023 copy_text_properties (from
, to
, string
, make_number (0), res
, Qnil
);
1026 res
= Fvector (to
- from
,
1027 XVECTOR (string
)->contents
+ from
);
1032 DEFUN ("nthcdr", Fnthcdr
, Snthcdr
, 2, 2, 0,
1033 "Take cdr N times on LIST, returns the result.")
1036 register Lisp_Object list
;
1038 register int i
, num
;
1039 CHECK_NUMBER (n
, 0);
1041 for (i
= 0; i
< num
&& !NILP (list
); i
++)
1049 DEFUN ("nth", Fnth
, Snth
, 2, 2, 0,
1050 "Return the Nth element of LIST.\n\
1051 N counts from zero. If LIST is not that long, nil is returned.")
1053 Lisp_Object n
, list
;
1055 return Fcar (Fnthcdr (n
, list
));
1058 DEFUN ("elt", Felt
, Selt
, 2, 2, 0,
1059 "Return element of SEQUENCE at index N.")
1061 register Lisp_Object sequence
, n
;
1063 CHECK_NUMBER (n
, 0);
1066 if (CONSP (sequence
) || NILP (sequence
))
1067 return Fcar (Fnthcdr (n
, sequence
));
1068 else if (STRINGP (sequence
) || VECTORP (sequence
)
1069 || BOOL_VECTOR_P (sequence
) || CHAR_TABLE_P (sequence
))
1070 return Faref (sequence
, n
);
1072 sequence
= wrong_type_argument (Qsequencep
, sequence
);
1076 DEFUN ("member", Fmember
, Smember
, 2, 2, 0,
1077 "Return non-nil if ELT is an element of LIST. Comparison done with `equal'.\n\
1078 The value is actually the tail of LIST whose car is ELT.")
1080 register Lisp_Object elt
;
1083 register Lisp_Object tail
;
1084 for (tail
= list
; !NILP (tail
); tail
= XCONS (tail
)->cdr
)
1086 register Lisp_Object tem
;
1088 if (! NILP (Fequal (elt
, tem
)))
1095 DEFUN ("memq", Fmemq
, Smemq
, 2, 2, 0,
1096 "Return non-nil if ELT is an element of LIST. Comparison done with EQ.\n\
1097 The value is actually the tail of LIST whose car is ELT.")
1099 register Lisp_Object elt
;
1102 register Lisp_Object tail
;
1103 for (tail
= list
; !NILP (tail
); tail
= XCONS (tail
)->cdr
)
1105 register Lisp_Object tem
;
1107 if (EQ (elt
, tem
)) return tail
;
1113 DEFUN ("assq", Fassq
, Sassq
, 2, 2, 0,
1114 "Return non-nil if KEY is `eq' to the car of an element of LIST.\n\
1115 The value is actually the element of LIST whose car is KEY.\n\
1116 Elements of LIST that are not conses are ignored.")
1118 register Lisp_Object key
;
1121 register Lisp_Object tail
;
1122 for (tail
= list
; !NILP (tail
); tail
= XCONS (tail
)->cdr
)
1124 register Lisp_Object elt
, tem
;
1126 if (!CONSP (elt
)) continue;
1127 tem
= XCONS (elt
)->car
;
1128 if (EQ (key
, tem
)) return elt
;
1134 /* Like Fassq but never report an error and do not allow quits.
1135 Use only on lists known never to be circular. */
1138 assq_no_quit (key
, list
)
1139 register Lisp_Object key
;
1142 register Lisp_Object tail
;
1143 for (tail
= list
; CONSP (tail
); tail
= XCONS (tail
)->cdr
)
1145 register Lisp_Object elt
, tem
;
1147 if (!CONSP (elt
)) continue;
1148 tem
= XCONS (elt
)->car
;
1149 if (EQ (key
, tem
)) return elt
;
1154 DEFUN ("assoc", Fassoc
, Sassoc
, 2, 2, 0,
1155 "Return non-nil if KEY is `equal' to the car of an element of LIST.\n\
1156 The value is actually the element of LIST whose car equals KEY.")
1158 register Lisp_Object key
;
1161 register Lisp_Object tail
;
1162 for (tail
= list
; !NILP (tail
); tail
= XCONS (tail
)->cdr
)
1164 register Lisp_Object elt
, tem
;
1166 if (!CONSP (elt
)) continue;
1167 tem
= Fequal (XCONS (elt
)->car
, key
);
1168 if (!NILP (tem
)) return elt
;
1174 DEFUN ("rassq", Frassq
, Srassq
, 2, 2, 0,
1175 "Return non-nil if ELT is `eq' to the cdr of an element of LIST.\n\
1176 The value is actually the element of LIST whose cdr is ELT.")
1178 register Lisp_Object key
;
1181 register Lisp_Object tail
;
1182 for (tail
= list
; !NILP (tail
); tail
= XCONS (tail
)->cdr
)
1184 register Lisp_Object elt
, tem
;
1186 if (!CONSP (elt
)) continue;
1187 tem
= XCONS (elt
)->cdr
;
1188 if (EQ (key
, tem
)) return elt
;
1194 DEFUN ("rassoc", Frassoc
, Srassoc
, 2, 2, 0,
1195 "Return non-nil if KEY is `equal' to the cdr of an element of LIST.\n\
1196 The value is actually the element of LIST whose cdr equals KEY.")
1198 register Lisp_Object key
;
1201 register Lisp_Object tail
;
1202 for (tail
= list
; !NILP (tail
); tail
= XCONS (tail
)->cdr
)
1204 register Lisp_Object elt
, tem
;
1206 if (!CONSP (elt
)) continue;
1207 tem
= Fequal (XCONS (elt
)->cdr
, key
);
1208 if (!NILP (tem
)) return elt
;
1214 DEFUN ("delq", Fdelq
, Sdelq
, 2, 2, 0,
1215 "Delete by side effect any occurrences of ELT as a member of LIST.\n\
1216 The modified LIST is returned. Comparison is done with `eq'.\n\
1217 If the first member of LIST is ELT, there is no way to remove it by side effect;\n\
1218 therefore, write `(setq foo (delq element foo))'\n\
1219 to be sure of changing the value of `foo'.")
1221 register Lisp_Object elt
;
1224 register Lisp_Object tail
, prev
;
1225 register Lisp_Object tem
;
1229 while (!NILP (tail
))
1235 list
= XCONS (tail
)->cdr
;
1237 Fsetcdr (prev
, XCONS (tail
)->cdr
);
1241 tail
= XCONS (tail
)->cdr
;
1247 DEFUN ("delete", Fdelete
, Sdelete
, 2, 2, 0,
1248 "Delete by side effect any occurrences of ELT as a member of LIST.\n\
1249 The modified LIST is returned. Comparison is done with `equal'.\n\
1250 If the first member of LIST is ELT, deleting it is not a side effect;\n\
1251 it is simply using a different list.\n\
1252 Therefore, write `(setq foo (delete element foo))'\n\
1253 to be sure of changing the value of `foo'.")
1255 register Lisp_Object elt
;
1258 register Lisp_Object tail
, prev
;
1259 register Lisp_Object tem
;
1263 while (!NILP (tail
))
1266 if (! NILP (Fequal (elt
, tem
)))
1269 list
= XCONS (tail
)->cdr
;
1271 Fsetcdr (prev
, XCONS (tail
)->cdr
);
1275 tail
= XCONS (tail
)->cdr
;
1281 DEFUN ("nreverse", Fnreverse
, Snreverse
, 1, 1, 0,
1282 "Reverse LIST by modifying cdr pointers.\n\
1283 Returns the beginning of the reversed list.")
1287 register Lisp_Object prev
, tail
, next
;
1289 if (NILP (list
)) return list
;
1292 while (!NILP (tail
))
1296 Fsetcdr (tail
, prev
);
1303 DEFUN ("reverse", Freverse
, Sreverse
, 1, 1, 0,
1304 "Reverse LIST, copying. Returns the beginning of the reversed list.\n\
1305 See also the function `nreverse', which is used more often.")
1311 for (new = Qnil
; CONSP (list
); list
= XCONS (list
)->cdr
)
1312 new = Fcons (XCONS (list
)->car
, new);
1314 wrong_type_argument (Qconsp
, list
);
1318 Lisp_Object
merge ();
1320 DEFUN ("sort", Fsort
, Ssort
, 2, 2, 0,
1321 "Sort LIST, stably, comparing elements using PREDICATE.\n\
1322 Returns the sorted list. LIST is modified by side effects.\n\
1323 PREDICATE is called with two elements of LIST, and should return T\n\
1324 if the first element is \"less\" than the second.")
1326 Lisp_Object list
, predicate
;
1328 Lisp_Object front
, back
;
1329 register Lisp_Object len
, tem
;
1330 struct gcpro gcpro1
, gcpro2
;
1331 register int length
;
1334 len
= Flength (list
);
1335 length
= XINT (len
);
1339 XSETINT (len
, (length
/ 2) - 1);
1340 tem
= Fnthcdr (len
, list
);
1342 Fsetcdr (tem
, Qnil
);
1344 GCPRO2 (front
, back
);
1345 front
= Fsort (front
, predicate
);
1346 back
= Fsort (back
, predicate
);
1348 return merge (front
, back
, predicate
);
1352 merge (org_l1
, org_l2
, pred
)
1353 Lisp_Object org_l1
, org_l2
;
1357 register Lisp_Object tail
;
1359 register Lisp_Object l1
, l2
;
1360 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
1367 /* It is sufficient to protect org_l1 and org_l2.
1368 When l1 and l2 are updated, we copy the new values
1369 back into the org_ vars. */
1370 GCPRO4 (org_l1
, org_l2
, pred
, value
);
1390 tem
= call2 (pred
, Fcar (l2
), Fcar (l1
));
1406 Fsetcdr (tail
, tem
);
1412 DEFUN ("plist-get", Fplist_get
, Splist_get
, 2, 2, 0,
1413 "Extract a value from a property list.\n\
1414 PLIST is a property list, which is a list of the form\n\
1415 \(PROP1 VALUE1 PROP2 VALUE2...). This function returns the value\n\
1416 corresponding to the given PROP, or nil if PROP is not\n\
1417 one of the properties on the list.")
1420 register Lisp_Object prop
;
1422 register Lisp_Object tail
;
1423 for (tail
= plist
; !NILP (tail
); tail
= Fcdr (XCONS (tail
)->cdr
))
1425 register Lisp_Object tem
;
1428 return Fcar (XCONS (tail
)->cdr
);
1433 DEFUN ("get", Fget
, Sget
, 2, 2, 0,
1434 "Return the value of SYMBOL's PROPNAME property.\n\
1435 This is the last value stored with `(put SYMBOL PROPNAME VALUE)'.")
1437 Lisp_Object symbol
, propname
;
1439 CHECK_SYMBOL (symbol
, 0);
1440 return Fplist_get (XSYMBOL (symbol
)->plist
, propname
);
1443 DEFUN ("plist-put", Fplist_put
, Splist_put
, 3, 3, 0,
1444 "Change value in PLIST of PROP to VAL.\n\
1445 PLIST is a property list, which is a list of the form\n\
1446 \(PROP1 VALUE1 PROP2 VALUE2 ...). PROP is a symbol and VAL is any object.\n\
1447 If PROP is already a property on the list, its value is set to VAL,\n\
1448 otherwise the new PROP VAL pair is added. The new plist is returned;\n\
1449 use `(setq x (plist-put x prop val))' to be sure to use the new value.\n\
1450 The PLIST is modified by side effects.")
1453 register Lisp_Object prop
;
1456 register Lisp_Object tail
, prev
;
1457 Lisp_Object newcell
;
1459 for (tail
= plist
; CONSP (tail
) && CONSP (XCONS (tail
)->cdr
);
1460 tail
= XCONS (XCONS (tail
)->cdr
)->cdr
)
1462 if (EQ (prop
, XCONS (tail
)->car
))
1464 Fsetcar (XCONS (tail
)->cdr
, val
);
1469 newcell
= Fcons (prop
, Fcons (val
, Qnil
));
1473 Fsetcdr (XCONS (prev
)->cdr
, newcell
);
1477 DEFUN ("put", Fput
, Sput
, 3, 3, 0,
1478 "Store SYMBOL's PROPNAME property with value VALUE.\n\
1479 It can be retrieved with `(get SYMBOL PROPNAME)'.")
1480 (symbol
, propname
, value
)
1481 Lisp_Object symbol
, propname
, value
;
1483 CHECK_SYMBOL (symbol
, 0);
1484 XSYMBOL (symbol
)->plist
1485 = Fplist_put (XSYMBOL (symbol
)->plist
, propname
, value
);
1489 DEFUN ("equal", Fequal
, Sequal
, 2, 2, 0,
1490 "Return t if two Lisp objects have similar structure and contents.\n\
1491 They must have the same data type.\n\
1492 Conses are compared by comparing the cars and the cdrs.\n\
1493 Vectors and strings are compared element by element.\n\
1494 Numbers are compared by value, but integers cannot equal floats.\n\
1495 (Use `=' if you want integers and floats to be able to be equal.)\n\
1496 Symbols must match exactly.")
1498 register Lisp_Object o1
, o2
;
1500 return internal_equal (o1
, o2
, 0) ? Qt
: Qnil
;
1504 internal_equal (o1
, o2
, depth
)
1505 register Lisp_Object o1
, o2
;
1509 error ("Stack overflow in equal");
1515 if (XTYPE (o1
) != XTYPE (o2
))
1520 #ifdef LISP_FLOAT_TYPE
1522 return (extract_float (o1
) == extract_float (o2
));
1526 if (!internal_equal (XCONS (o1
)->car
, XCONS (o2
)->car
, depth
+ 1))
1528 o1
= XCONS (o1
)->cdr
;
1529 o2
= XCONS (o2
)->cdr
;
1533 if (XMISCTYPE (o1
) != XMISCTYPE (o2
))
1537 if (!internal_equal (OVERLAY_START (o1
), OVERLAY_START (o1
),
1539 || !internal_equal (OVERLAY_END (o1
), OVERLAY_END (o1
),
1542 o1
= XOVERLAY (o1
)->plist
;
1543 o2
= XOVERLAY (o2
)->plist
;
1548 return (XMARKER (o1
)->buffer
== XMARKER (o2
)->buffer
1549 && (XMARKER (o1
)->buffer
== 0
1550 || XMARKER (o1
)->bytepos
== XMARKER (o2
)->bytepos
));
1554 case Lisp_Vectorlike
:
1556 register int i
, size
;
1557 size
= XVECTOR (o1
)->size
;
1558 /* Pseudovectors have the type encoded in the size field, so this test
1559 actually checks that the objects have the same type as well as the
1561 if (XVECTOR (o2
)->size
!= size
)
1563 /* Boolvectors are compared much like strings. */
1564 if (BOOL_VECTOR_P (o1
))
1567 = (XBOOL_VECTOR (o1
)->size
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
;
1569 if (XBOOL_VECTOR (o1
)->size
!= XBOOL_VECTOR (o2
)->size
)
1571 if (bcmp (XBOOL_VECTOR (o1
)->data
, XBOOL_VECTOR (o2
)->data
,
1576 if (WINDOW_CONFIGURATIONP (o1
))
1577 return compare_window_configurations (o1
, o2
, 0);
1579 /* Aside from them, only true vectors, char-tables, and compiled
1580 functions are sensible to compare, so eliminate the others now. */
1581 if (size
& PSEUDOVECTOR_FLAG
)
1583 if (!(size
& (PVEC_COMPILED
| PVEC_CHAR_TABLE
)))
1585 size
&= PSEUDOVECTOR_SIZE_MASK
;
1587 for (i
= 0; i
< size
; i
++)
1590 v1
= XVECTOR (o1
)->contents
[i
];
1591 v2
= XVECTOR (o2
)->contents
[i
];
1592 if (!internal_equal (v1
, v2
, depth
+ 1))
1600 if (XSTRING (o1
)->size
!= XSTRING (o2
)->size
)
1602 if (XSTRING (o1
)->size_byte
!= XSTRING (o2
)->size_byte
)
1604 if (bcmp (XSTRING (o1
)->data
, XSTRING (o2
)->data
,
1605 XSTRING (o1
)->size_byte
))
1612 extern Lisp_Object
Fmake_char_internal ();
1614 DEFUN ("fillarray", Ffillarray
, Sfillarray
, 2, 2, 0,
1615 "Store each element of ARRAY with ITEM.\n\
1616 ARRAY is a vector, string, char-table, or bool-vector.")
1618 Lisp_Object array
, item
;
1620 register int size
, index
, charval
;
1622 if (VECTORP (array
))
1624 register Lisp_Object
*p
= XVECTOR (array
)->contents
;
1625 size
= XVECTOR (array
)->size
;
1626 for (index
= 0; index
< size
; index
++)
1629 else if (CHAR_TABLE_P (array
))
1631 register Lisp_Object
*p
= XCHAR_TABLE (array
)->contents
;
1632 size
= CHAR_TABLE_ORDINARY_SLOTS
;
1633 for (index
= 0; index
< size
; index
++)
1635 XCHAR_TABLE (array
)->defalt
= Qnil
;
1637 else if (STRINGP (array
))
1639 register unsigned char *p
= XSTRING (array
)->data
;
1640 CHECK_NUMBER (item
, 1);
1641 charval
= XINT (item
);
1642 size
= XSTRING (array
)->size
;
1643 for (index
= 0; index
< size
; index
++)
1646 else if (BOOL_VECTOR_P (array
))
1648 register unsigned char *p
= XBOOL_VECTOR (array
)->data
;
1650 = (XBOOL_VECTOR (array
)->size
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
;
1652 charval
= (! NILP (item
) ? -1 : 0);
1653 for (index
= 0; index
< size_in_chars
; index
++)
1658 array
= wrong_type_argument (Qarrayp
, array
);
1664 DEFUN ("char-table-subtype", Fchar_table_subtype
, Schar_table_subtype
,
1666 "Return the subtype of char-table CHAR-TABLE. The value is a symbol.")
1668 Lisp_Object char_table
;
1670 CHECK_CHAR_TABLE (char_table
, 0);
1672 return XCHAR_TABLE (char_table
)->purpose
;
1675 DEFUN ("char-table-parent", Fchar_table_parent
, Schar_table_parent
,
1677 "Return the parent char-table of CHAR-TABLE.\n\
1678 The value is either nil or another char-table.\n\
1679 If CHAR-TABLE holds nil for a given character,\n\
1680 then the actual applicable value is inherited from the parent char-table\n\
1681 \(or from its parents, if necessary).")
1683 Lisp_Object char_table
;
1685 CHECK_CHAR_TABLE (char_table
, 0);
1687 return XCHAR_TABLE (char_table
)->parent
;
1690 DEFUN ("set-char-table-parent", Fset_char_table_parent
, Sset_char_table_parent
,
1692 "Set the parent char-table of CHAR-TABLE to PARENT.\n\
1693 PARENT must be either nil or another char-table.")
1694 (char_table
, parent
)
1695 Lisp_Object char_table
, parent
;
1699 CHECK_CHAR_TABLE (char_table
, 0);
1703 CHECK_CHAR_TABLE (parent
, 0);
1705 for (temp
= parent
; !NILP (temp
); temp
= XCHAR_TABLE (temp
)->parent
)
1706 if (EQ (temp
, char_table
))
1707 error ("Attempt to make a chartable be its own parent");
1710 XCHAR_TABLE (char_table
)->parent
= parent
;
1715 DEFUN ("char-table-extra-slot", Fchar_table_extra_slot
, Schar_table_extra_slot
,
1717 "Return the value of CHAR-TABLE's extra-slot number N.")
1719 Lisp_Object char_table
, n
;
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
)];
1730 DEFUN ("set-char-table-extra-slot", Fset_char_table_extra_slot
,
1731 Sset_char_table_extra_slot
,
1733 "Set CHAR-TABLE's extra-slot number N to VALUE.")
1734 (char_table
, n
, value
)
1735 Lisp_Object char_table
, n
, value
;
1737 CHECK_CHAR_TABLE (char_table
, 1);
1738 CHECK_NUMBER (n
, 2);
1740 || XINT (n
) >= CHAR_TABLE_EXTRA_SLOTS (XCHAR_TABLE (char_table
)))
1741 args_out_of_range (char_table
, n
);
1743 return XCHAR_TABLE (char_table
)->extras
[XINT (n
)] = value
;
1746 DEFUN ("char-table-range", Fchar_table_range
, Schar_table_range
,
1748 "Return the value in CHAR-TABLE for a range of characters RANGE.\n\
1749 RANGE should be nil (for the default value)\n\
1750 a vector which identifies a character set or a row of a character set,\n\
1751 a character set name, or a character code.")
1753 Lisp_Object char_table
, range
;
1757 CHECK_CHAR_TABLE (char_table
, 0);
1759 if (EQ (range
, Qnil
))
1760 return XCHAR_TABLE (char_table
)->defalt
;
1761 else if (INTEGERP (range
))
1762 return Faref (char_table
, range
);
1763 else if (SYMBOLP (range
))
1765 Lisp_Object charset_info
;
1767 charset_info
= Fget (range
, Qcharset
);
1768 CHECK_VECTOR (charset_info
, 0);
1770 return Faref (char_table
, XVECTOR (charset_info
)->contents
[0] + 128);
1772 else if (VECTORP (range
))
1774 if (XVECTOR (range
)->size
== 1)
1775 return Faref (char_table
, XVECTOR (range
)->contents
[0] + 128);
1778 int size
= XVECTOR (range
)->size
;
1779 Lisp_Object
*val
= XVECTOR (range
)->contents
;
1780 Lisp_Object ch
= Fmake_char_internal (size
<= 0 ? Qnil
: val
[0],
1781 size
<= 1 ? Qnil
: val
[1],
1782 size
<= 2 ? Qnil
: val
[2]);
1783 return Faref (char_table
, ch
);
1787 error ("Invalid RANGE argument to `char-table-range'");
1790 DEFUN ("set-char-table-range", Fset_char_table_range
, Sset_char_table_range
,
1792 "Set the value in CHAR-TABLE for a range of characters RANGE to VALUE.\n\
1793 RANGE should be t (for all characters), nil (for the default value)\n\
1794 a vector which identifies a character set or a row of a character set,\n\
1795 a coding system, or a character code.")
1796 (char_table
, range
, value
)
1797 Lisp_Object char_table
, range
, value
;
1801 CHECK_CHAR_TABLE (char_table
, 0);
1804 for (i
= 0; i
< CHAR_TABLE_ORDINARY_SLOTS
; i
++)
1805 XCHAR_TABLE (char_table
)->contents
[i
] = value
;
1806 else if (EQ (range
, Qnil
))
1807 XCHAR_TABLE (char_table
)->defalt
= value
;
1808 else if (SYMBOLP (range
))
1810 Lisp_Object charset_info
;
1812 charset_info
= Fget (range
, Qcharset
);
1813 CHECK_VECTOR (charset_info
, 0);
1815 return Faset (char_table
, XVECTOR (charset_info
)->contents
[0] + 128,
1818 else if (INTEGERP (range
))
1819 Faset (char_table
, range
, value
);
1820 else if (VECTORP (range
))
1822 if (XVECTOR (range
)->size
== 1)
1823 return Faset (char_table
, XVECTOR (range
)->contents
[0] + 128, value
);
1826 int size
= XVECTOR (range
)->size
;
1827 Lisp_Object
*val
= XVECTOR (range
)->contents
;
1828 Lisp_Object ch
= Fmake_char_internal (size
<= 0 ? Qnil
: val
[0],
1829 size
<= 1 ? Qnil
: val
[1],
1830 size
<= 2 ? Qnil
: val
[2]);
1831 return Faset (char_table
, ch
, value
);
1835 error ("Invalid RANGE argument to `set-char-table-range'");
1840 DEFUN ("set-char-table-default", Fset_char_table_default
,
1841 Sset_char_table_default
, 3, 3, 0,
1842 "Set the default value in CHAR-TABLE for a generic character CHAR to VALUE.\n\
1843 The generic character specifies the group of characters.\n\
1844 See also the documentation of make-char.")
1845 (char_table
, ch
, value
)
1846 Lisp_Object char_table
, ch
, value
;
1848 int c
, i
, charset
, code1
, code2
;
1851 CHECK_CHAR_TABLE (char_table
, 0);
1852 CHECK_NUMBER (ch
, 1);
1855 SPLIT_NON_ASCII_CHAR (c
, charset
, code1
, code2
);
1856 if (! CHARSET_DEFINED_P (charset
))
1857 invalid_character (c
);
1859 if (charset
== CHARSET_ASCII
)
1860 return (XCHAR_TABLE (char_table
)->defalt
= value
);
1862 /* Even if C is not a generic char, we had better behave as if a
1863 generic char is specified. */
1864 if (CHARSET_DIMENSION (charset
) == 1)
1866 temp
= XCHAR_TABLE (char_table
)->contents
[charset
+ 128];
1869 if (SUB_CHAR_TABLE_P (temp
))
1870 XCHAR_TABLE (temp
)->defalt
= value
;
1872 XCHAR_TABLE (char_table
)->contents
[charset
+ 128] = value
;
1876 if (! SUB_CHAR_TABLE_P (char_table
))
1877 char_table
= (XCHAR_TABLE (char_table
)->contents
[charset
+ 128]
1878 = make_sub_char_table (temp
));
1879 temp
= XCHAR_TABLE (char_table
)->contents
[code1
];
1880 if (SUB_CHAR_TABLE_P (temp
))
1881 XCHAR_TABLE (temp
)->defalt
= value
;
1883 XCHAR_TABLE (char_table
)->contents
[code1
] = value
;
1887 /* Map C_FUNCTION or FUNCTION over SUBTABLE, calling it for each
1888 character or group of characters that share a value.
1889 DEPTH is the current depth in the originally specified
1890 chartable, and INDICES contains the vector indices
1891 for the levels our callers have descended.
1893 ARG is passed to C_FUNCTION when that is called. */
1896 map_char_table (c_function
, function
, subtable
, arg
, depth
, indices
)
1897 void (*c_function
) P_ ((Lisp_Object
, Lisp_Object
, Lisp_Object
));
1898 Lisp_Object function
, subtable
, arg
, *indices
;
1905 /* At first, handle ASCII and 8-bit European characters. */
1906 for (i
= 0; i
< CHAR_TABLE_SINGLE_BYTE_SLOTS
; i
++)
1908 Lisp_Object elt
= XCHAR_TABLE (subtable
)->contents
[i
];
1910 (*c_function
) (arg
, make_number (i
), elt
);
1912 call2 (function
, make_number (i
), elt
);
1914 #if 0 /* If the char table has entries for higher characters,
1915 we should report them. */
1916 if (NILP (current_buffer
->enable_multibyte_characters
))
1919 to
= CHAR_TABLE_ORDINARY_SLOTS
;
1924 to
= SUB_CHAR_TABLE_ORDINARY_SLOTS
;
1929 Lisp_Object elt
= XCHAR_TABLE (subtable
)->contents
[i
];
1931 XSETFASTINT (indices
[depth
], i
);
1933 if (SUB_CHAR_TABLE_P (elt
))
1936 error ("Too deep char table");
1937 map_char_table (c_function
, function
, elt
, arg
, depth
+ 1, indices
);
1941 int charset
= XFASTINT (indices
[0]) - 128, c1
, c2
, c
;
1943 if (CHARSET_DEFINED_P (charset
))
1945 c1
= depth
>= 1 ? XFASTINT (indices
[1]) : 0;
1946 c2
= depth
>= 2 ? XFASTINT (indices
[2]) : 0;
1947 c
= MAKE_NON_ASCII_CHAR (charset
, c1
, c2
);
1949 (*c_function
) (arg
, make_number (c
), elt
);
1951 call2 (function
, make_number (c
), elt
);
1957 DEFUN ("map-char-table", Fmap_char_table
, Smap_char_table
,
1959 "Call FUNCTION for each (normal and generic) characters in CHAR-TABLE.\n\
1960 FUNCTION is called with two arguments--a key and a value.\n\
1961 The key is always a possible IDX argument to `aref'.")
1962 (function
, char_table
)
1963 Lisp_Object function
, char_table
;
1965 /* The depth of char table is at most 3. */
1966 Lisp_Object indices
[3];
1968 CHECK_CHAR_TABLE (char_table
, 1);
1970 map_char_table (NULL
, function
, char_table
, char_table
, 0, indices
);
1980 Lisp_Object args
[2];
1983 return Fnconc (2, args
);
1985 return Fnconc (2, &s1
);
1986 #endif /* NO_ARG_ARRAY */
1989 DEFUN ("nconc", Fnconc
, Snconc
, 0, MANY
, 0,
1990 "Concatenate any number of lists by altering them.\n\
1991 Only the last argument is not altered, and need not be a list.")
1996 register int argnum
;
1997 register Lisp_Object tail
, tem
, val
;
2001 for (argnum
= 0; argnum
< nargs
; argnum
++)
2004 if (NILP (tem
)) continue;
2009 if (argnum
+ 1 == nargs
) break;
2012 tem
= wrong_type_argument (Qlistp
, tem
);
2021 tem
= args
[argnum
+ 1];
2022 Fsetcdr (tail
, tem
);
2024 args
[argnum
+ 1] = tail
;
2030 /* This is the guts of all mapping functions.
2031 Apply FN to each element of SEQ, one by one,
2032 storing the results into elements of VALS, a C vector of Lisp_Objects.
2033 LENI is the length of VALS, which should also be the length of SEQ. */
2036 mapcar1 (leni
, vals
, fn
, seq
)
2039 Lisp_Object fn
, seq
;
2041 register Lisp_Object tail
;
2044 struct gcpro gcpro1
, gcpro2
, gcpro3
;
2046 /* Don't let vals contain any garbage when GC happens. */
2047 for (i
= 0; i
< leni
; i
++)
2050 GCPRO3 (dummy
, fn
, seq
);
2052 gcpro1
.nvars
= leni
;
2053 /* We need not explicitly protect `tail' because it is used only on lists, and
2054 1) lists are not relocated and 2) the list is marked via `seq' so will not be freed */
2058 for (i
= 0; i
< leni
; i
++)
2060 dummy
= XVECTOR (seq
)->contents
[i
];
2061 vals
[i
] = call1 (fn
, dummy
);
2064 else if (BOOL_VECTOR_P (seq
))
2066 for (i
= 0; i
< leni
; i
++)
2069 byte
= XBOOL_VECTOR (seq
)->data
[i
/ BITS_PER_CHAR
];
2070 if (byte
& (1 << (i
% BITS_PER_CHAR
)))
2075 vals
[i
] = call1 (fn
, dummy
);
2078 else if (STRINGP (seq
) && ! STRING_MULTIBYTE (seq
))
2080 /* Single-byte string. */
2081 for (i
= 0; i
< leni
; i
++)
2083 XSETFASTINT (dummy
, XSTRING (seq
)->data
[i
]);
2084 vals
[i
] = call1 (fn
, dummy
);
2087 else if (STRINGP (seq
))
2089 /* Multi-byte string. */
2090 int len_byte
= XSTRING (seq
)->size_byte
;
2093 for (i
= 0, i_byte
= 0; i
< leni
;)
2098 FETCH_STRING_CHAR_ADVANCE (c
, seq
, i
, i_byte
);
2099 XSETFASTINT (dummy
, c
);
2100 vals
[i_before
] = call1 (fn
, dummy
);
2103 else /* Must be a list, since Flength did not get an error */
2106 for (i
= 0; i
< leni
; i
++)
2108 vals
[i
] = call1 (fn
, Fcar (tail
));
2109 tail
= XCONS (tail
)->cdr
;
2116 DEFUN ("mapconcat", Fmapconcat
, Smapconcat
, 3, 3, 0,
2117 "Apply FUNCTION to each element of SEQUENCE, and concat the results as strings.\n\
2118 In between each pair of results, stick in SEPARATOR. Thus, \" \" as\n\
2119 SEPARATOR results in spaces between the values returned by FUNCTION.\n\
2120 SEQUENCE may be a list, a vector, a bool-vector, or a string.")
2121 (function
, sequence
, separator
)
2122 Lisp_Object function
, sequence
, separator
;
2127 register Lisp_Object
*args
;
2129 struct gcpro gcpro1
;
2131 len
= Flength (sequence
);
2133 nargs
= leni
+ leni
- 1;
2134 if (nargs
< 0) return build_string ("");
2136 args
= (Lisp_Object
*) alloca (nargs
* sizeof (Lisp_Object
));
2139 mapcar1 (leni
, args
, function
, sequence
);
2142 for (i
= leni
- 1; i
>= 0; i
--)
2143 args
[i
+ i
] = args
[i
];
2145 for (i
= 1; i
< nargs
; i
+= 2)
2146 args
[i
] = separator
;
2148 return Fconcat (nargs
, args
);
2151 DEFUN ("mapcar", Fmapcar
, Smapcar
, 2, 2, 0,
2152 "Apply FUNCTION to each element of SEQUENCE, and make a list of the results.\n\
2153 The result is a list just as long as SEQUENCE.\n\
2154 SEQUENCE may be a list, a vector, a bool-vector, or a string.")
2155 (function
, sequence
)
2156 Lisp_Object function
, sequence
;
2158 register Lisp_Object len
;
2160 register Lisp_Object
*args
;
2162 len
= Flength (sequence
);
2163 leni
= XFASTINT (len
);
2164 args
= (Lisp_Object
*) alloca (leni
* sizeof (Lisp_Object
));
2166 mapcar1 (leni
, args
, function
, sequence
);
2168 return Flist (leni
, args
);
2171 /* Anything that calls this function must protect from GC! */
2173 DEFUN ("y-or-n-p", Fy_or_n_p
, Sy_or_n_p
, 1, 1, 0,
2174 "Ask user a \"y or n\" question. Return t if answer is \"y\".\n\
2175 Takes one argument, which is the string to display to ask the question.\n\
2176 It should end in a space; `y-or-n-p' adds `(y or n) ' to it.\n\
2177 No confirmation of the answer is requested; a single character is enough.\n\
2178 Also accepts Space to mean yes, or Delete to mean no.")
2182 register Lisp_Object obj
, key
, def
, answer_string
, map
;
2183 register int answer
;
2184 Lisp_Object xprompt
;
2185 Lisp_Object args
[2];
2186 struct gcpro gcpro1
, gcpro2
;
2187 int count
= specpdl_ptr
- specpdl
;
2189 specbind (Qcursor_in_echo_area
, Qt
);
2191 map
= Fsymbol_value (intern ("query-replace-map"));
2193 CHECK_STRING (prompt
, 0);
2195 GCPRO2 (prompt
, xprompt
);
2201 if ((NILP (last_nonmenu_event
) || CONSP (last_nonmenu_event
))
2205 Lisp_Object pane
, menu
;
2206 redisplay_preserve_echo_area ();
2207 pane
= Fcons (Fcons (build_string ("Yes"), Qt
),
2208 Fcons (Fcons (build_string ("No"), Qnil
),
2210 menu
= Fcons (prompt
, pane
);
2211 obj
= Fx_popup_dialog (Qt
, menu
);
2212 answer
= !NILP (obj
);
2215 #endif /* HAVE_MENUS */
2216 cursor_in_echo_area
= 1;
2217 choose_minibuf_frame ();
2218 message_with_string ("%s(y or n) ", xprompt
, 0);
2220 if (minibuffer_auto_raise
)
2222 Lisp_Object mini_frame
;
2224 mini_frame
= WINDOW_FRAME (XWINDOW (minibuf_window
));
2226 Fraise_frame (mini_frame
);
2229 obj
= read_filtered_event (1, 0, 0);
2230 cursor_in_echo_area
= 0;
2231 /* If we need to quit, quit with cursor_in_echo_area = 0. */
2234 key
= Fmake_vector (make_number (1), obj
);
2235 def
= Flookup_key (map
, key
, Qt
);
2236 answer_string
= Fsingle_key_description (obj
);
2238 if (EQ (def
, intern ("skip")))
2243 else if (EQ (def
, intern ("act")))
2248 else if (EQ (def
, intern ("recenter")))
2254 else if (EQ (def
, intern ("quit")))
2256 /* We want to exit this command for exit-prefix,
2257 and this is the only way to do it. */
2258 else if (EQ (def
, intern ("exit-prefix")))
2263 /* If we don't clear this, then the next call to read_char will
2264 return quit_char again, and we'll enter an infinite loop. */
2269 if (EQ (xprompt
, prompt
))
2271 args
[0] = build_string ("Please answer y or n. ");
2273 xprompt
= Fconcat (2, args
);
2278 if (! noninteractive
)
2280 cursor_in_echo_area
= -1;
2281 message_with_string (answer
? "%s(y or n) y" : "%s(y or n) n",
2285 unbind_to (count
, Qnil
);
2286 return answer
? Qt
: Qnil
;
2289 /* This is how C code calls `yes-or-no-p' and allows the user
2292 Anything that calls this function must protect from GC! */
2295 do_yes_or_no_p (prompt
)
2298 return call1 (intern ("yes-or-no-p"), prompt
);
2301 /* Anything that calls this function must protect from GC! */
2303 DEFUN ("yes-or-no-p", Fyes_or_no_p
, Syes_or_no_p
, 1, 1, 0,
2304 "Ask user a yes-or-no question. Return t if answer is yes.\n\
2305 Takes one argument, which is the string to display to ask the question.\n\
2306 It should end in a space; `yes-or-no-p' adds `(yes or no) ' to it.\n\
2307 The user must confirm the answer with RET,\n\
2308 and can edit it until it has been confirmed.")
2312 register Lisp_Object ans
;
2313 Lisp_Object args
[2];
2314 struct gcpro gcpro1
;
2317 CHECK_STRING (prompt
, 0);
2320 if ((NILP (last_nonmenu_event
) || CONSP (last_nonmenu_event
))
2324 Lisp_Object pane
, menu
, obj
;
2325 redisplay_preserve_echo_area ();
2326 pane
= Fcons (Fcons (build_string ("Yes"), Qt
),
2327 Fcons (Fcons (build_string ("No"), Qnil
),
2330 menu
= Fcons (prompt
, pane
);
2331 obj
= Fx_popup_dialog (Qt
, menu
);
2335 #endif /* HAVE_MENUS */
2338 args
[1] = build_string ("(yes or no) ");
2339 prompt
= Fconcat (2, args
);
2345 ans
= Fdowncase (Fread_from_minibuffer (prompt
, Qnil
, Qnil
, Qnil
,
2346 Qyes_or_no_p_history
, Qnil
,
2348 if (XSTRING (ans
)->size
== 3 && !strcmp (XSTRING (ans
)->data
, "yes"))
2353 if (XSTRING (ans
)->size
== 2 && !strcmp (XSTRING (ans
)->data
, "no"))
2361 message ("Please answer yes or no.");
2362 Fsleep_for (make_number (2), Qnil
);
2366 DEFUN ("load-average", Fload_average
, Sload_average
, 0, 0, 0,
2367 "Return list of 1 minute, 5 minute and 15 minute load averages.\n\
2368 Each of the three load averages is multiplied by 100,\n\
2369 then converted to integer.\n\
2370 If the 5-minute or 15-minute load averages are not available, return a\n\
2371 shortened list, containing only those averages which are available.")
2375 int loads
= getloadavg (load_ave
, 3);
2379 error ("load-average not implemented for this operating system");
2383 ret
= Fcons (make_number ((int) (load_ave
[--loads
] * 100.0)), ret
);
2388 Lisp_Object Vfeatures
;
2390 DEFUN ("featurep", Ffeaturep
, Sfeaturep
, 1, 1, 0,
2391 "Returns t if FEATURE is present in this Emacs.\n\
2392 Use this to conditionalize execution of lisp code based on the presence or\n\
2393 absence of emacs or environment extensions.\n\
2394 Use `provide' to declare that a feature is available.\n\
2395 This function looks at the value of the variable `features'.")
2397 Lisp_Object feature
;
2399 register Lisp_Object tem
;
2400 CHECK_SYMBOL (feature
, 0);
2401 tem
= Fmemq (feature
, Vfeatures
);
2402 return (NILP (tem
)) ? Qnil
: Qt
;
2405 DEFUN ("provide", Fprovide
, Sprovide
, 1, 1, 0,
2406 "Announce that FEATURE is a feature of the current Emacs.")
2408 Lisp_Object feature
;
2410 register Lisp_Object tem
;
2411 CHECK_SYMBOL (feature
, 0);
2412 if (!NILP (Vautoload_queue
))
2413 Vautoload_queue
= Fcons (Fcons (Vfeatures
, Qnil
), Vautoload_queue
);
2414 tem
= Fmemq (feature
, Vfeatures
);
2416 Vfeatures
= Fcons (feature
, Vfeatures
);
2417 LOADHIST_ATTACH (Fcons (Qprovide
, feature
));
2421 DEFUN ("require", Frequire
, Srequire
, 1, 2, 0,
2422 "If feature FEATURE is not loaded, load it from FILENAME.\n\
2423 If FEATURE is not a member of the list `features', then the feature\n\
2424 is not loaded; so load the file FILENAME.\n\
2425 If FILENAME is omitted, the printname of FEATURE is used as the file name.")
2426 (feature
, file_name
)
2427 Lisp_Object feature
, file_name
;
2429 register Lisp_Object tem
;
2430 CHECK_SYMBOL (feature
, 0);
2431 tem
= Fmemq (feature
, Vfeatures
);
2432 LOADHIST_ATTACH (Fcons (Qrequire
, feature
));
2435 int count
= specpdl_ptr
- specpdl
;
2437 /* Value saved here is to be restored into Vautoload_queue */
2438 record_unwind_protect (un_autoload
, Vautoload_queue
);
2439 Vautoload_queue
= Qt
;
2441 Fload (NILP (file_name
) ? Fsymbol_name (feature
) : file_name
,
2442 Qnil
, Qt
, Qnil
, (NILP (file_name
) ? Qt
: Qnil
));
2444 tem
= Fmemq (feature
, Vfeatures
);
2446 error ("Required feature %s was not provided",
2447 XSYMBOL (feature
)->name
->data
);
2449 /* Once loading finishes, don't undo it. */
2450 Vautoload_queue
= Qt
;
2451 feature
= unbind_to (count
, feature
);
2456 /* Primitives for work of the "widget" library.
2457 In an ideal world, this section would not have been necessary.
2458 However, lisp function calls being as slow as they are, it turns
2459 out that some functions in the widget library (wid-edit.el) are the
2460 bottleneck of Widget operation. Here is their translation to C,
2461 for the sole reason of efficiency. */
2463 DEFUN ("widget-plist-member", Fwidget_plist_member
, Swidget_plist_member
, 2, 2, 0,
2464 "Return non-nil if PLIST has the property PROP.\n\
2465 PLIST is a property list, which is a list of the form\n\
2466 \(PROP1 VALUE1 PROP2 VALUE2 ...\). PROP is a symbol.\n\
2467 Unlike `plist-get', this allows you to distinguish between a missing\n\
2468 property and a property with the value nil.\n\
2469 The value is actually the tail of PLIST whose car is PROP.")
2471 Lisp_Object plist
, prop
;
2473 while (CONSP (plist
) && !EQ (XCAR (plist
), prop
))
2476 plist
= XCDR (plist
);
2477 plist
= CDR (plist
);
2482 DEFUN ("widget-put", Fwidget_put
, Swidget_put
, 3, 3, 0,
2483 "In WIDGET, set PROPERTY to VALUE.\n\
2484 The value can later be retrieved with `widget-get'.")
2485 (widget
, property
, value
)
2486 Lisp_Object widget
, property
, value
;
2488 CHECK_CONS (widget
, 1);
2489 XCDR (widget
) = Fplist_put (XCDR (widget
), property
, value
);
2492 DEFUN ("widget-get", Fwidget_get
, Swidget_get
, 2, 2, 0,
2493 "In WIDGET, get the value of PROPERTY.\n\
2494 The value could either be specified when the widget was created, or\n\
2495 later with `widget-put'.")
2497 Lisp_Object widget
, property
;
2505 CHECK_CONS (widget
, 1);
2506 tmp
= Fwidget_plist_member (XCDR (widget
), property
);
2512 tmp
= XCAR (widget
);
2515 widget
= Fget (tmp
, Qwidget_type
);
2519 DEFUN ("widget-apply", Fwidget_apply
, Swidget_apply
, 2, MANY
, 0,
2520 "Apply the value of WIDGET's PROPERTY to the widget itself.\n\
2521 ARGS are passed as extra arguments to the function.")
2526 /* This function can GC. */
2527 Lisp_Object newargs
[3];
2528 struct gcpro gcpro1
, gcpro2
;
2531 newargs
[0] = Fwidget_get (args
[0], args
[1]);
2532 newargs
[1] = args
[0];
2533 newargs
[2] = Flist (nargs
- 2, args
+ 2);
2534 GCPRO2 (newargs
[0], newargs
[2]);
2535 result
= Fapply (3, newargs
);
2542 Qstring_lessp
= intern ("string-lessp");
2543 staticpro (&Qstring_lessp
);
2544 Qprovide
= intern ("provide");
2545 staticpro (&Qprovide
);
2546 Qrequire
= intern ("require");
2547 staticpro (&Qrequire
);
2548 Qyes_or_no_p_history
= intern ("yes-or-no-p-history");
2549 staticpro (&Qyes_or_no_p_history
);
2550 Qcursor_in_echo_area
= intern ("cursor-in-echo-area");
2551 staticpro (&Qcursor_in_echo_area
);
2552 Qwidget_type
= intern ("widget-type");
2553 staticpro (&Qwidget_type
);
2555 staticpro (&string_char_byte_cache_string
);
2556 string_char_byte_cache_string
= Qnil
;
2558 Fset (Qyes_or_no_p_history
, Qnil
);
2560 DEFVAR_LISP ("features", &Vfeatures
,
2561 "A list of symbols which are the features of the executing emacs.\n\
2562 Used by `featurep' and `require', and altered by `provide'.");
2565 DEFVAR_BOOL ("use-dialog-box", &use_dialog_box
,
2566 "*Non-nil means mouse commands use dialog boxes to ask questions.\n\
2567 This applies to y-or-n and yes-or-no questions asked by commands\n\
2568 invoked by mouse clicks and mouse menu items.");
2571 defsubr (&Sidentity
);
2574 defsubr (&Ssafe_length
);
2575 defsubr (&Sstring_bytes
);
2576 defsubr (&Sstring_equal
);
2577 defsubr (&Sstring_lessp
);
2580 defsubr (&Svconcat
);
2581 defsubr (&Scopy_sequence
);
2582 defsubr (&Sstring_make_multibyte
);
2583 defsubr (&Sstring_make_unibyte
);
2584 defsubr (&Sstring_as_multibyte
);
2585 defsubr (&Sstring_as_unibyte
);
2586 defsubr (&Scopy_alist
);
2587 defsubr (&Ssubstring
);
2599 defsubr (&Snreverse
);
2600 defsubr (&Sreverse
);
2602 defsubr (&Splist_get
);
2604 defsubr (&Splist_put
);
2607 defsubr (&Sfillarray
);
2608 defsubr (&Schar_table_subtype
);
2609 defsubr (&Schar_table_parent
);
2610 defsubr (&Sset_char_table_parent
);
2611 defsubr (&Schar_table_extra_slot
);
2612 defsubr (&Sset_char_table_extra_slot
);
2613 defsubr (&Schar_table_range
);
2614 defsubr (&Sset_char_table_range
);
2615 defsubr (&Sset_char_table_default
);
2616 defsubr (&Smap_char_table
);
2619 defsubr (&Smapconcat
);
2620 defsubr (&Sy_or_n_p
);
2621 defsubr (&Syes_or_no_p
);
2622 defsubr (&Sload_average
);
2623 defsubr (&Sfeaturep
);
2624 defsubr (&Srequire
);
2625 defsubr (&Sprovide
);
2626 defsubr (&Swidget_plist_member
);
2627 defsubr (&Swidget_put
);
2628 defsubr (&Swidget_get
);
2629 defsubr (&Swidget_apply
);