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. */
28 /* Note on some machines this defines `vector' as a typedef,
29 so make sure we don't use that name in this file. */
39 #include "intervals.h"
47 #define NULL (void *)0
50 /* Nonzero enables use of dialog boxes for questions
51 asked by mouse commands. */
54 extern int minibuffer_auto_raise
;
55 extern Lisp_Object minibuf_window
;
57 Lisp_Object Qstring_lessp
, Qprovide
, Qrequire
;
58 Lisp_Object Qyes_or_no_p_history
;
59 Lisp_Object Qcursor_in_echo_area
;
60 Lisp_Object Qwidget_type
;
62 static int internal_equal ();
64 DEFUN ("identity", Fidentity
, Sidentity
, 1, 1, 0,
65 "Return the argument unchanged.")
72 extern long get_random ();
73 extern void seed_random ();
76 DEFUN ("random", Frandom
, Srandom
, 0, 1, 0,
77 "Return a pseudo-random number.\n\
78 All integers representable in Lisp are equally likely.\n\
79 On most systems, this is 28 bits' worth.\n\
80 With positive integer argument N, return random number in interval [0,N).\n\
81 With argument t, set the random number seed from the current time and pid.")
86 Lisp_Object lispy_val
;
87 unsigned long denominator
;
90 seed_random (getpid () + time (NULL
));
91 if (NATNUMP (n
) && XFASTINT (n
) != 0)
93 /* Try to take our random number from the higher bits of VAL,
94 not the lower, since (says Gentzel) the low bits of `random'
95 are less random than the higher ones. We do this by using the
96 quotient rather than the remainder. At the high end of the RNG
97 it's possible to get a quotient larger than n; discarding
98 these values eliminates the bias that would otherwise appear
99 when using a large n. */
100 denominator
= ((unsigned long)1 << VALBITS
) / XFASTINT (n
);
102 val
= get_random () / denominator
;
103 while (val
>= XFASTINT (n
));
107 XSETINT (lispy_val
, val
);
111 /* Random data-structure functions */
113 DEFUN ("length", Flength
, Slength
, 1, 1, 0,
114 "Return the length of vector, list or string SEQUENCE.\n\
115 A byte-code function object is also allowed.\n\
116 If the string contains multibyte characters, this is not the necessarily\n\
117 the number of bytes in the string; it is the number of characters.\n\
118 To get the number of bytes, use `string-bytes'")
120 register Lisp_Object sequence
;
122 register Lisp_Object tail
, val
;
126 if (STRINGP (sequence
))
127 XSETFASTINT (val
, XSTRING (sequence
)->size
);
128 else if (VECTORP (sequence
))
129 XSETFASTINT (val
, XVECTOR (sequence
)->size
);
130 else if (CHAR_TABLE_P (sequence
))
131 XSETFASTINT (val
, (MIN_CHAR_COMPOSITION
132 + (CHAR_FIELD2_MASK
| CHAR_FIELD3_MASK
)
134 else if (BOOL_VECTOR_P (sequence
))
135 XSETFASTINT (val
, XBOOL_VECTOR (sequence
)->size
);
136 else if (COMPILEDP (sequence
))
137 XSETFASTINT (val
, XVECTOR (sequence
)->size
& PSEUDOVECTOR_SIZE_MASK
);
138 else if (CONSP (sequence
))
140 for (i
= 0, tail
= sequence
; !NILP (tail
); i
++)
146 XSETFASTINT (val
, i
);
148 else if (NILP (sequence
))
149 XSETFASTINT (val
, 0);
152 sequence
= wrong_type_argument (Qsequencep
, sequence
);
158 /* This does not check for quits. That is safe
159 since it must terminate. */
161 DEFUN ("safe-length", Fsafe_length
, Ssafe_length
, 1, 1, 0,
162 "Return the length of a list, but avoid error or infinite loop.\n\
163 This function never gets an error. If LIST is not really a list,\n\
164 it returns 0. If LIST is circular, it returns a finite value\n\
165 which is at least the number of distinct elements.")
169 Lisp_Object tail
, halftail
, length
;
172 /* halftail is used to detect circular lists. */
174 for (tail
= list
; CONSP (tail
); tail
= XCONS (tail
)->cdr
)
176 if (EQ (tail
, halftail
) && len
!= 0)
180 halftail
= XCONS (halftail
)->cdr
;
183 XSETINT (length
, len
);
187 DEFUN ("string-bytes", Fstring_bytes
, Sstring_bytes
, 1, 1, 0,
188 "Return the number of bytes in STRING.\n\
189 If STRING is a multibyte string, this is greater than the length of STRING.")
193 CHECK_STRING (string
, 1);
194 return make_number (STRING_BYTES (XSTRING (string
)));
197 DEFUN ("string-equal", Fstring_equal
, Sstring_equal
, 2, 2, 0,
198 "Return t if two strings have identical contents.\n\
199 Case is significant, but text properties are ignored.\n\
200 Symbols are also allowed; their print names are used instead.")
202 register Lisp_Object s1
, s2
;
205 XSETSTRING (s1
, XSYMBOL (s1
)->name
);
207 XSETSTRING (s2
, XSYMBOL (s2
)->name
);
208 CHECK_STRING (s1
, 0);
209 CHECK_STRING (s2
, 1);
211 if (XSTRING (s1
)->size
!= XSTRING (s2
)->size
212 || STRING_BYTES (XSTRING (s1
)) != STRING_BYTES (XSTRING (s2
))
213 || bcmp (XSTRING (s1
)->data
, XSTRING (s2
)->data
, STRING_BYTES (XSTRING (s1
))))
218 DEFUN ("string-lessp", Fstring_lessp
, Sstring_lessp
, 2, 2, 0,
219 "Return t if first arg string is less than second in lexicographic order.\n\
220 Case is significant.\n\
221 Symbols are also allowed; their print names are used instead.")
223 register Lisp_Object s1
, s2
;
226 register int i1
, i1_byte
, i2
, i2_byte
;
229 XSETSTRING (s1
, XSYMBOL (s1
)->name
);
231 XSETSTRING (s2
, XSYMBOL (s2
)->name
);
232 CHECK_STRING (s1
, 0);
233 CHECK_STRING (s2
, 1);
235 i1
= i1_byte
= i2
= i2_byte
= 0;
237 end
= XSTRING (s1
)->size
;
238 if (end
> XSTRING (s2
)->size
)
239 end
= XSTRING (s2
)->size
;
243 /* When we find a mismatch, we must compare the
244 characters, not just the bytes. */
247 if (STRING_MULTIBYTE (s1
))
248 FETCH_STRING_CHAR_ADVANCE (c1
, s1
, i1
, i1_byte
);
250 c1
= XSTRING (s1
)->data
[i1
++];
252 if (STRING_MULTIBYTE (s2
))
253 FETCH_STRING_CHAR_ADVANCE (c2
, s2
, i2
, i2_byte
);
255 c2
= XSTRING (s2
)->data
[i2
++];
258 return c1
< c2
? Qt
: Qnil
;
260 return i1
< XSTRING (s2
)->size
? Qt
: Qnil
;
263 static Lisp_Object
concat ();
274 return concat (2, args
, Lisp_String
, 0);
276 return concat (2, &s1
, Lisp_String
, 0);
277 #endif /* NO_ARG_ARRAY */
283 Lisp_Object s1
, s2
, s3
;
290 return concat (3, args
, Lisp_String
, 0);
292 return concat (3, &s1
, Lisp_String
, 0);
293 #endif /* NO_ARG_ARRAY */
296 DEFUN ("append", Fappend
, Sappend
, 0, MANY
, 0,
297 "Concatenate all the arguments and make the result a list.\n\
298 The result is a list whose elements are the elements of all the arguments.\n\
299 Each argument may be a list, vector or string.\n\
300 The last argument is not copied, just used as the tail of the new list.")
305 return concat (nargs
, args
, Lisp_Cons
, 1);
308 DEFUN ("concat", Fconcat
, Sconcat
, 0, MANY
, 0,
309 "Concatenate all the arguments and make the result a string.\n\
310 The result is a string whose elements are the elements of all the arguments.\n\
311 Each argument may be a string or a list or vector of characters (integers).\n\
313 Do not use individual integers as arguments!\n\
314 The behavior of `concat' in that case will be changed later!\n\
315 If your program passes an integer as an argument to `concat',\n\
316 you should change it right away not to do so.")
321 return concat (nargs
, args
, Lisp_String
, 0);
324 DEFUN ("vconcat", Fvconcat
, Svconcat
, 0, MANY
, 0,
325 "Concatenate all the arguments and make the result a vector.\n\
326 The result is a vector whose elements are the elements of all the arguments.\n\
327 Each argument may be a list, vector or string.")
332 return concat (nargs
, args
, Lisp_Vectorlike
, 0);
335 /* Retrun a copy of a sub char table ARG. The elements except for a
336 nested sub char table are not copied. */
338 copy_sub_char_table (arg
)
341 Lisp_Object copy
= make_sub_char_table (XCHAR_TABLE (arg
)->defalt
);
344 /* Copy all the contents. */
345 bcopy (XCHAR_TABLE (arg
)->contents
, XCHAR_TABLE (copy
)->contents
,
346 SUB_CHAR_TABLE_ORDINARY_SLOTS
* sizeof (Lisp_Object
));
347 /* Recursively copy any sub char-tables in the ordinary slots. */
348 for (i
= 32; i
< SUB_CHAR_TABLE_ORDINARY_SLOTS
; i
++)
349 if (SUB_CHAR_TABLE_P (XCHAR_TABLE (arg
)->contents
[i
]))
350 XCHAR_TABLE (copy
)->contents
[i
]
351 = copy_sub_char_table (XCHAR_TABLE (copy
)->contents
[i
]);
357 DEFUN ("copy-sequence", Fcopy_sequence
, Scopy_sequence
, 1, 1, 0,
358 "Return a copy of a list, vector or string.\n\
359 The elements of a list or vector are not copied; they are shared\n\
364 if (NILP (arg
)) return arg
;
366 if (CHAR_TABLE_P (arg
))
371 copy
= Fmake_char_table (XCHAR_TABLE (arg
)->purpose
, Qnil
);
372 /* Copy all the slots, including the extra ones. */
373 bcopy (XVECTOR (arg
)->contents
, XVECTOR (copy
)->contents
,
374 ((XCHAR_TABLE (arg
)->size
& PSEUDOVECTOR_SIZE_MASK
)
375 * sizeof (Lisp_Object
)));
377 /* Recursively copy any sub char tables in the ordinary slots
378 for multibyte characters. */
379 for (i
= CHAR_TABLE_SINGLE_BYTE_SLOTS
;
380 i
< CHAR_TABLE_ORDINARY_SLOTS
; i
++)
381 if (SUB_CHAR_TABLE_P (XCHAR_TABLE (arg
)->contents
[i
]))
382 XCHAR_TABLE (copy
)->contents
[i
]
383 = copy_sub_char_table (XCHAR_TABLE (copy
)->contents
[i
]);
388 if (BOOL_VECTOR_P (arg
))
392 = (XBOOL_VECTOR (arg
)->size
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
;
394 val
= Fmake_bool_vector (Flength (arg
), Qnil
);
395 bcopy (XBOOL_VECTOR (arg
)->data
, XBOOL_VECTOR (val
)->data
,
400 if (!CONSP (arg
) && !VECTORP (arg
) && !STRINGP (arg
))
401 arg
= wrong_type_argument (Qsequencep
, arg
);
402 return concat (1, &arg
, CONSP (arg
) ? Lisp_Cons
: XTYPE (arg
), 0);
406 concat (nargs
, args
, target_type
, last_special
)
409 enum Lisp_Type target_type
;
413 register Lisp_Object tail
;
414 register Lisp_Object
this;
417 register int result_len
;
418 register int result_len_byte
;
420 Lisp_Object last_tail
;
424 /* In append, the last arg isn't treated like the others */
425 if (last_special
&& nargs
> 0)
428 last_tail
= args
[nargs
];
433 /* Canonicalize each argument. */
434 for (argnum
= 0; argnum
< nargs
; argnum
++)
437 if (!(CONSP (this) || NILP (this) || VECTORP (this) || STRINGP (this)
438 || COMPILEDP (this) || BOOL_VECTOR_P (this)))
441 args
[argnum
] = Fnumber_to_string (this);
443 args
[argnum
] = wrong_type_argument (Qsequencep
, this);
447 /* Compute total length in chars of arguments in RESULT_LEN.
448 If desired output is a string, also compute length in bytes
449 in RESULT_LEN_BYTE, and determine in SOME_MULTIBYTE
450 whether the result should be a multibyte string. */
454 for (argnum
= 0; argnum
< nargs
; argnum
++)
458 len
= XFASTINT (Flength (this));
459 if (target_type
== Lisp_String
)
461 /* We must count the number of bytes needed in the string
462 as well as the number of characters. */
468 for (i
= 0; i
< len
; i
++)
470 ch
= XVECTOR (this)->contents
[i
];
472 wrong_type_argument (Qintegerp
, ch
);
473 this_len_byte
= XFASTINT (Fchar_bytes (ch
));
474 result_len_byte
+= this_len_byte
;
475 if (this_len_byte
> 1)
478 else if (BOOL_VECTOR_P (this) && XBOOL_VECTOR (this)->size
> 0)
479 wrong_type_argument (Qintegerp
, Faref (this, make_number (0)));
480 else if (CONSP (this))
481 for (; CONSP (this); this = XCONS (this)->cdr
)
483 ch
= XCONS (this)->car
;
485 wrong_type_argument (Qintegerp
, ch
);
486 this_len_byte
= XFASTINT (Fchar_bytes (ch
));
487 result_len_byte
+= this_len_byte
;
488 if (this_len_byte
> 1)
491 else if (STRINGP (this))
493 if (STRING_MULTIBYTE (this))
496 result_len_byte
+= STRING_BYTES (XSTRING (this));
499 result_len_byte
+= count_size_as_multibyte (XSTRING (this)->data
,
500 XSTRING (this)->size
);
507 if (! some_multibyte
)
508 result_len_byte
= result_len
;
510 /* Create the output object. */
511 if (target_type
== Lisp_Cons
)
512 val
= Fmake_list (make_number (result_len
), Qnil
);
513 else if (target_type
== Lisp_Vectorlike
)
514 val
= Fmake_vector (make_number (result_len
), Qnil
);
515 else if (some_multibyte
)
516 val
= make_uninit_multibyte_string (result_len
, result_len_byte
);
518 val
= make_uninit_string (result_len
);
520 /* In `append', if all but last arg are nil, return last arg. */
521 if (target_type
== Lisp_Cons
&& EQ (val
, Qnil
))
524 /* Copy the contents of the args into the result. */
526 tail
= val
, toindex
= -1; /* -1 in toindex is flag we are making a list */
528 toindex
= 0, toindex_byte
= 0;
532 for (argnum
= 0; argnum
< nargs
; argnum
++)
536 register unsigned int thisindex
= 0;
537 register unsigned int thisindex_byte
= 0;
541 thislen
= Flength (this), thisleni
= XINT (thislen
);
543 if (STRINGP (this) && STRINGP (val
)
544 && ! NULL_INTERVAL_P (XSTRING (this)->intervals
))
545 copy_text_properties (make_number (0), thislen
, this,
546 make_number (toindex
), val
, Qnil
);
548 /* Between strings of the same kind, copy fast. */
549 if (STRINGP (this) && STRINGP (val
)
550 && STRING_MULTIBYTE (this) == some_multibyte
)
552 int thislen_byte
= STRING_BYTES (XSTRING (this));
553 bcopy (XSTRING (this)->data
, XSTRING (val
)->data
+ toindex_byte
,
554 STRING_BYTES (XSTRING (this)));
555 toindex_byte
+= thislen_byte
;
558 /* Copy a single-byte string to a multibyte string. */
559 else if (STRINGP (this) && STRINGP (val
))
561 toindex_byte
+= copy_text (XSTRING (this)->data
,
562 XSTRING (val
)->data
+ toindex_byte
,
563 XSTRING (this)->size
, 0, 1);
567 /* Copy element by element. */
570 register Lisp_Object elt
;
572 /* Fetch next element of `this' arg into `elt', or break if
573 `this' is exhausted. */
574 if (NILP (this)) break;
576 elt
= XCONS (this)->car
, this = XCONS (this)->cdr
;
577 else if (thisindex
>= thisleni
)
579 else if (STRINGP (this))
582 if (STRING_MULTIBYTE (this))
584 FETCH_STRING_CHAR_ADVANCE (c
, this,
587 XSETFASTINT (elt
, c
);
591 XSETFASTINT (elt
, XSTRING (this)->data
[thisindex
++]);
592 if (some_multibyte
&& XINT (elt
) >= 0200
593 && XINT (elt
) < 0400)
595 c
= unibyte_char_to_multibyte (XINT (elt
));
600 else if (BOOL_VECTOR_P (this))
603 byte
= XBOOL_VECTOR (this)->data
[thisindex
/ BITS_PER_CHAR
];
604 if (byte
& (1 << (thisindex
% BITS_PER_CHAR
)))
611 elt
= XVECTOR (this)->contents
[thisindex
++];
613 /* Store this element into the result. */
616 XCONS (tail
)->car
= elt
;
618 tail
= XCONS (tail
)->cdr
;
620 else if (VECTORP (val
))
621 XVECTOR (val
)->contents
[toindex
++] = elt
;
624 CHECK_NUMBER (elt
, 0);
625 if (SINGLE_BYTE_CHAR_P (XINT (elt
)))
627 XSTRING (val
)->data
[toindex
++] = XINT (elt
);
631 /* If we have any multibyte characters,
632 we already decided to make a multibyte string. */
635 unsigned char work
[4], *str
;
636 int i
= CHAR_STRING (c
, work
, str
);
638 /* P exists as a variable
639 to avoid a bug on the Masscomp C compiler. */
640 unsigned char *p
= & XSTRING (val
)->data
[toindex_byte
];
649 XCONS (prev
)->cdr
= last_tail
;
654 static Lisp_Object string_char_byte_cache_string
;
655 static int string_char_byte_cache_charpos
;
656 static int string_char_byte_cache_bytepos
;
658 /* Return the character index corresponding to CHAR_INDEX in STRING. */
661 string_char_to_byte (string
, char_index
)
666 int best_below
, best_below_byte
;
667 int best_above
, best_above_byte
;
669 if (! STRING_MULTIBYTE (string
))
672 best_below
= best_below_byte
= 0;
673 best_above
= XSTRING (string
)->size
;
674 best_above_byte
= STRING_BYTES (XSTRING (string
));
676 if (EQ (string
, string_char_byte_cache_string
))
678 if (string_char_byte_cache_charpos
< char_index
)
680 best_below
= string_char_byte_cache_charpos
;
681 best_below_byte
= string_char_byte_cache_bytepos
;
685 best_above
= string_char_byte_cache_charpos
;
686 best_above_byte
= string_char_byte_cache_bytepos
;
690 if (char_index
- best_below
< best_above
- char_index
)
692 while (best_below
< char_index
)
695 FETCH_STRING_CHAR_ADVANCE (c
, string
, best_below
, best_below_byte
);
698 i_byte
= best_below_byte
;
702 while (best_above
> char_index
)
704 int best_above_byte_saved
= --best_above_byte
;
706 while (best_above_byte
> 0
707 && !CHAR_HEAD_P (XSTRING (string
)->data
[best_above_byte
]))
709 if (XSTRING (string
)->data
[best_above_byte
] < 0x80)
710 best_above_byte
= best_above_byte_saved
;
714 i_byte
= best_above_byte
;
717 string_char_byte_cache_bytepos
= i_byte
;
718 string_char_byte_cache_charpos
= i
;
719 string_char_byte_cache_string
= string
;
724 /* Return the character index corresponding to BYTE_INDEX in STRING. */
727 string_byte_to_char (string
, byte_index
)
732 int best_below
, best_below_byte
;
733 int best_above
, best_above_byte
;
735 if (! STRING_MULTIBYTE (string
))
738 best_below
= best_below_byte
= 0;
739 best_above
= XSTRING (string
)->size
;
740 best_above_byte
= STRING_BYTES (XSTRING (string
));
742 if (EQ (string
, string_char_byte_cache_string
))
744 if (string_char_byte_cache_bytepos
< byte_index
)
746 best_below
= string_char_byte_cache_charpos
;
747 best_below_byte
= string_char_byte_cache_bytepos
;
751 best_above
= string_char_byte_cache_charpos
;
752 best_above_byte
= string_char_byte_cache_bytepos
;
756 if (byte_index
- best_below_byte
< best_above_byte
- byte_index
)
758 while (best_below_byte
< byte_index
)
761 FETCH_STRING_CHAR_ADVANCE (c
, string
, best_below
, best_below_byte
);
764 i_byte
= best_below_byte
;
768 while (best_above_byte
> byte_index
)
770 int best_above_byte_saved
= --best_above_byte
;
772 while (best_above_byte
> 0
773 && !CHAR_HEAD_P (XSTRING (string
)->data
[best_above_byte
]))
775 if (XSTRING (string
)->data
[best_above_byte
] < 0x80)
776 best_above_byte
= best_above_byte_saved
;
780 i_byte
= best_above_byte
;
783 string_char_byte_cache_bytepos
= i_byte
;
784 string_char_byte_cache_charpos
= i
;
785 string_char_byte_cache_string
= string
;
790 /* Convert STRING to a multibyte string.
791 Single-byte characters 0240 through 0377 are converted
792 by adding nonascii_insert_offset to each. */
795 string_make_multibyte (string
)
801 if (STRING_MULTIBYTE (string
))
804 nbytes
= count_size_as_multibyte (XSTRING (string
)->data
,
805 XSTRING (string
)->size
);
806 /* If all the chars are ASCII, they won't need any more bytes
807 once converted. In that case, we can return STRING itself. */
808 if (nbytes
== STRING_BYTES (XSTRING (string
)))
811 buf
= (unsigned char *) alloca (nbytes
);
812 copy_text (XSTRING (string
)->data
, buf
, STRING_BYTES (XSTRING (string
)),
815 return make_multibyte_string (buf
, XSTRING (string
)->size
, nbytes
);
818 /* Convert STRING to a single-byte string. */
821 string_make_unibyte (string
)
826 if (! STRING_MULTIBYTE (string
))
829 buf
= (unsigned char *) alloca (XSTRING (string
)->size
);
831 copy_text (XSTRING (string
)->data
, buf
, STRING_BYTES (XSTRING (string
)),
834 return make_unibyte_string (buf
, XSTRING (string
)->size
);
837 DEFUN ("string-make-multibyte", Fstring_make_multibyte
, Sstring_make_multibyte
,
839 "Return the multibyte equivalent of STRING.")
843 return string_make_multibyte (string
);
846 DEFUN ("string-make-unibyte", Fstring_make_unibyte
, Sstring_make_unibyte
,
848 "Return the unibyte equivalent of STRING.")
852 return string_make_unibyte (string
);
855 DEFUN ("string-as-unibyte", Fstring_as_unibyte
, Sstring_as_unibyte
,
857 "Return a unibyte string with the same individual bytes as STRING.\n\
858 If STRING is unibyte, the result is STRING itself.")
862 if (STRING_MULTIBYTE (string
))
864 string
= Fcopy_sequence (string
);
865 XSTRING (string
)->size
= STRING_BYTES (XSTRING (string
));
866 SET_STRING_BYTES (XSTRING (string
), -1);
871 DEFUN ("string-as-multibyte", Fstring_as_multibyte
, Sstring_as_multibyte
,
873 "Return a multibyte string with the same individual bytes as STRING.\n\
874 If STRING is multibyte, the result is STRING itself.")
878 if (! STRING_MULTIBYTE (string
))
880 int nbytes
= STRING_BYTES (XSTRING (string
));
881 int newlen
= multibyte_chars_in_text (XSTRING (string
)->data
, nbytes
);
883 string
= Fcopy_sequence (string
);
884 XSTRING (string
)->size
= newlen
;
885 XSTRING (string
)->size_byte
= nbytes
;
890 DEFUN ("copy-alist", Fcopy_alist
, Scopy_alist
, 1, 1, 0,
891 "Return a copy of ALIST.\n\
892 This is an alist which represents the same mapping from objects to objects,\n\
893 but does not share the alist structure with ALIST.\n\
894 The objects mapped (cars and cdrs of elements of the alist)\n\
895 are shared, however.\n\
896 Elements of ALIST that are not conses are also shared.")
900 register Lisp_Object tem
;
902 CHECK_LIST (alist
, 0);
905 alist
= concat (1, &alist
, Lisp_Cons
, 0);
906 for (tem
= alist
; CONSP (tem
); tem
= XCONS (tem
)->cdr
)
908 register Lisp_Object car
;
909 car
= XCONS (tem
)->car
;
912 XCONS (tem
)->car
= Fcons (XCONS (car
)->car
, XCONS (car
)->cdr
);
917 DEFUN ("substring", Fsubstring
, Ssubstring
, 2, 3, 0,
918 "Return a substring of STRING, starting at index FROM and ending before TO.\n\
919 TO may be nil or omitted; then the substring runs to the end of STRING.\n\
920 If FROM or TO is negative, it counts from the end.\n\
922 This function allows vectors as well as strings.")
925 register Lisp_Object from
, to
;
930 int from_char
, to_char
;
931 int from_byte
, to_byte
;
933 if (! (STRINGP (string
) || VECTORP (string
)))
934 wrong_type_argument (Qarrayp
, string
);
936 CHECK_NUMBER (from
, 1);
938 if (STRINGP (string
))
940 size
= XSTRING (string
)->size
;
941 size_byte
= STRING_BYTES (XSTRING (string
));
944 size
= XVECTOR (string
)->size
;
953 CHECK_NUMBER (to
, 2);
959 if (STRINGP (string
))
960 to_byte
= string_char_to_byte (string
, to_char
);
963 from_char
= XINT (from
);
966 if (STRINGP (string
))
967 from_byte
= string_char_to_byte (string
, from_char
);
969 if (!(0 <= from_char
&& from_char
<= to_char
&& to_char
<= size
))
970 args_out_of_range_3 (string
, make_number (from_char
),
971 make_number (to_char
));
973 if (STRINGP (string
))
975 res
= make_specified_string (XSTRING (string
)->data
+ from_byte
,
976 to_char
- from_char
, to_byte
- from_byte
,
977 STRING_MULTIBYTE (string
));
978 copy_text_properties (make_number (from_char
), make_number (to_char
),
979 string
, make_number (0), res
, Qnil
);
982 res
= Fvector (to_char
- from_char
,
983 XVECTOR (string
)->contents
+ from_char
);
988 /* Extract a substring of STRING, giving start and end positions
989 both in characters and in bytes. */
992 substring_both (string
, from
, from_byte
, to
, to_byte
)
994 int from
, from_byte
, to
, to_byte
;
1000 if (! (STRINGP (string
) || VECTORP (string
)))
1001 wrong_type_argument (Qarrayp
, string
);
1003 if (STRINGP (string
))
1005 size
= XSTRING (string
)->size
;
1006 size_byte
= STRING_BYTES (XSTRING (string
));
1009 size
= XVECTOR (string
)->size
;
1011 if (!(0 <= from
&& from
<= to
&& to
<= size
))
1012 args_out_of_range_3 (string
, make_number (from
), make_number (to
));
1014 if (STRINGP (string
))
1016 res
= make_specified_string (XSTRING (string
)->data
+ from_byte
,
1017 to
- from
, to_byte
- from_byte
,
1018 STRING_MULTIBYTE (string
));
1019 copy_text_properties (make_number (from
), make_number (to
),
1020 string
, make_number (0), res
, Qnil
);
1023 res
= Fvector (to
- from
,
1024 XVECTOR (string
)->contents
+ from
);
1029 DEFUN ("nthcdr", Fnthcdr
, Snthcdr
, 2, 2, 0,
1030 "Take cdr N times on LIST, returns the result.")
1033 register Lisp_Object list
;
1035 register int i
, num
;
1036 CHECK_NUMBER (n
, 0);
1038 for (i
= 0; i
< num
&& !NILP (list
); i
++)
1046 DEFUN ("nth", Fnth
, Snth
, 2, 2, 0,
1047 "Return the Nth element of LIST.\n\
1048 N counts from zero. If LIST is not that long, nil is returned.")
1050 Lisp_Object n
, list
;
1052 return Fcar (Fnthcdr (n
, list
));
1055 DEFUN ("elt", Felt
, Selt
, 2, 2, 0,
1056 "Return element of SEQUENCE at index N.")
1058 register Lisp_Object sequence
, n
;
1060 CHECK_NUMBER (n
, 0);
1063 if (CONSP (sequence
) || NILP (sequence
))
1064 return Fcar (Fnthcdr (n
, sequence
));
1065 else if (STRINGP (sequence
) || VECTORP (sequence
)
1066 || BOOL_VECTOR_P (sequence
) || CHAR_TABLE_P (sequence
))
1067 return Faref (sequence
, n
);
1069 sequence
= wrong_type_argument (Qsequencep
, sequence
);
1073 DEFUN ("member", Fmember
, Smember
, 2, 2, 0,
1074 "Return non-nil if ELT is an element of LIST. Comparison done with `equal'.\n\
1075 The value is actually the tail of LIST whose car is ELT.")
1077 register Lisp_Object elt
;
1080 register Lisp_Object tail
;
1081 for (tail
= list
; !NILP (tail
); tail
= XCONS (tail
)->cdr
)
1083 register Lisp_Object tem
;
1085 if (! NILP (Fequal (elt
, tem
)))
1092 DEFUN ("memq", Fmemq
, Smemq
, 2, 2, 0,
1093 "Return non-nil if ELT is an element of LIST. Comparison done with EQ.\n\
1094 The value is actually the tail of LIST whose car is ELT.")
1096 register Lisp_Object elt
;
1099 register Lisp_Object tail
;
1100 for (tail
= list
; !NILP (tail
); tail
= XCONS (tail
)->cdr
)
1102 register Lisp_Object tem
;
1104 if (EQ (elt
, tem
)) return tail
;
1110 DEFUN ("assq", Fassq
, Sassq
, 2, 2, 0,
1111 "Return non-nil if KEY is `eq' to the car of an element of LIST.\n\
1112 The value is actually the element of LIST whose car is KEY.\n\
1113 Elements of LIST that are not conses are ignored.")
1115 register Lisp_Object key
;
1118 register Lisp_Object tail
;
1119 for (tail
= list
; !NILP (tail
); tail
= XCONS (tail
)->cdr
)
1121 register Lisp_Object elt
, tem
;
1123 if (!CONSP (elt
)) continue;
1124 tem
= XCONS (elt
)->car
;
1125 if (EQ (key
, tem
)) return elt
;
1131 /* Like Fassq but never report an error and do not allow quits.
1132 Use only on lists known never to be circular. */
1135 assq_no_quit (key
, list
)
1136 register Lisp_Object key
;
1139 register Lisp_Object tail
;
1140 for (tail
= list
; CONSP (tail
); tail
= XCONS (tail
)->cdr
)
1142 register Lisp_Object elt
, tem
;
1144 if (!CONSP (elt
)) continue;
1145 tem
= XCONS (elt
)->car
;
1146 if (EQ (key
, tem
)) return elt
;
1151 DEFUN ("assoc", Fassoc
, Sassoc
, 2, 2, 0,
1152 "Return non-nil if KEY is `equal' to the car of an element of LIST.\n\
1153 The value is actually the element of LIST whose car equals KEY.")
1155 register Lisp_Object key
;
1158 register Lisp_Object tail
;
1159 for (tail
= list
; !NILP (tail
); tail
= XCONS (tail
)->cdr
)
1161 register Lisp_Object elt
, tem
;
1163 if (!CONSP (elt
)) continue;
1164 tem
= Fequal (XCONS (elt
)->car
, key
);
1165 if (!NILP (tem
)) return elt
;
1171 DEFUN ("rassq", Frassq
, Srassq
, 2, 2, 0,
1172 "Return non-nil if ELT is `eq' to the cdr of an element of LIST.\n\
1173 The value is actually the element of LIST whose cdr is ELT.")
1175 register Lisp_Object key
;
1178 register Lisp_Object tail
;
1179 for (tail
= list
; !NILP (tail
); tail
= XCONS (tail
)->cdr
)
1181 register Lisp_Object elt
, tem
;
1183 if (!CONSP (elt
)) continue;
1184 tem
= XCONS (elt
)->cdr
;
1185 if (EQ (key
, tem
)) return elt
;
1191 DEFUN ("rassoc", Frassoc
, Srassoc
, 2, 2, 0,
1192 "Return non-nil if KEY is `equal' to the cdr of an element of LIST.\n\
1193 The value is actually the element of LIST whose cdr equals KEY.")
1195 register Lisp_Object key
;
1198 register Lisp_Object tail
;
1199 for (tail
= list
; !NILP (tail
); tail
= XCONS (tail
)->cdr
)
1201 register Lisp_Object elt
, tem
;
1203 if (!CONSP (elt
)) continue;
1204 tem
= Fequal (XCONS (elt
)->cdr
, key
);
1205 if (!NILP (tem
)) return elt
;
1211 DEFUN ("delq", Fdelq
, Sdelq
, 2, 2, 0,
1212 "Delete by side effect any occurrences of ELT as a member of LIST.\n\
1213 The modified LIST is returned. Comparison is done with `eq'.\n\
1214 If the first member of LIST is ELT, there is no way to remove it by side effect;\n\
1215 therefore, write `(setq foo (delq element foo))'\n\
1216 to be sure of changing the value of `foo'.")
1218 register Lisp_Object elt
;
1221 register Lisp_Object tail
, prev
;
1222 register Lisp_Object tem
;
1226 while (!NILP (tail
))
1232 list
= XCONS (tail
)->cdr
;
1234 Fsetcdr (prev
, XCONS (tail
)->cdr
);
1238 tail
= XCONS (tail
)->cdr
;
1244 DEFUN ("delete", Fdelete
, Sdelete
, 2, 2, 0,
1245 "Delete by side effect any occurrences of ELT as a member of LIST.\n\
1246 The modified LIST is returned. Comparison is done with `equal'.\n\
1247 If the first member of LIST is ELT, deleting it is not a side effect;\n\
1248 it is simply using a different list.\n\
1249 Therefore, write `(setq foo (delete element foo))'\n\
1250 to be sure of changing the value of `foo'.")
1252 register Lisp_Object elt
;
1255 register Lisp_Object tail
, prev
;
1256 register Lisp_Object tem
;
1260 while (!NILP (tail
))
1263 if (! NILP (Fequal (elt
, tem
)))
1266 list
= XCONS (tail
)->cdr
;
1268 Fsetcdr (prev
, XCONS (tail
)->cdr
);
1272 tail
= XCONS (tail
)->cdr
;
1278 DEFUN ("nreverse", Fnreverse
, Snreverse
, 1, 1, 0,
1279 "Reverse LIST by modifying cdr pointers.\n\
1280 Returns the beginning of the reversed list.")
1284 register Lisp_Object prev
, tail
, next
;
1286 if (NILP (list
)) return list
;
1289 while (!NILP (tail
))
1293 Fsetcdr (tail
, prev
);
1300 DEFUN ("reverse", Freverse
, Sreverse
, 1, 1, 0,
1301 "Reverse LIST, copying. Returns the beginning of the reversed list.\n\
1302 See also the function `nreverse', which is used more often.")
1308 for (new = Qnil
; CONSP (list
); list
= XCONS (list
)->cdr
)
1309 new = Fcons (XCONS (list
)->car
, new);
1311 wrong_type_argument (Qconsp
, list
);
1315 Lisp_Object
merge ();
1317 DEFUN ("sort", Fsort
, Ssort
, 2, 2, 0,
1318 "Sort LIST, stably, comparing elements using PREDICATE.\n\
1319 Returns the sorted list. LIST is modified by side effects.\n\
1320 PREDICATE is called with two elements of LIST, and should return T\n\
1321 if the first element is \"less\" than the second.")
1323 Lisp_Object list
, predicate
;
1325 Lisp_Object front
, back
;
1326 register Lisp_Object len
, tem
;
1327 struct gcpro gcpro1
, gcpro2
;
1328 register int length
;
1331 len
= Flength (list
);
1332 length
= XINT (len
);
1336 XSETINT (len
, (length
/ 2) - 1);
1337 tem
= Fnthcdr (len
, list
);
1339 Fsetcdr (tem
, Qnil
);
1341 GCPRO2 (front
, back
);
1342 front
= Fsort (front
, predicate
);
1343 back
= Fsort (back
, predicate
);
1345 return merge (front
, back
, predicate
);
1349 merge (org_l1
, org_l2
, pred
)
1350 Lisp_Object org_l1
, org_l2
;
1354 register Lisp_Object tail
;
1356 register Lisp_Object l1
, l2
;
1357 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
1364 /* It is sufficient to protect org_l1 and org_l2.
1365 When l1 and l2 are updated, we copy the new values
1366 back into the org_ vars. */
1367 GCPRO4 (org_l1
, org_l2
, pred
, value
);
1387 tem
= call2 (pred
, Fcar (l2
), Fcar (l1
));
1403 Fsetcdr (tail
, tem
);
1409 DEFUN ("plist-get", Fplist_get
, Splist_get
, 2, 2, 0,
1410 "Extract a value from a property list.\n\
1411 PLIST is a property list, which is a list of the form\n\
1412 \(PROP1 VALUE1 PROP2 VALUE2...). This function returns the value\n\
1413 corresponding to the given PROP, or nil if PROP is not\n\
1414 one of the properties on the list.")
1417 register Lisp_Object prop
;
1419 register Lisp_Object tail
;
1420 for (tail
= plist
; !NILP (tail
); tail
= Fcdr (XCONS (tail
)->cdr
))
1422 register Lisp_Object tem
;
1425 return Fcar (XCONS (tail
)->cdr
);
1430 DEFUN ("get", Fget
, Sget
, 2, 2, 0,
1431 "Return the value of SYMBOL's PROPNAME property.\n\
1432 This is the last value stored with `(put SYMBOL PROPNAME VALUE)'.")
1434 Lisp_Object symbol
, propname
;
1436 CHECK_SYMBOL (symbol
, 0);
1437 return Fplist_get (XSYMBOL (symbol
)->plist
, propname
);
1440 DEFUN ("plist-put", Fplist_put
, Splist_put
, 3, 3, 0,
1441 "Change value in PLIST of PROP to VAL.\n\
1442 PLIST is a property list, which is a list of the form\n\
1443 \(PROP1 VALUE1 PROP2 VALUE2 ...). PROP is a symbol and VAL is any object.\n\
1444 If PROP is already a property on the list, its value is set to VAL,\n\
1445 otherwise the new PROP VAL pair is added. The new plist is returned;\n\
1446 use `(setq x (plist-put x prop val))' to be sure to use the new value.\n\
1447 The PLIST is modified by side effects.")
1450 register Lisp_Object prop
;
1453 register Lisp_Object tail
, prev
;
1454 Lisp_Object newcell
;
1456 for (tail
= plist
; CONSP (tail
) && CONSP (XCONS (tail
)->cdr
);
1457 tail
= XCONS (XCONS (tail
)->cdr
)->cdr
)
1459 if (EQ (prop
, XCONS (tail
)->car
))
1461 Fsetcar (XCONS (tail
)->cdr
, val
);
1466 newcell
= Fcons (prop
, Fcons (val
, Qnil
));
1470 Fsetcdr (XCONS (prev
)->cdr
, newcell
);
1474 DEFUN ("put", Fput
, Sput
, 3, 3, 0,
1475 "Store SYMBOL's PROPNAME property with value VALUE.\n\
1476 It can be retrieved with `(get SYMBOL PROPNAME)'.")
1477 (symbol
, propname
, value
)
1478 Lisp_Object symbol
, propname
, value
;
1480 CHECK_SYMBOL (symbol
, 0);
1481 XSYMBOL (symbol
)->plist
1482 = Fplist_put (XSYMBOL (symbol
)->plist
, propname
, value
);
1486 DEFUN ("equal", Fequal
, Sequal
, 2, 2, 0,
1487 "Return t if two Lisp objects have similar structure and contents.\n\
1488 They must have the same data type.\n\
1489 Conses are compared by comparing the cars and the cdrs.\n\
1490 Vectors and strings are compared element by element.\n\
1491 Numbers are compared by value, but integers cannot equal floats.\n\
1492 (Use `=' if you want integers and floats to be able to be equal.)\n\
1493 Symbols must match exactly.")
1495 register Lisp_Object o1
, o2
;
1497 return internal_equal (o1
, o2
, 0) ? Qt
: Qnil
;
1501 internal_equal (o1
, o2
, depth
)
1502 register Lisp_Object o1
, o2
;
1506 error ("Stack overflow in equal");
1512 if (XTYPE (o1
) != XTYPE (o2
))
1517 #ifdef LISP_FLOAT_TYPE
1519 return (extract_float (o1
) == extract_float (o2
));
1523 if (!internal_equal (XCONS (o1
)->car
, XCONS (o2
)->car
, depth
+ 1))
1525 o1
= XCONS (o1
)->cdr
;
1526 o2
= XCONS (o2
)->cdr
;
1530 if (XMISCTYPE (o1
) != XMISCTYPE (o2
))
1534 if (!internal_equal (OVERLAY_START (o1
), OVERLAY_START (o1
),
1536 || !internal_equal (OVERLAY_END (o1
), OVERLAY_END (o1
),
1539 o1
= XOVERLAY (o1
)->plist
;
1540 o2
= XOVERLAY (o2
)->plist
;
1545 return (XMARKER (o1
)->buffer
== XMARKER (o2
)->buffer
1546 && (XMARKER (o1
)->buffer
== 0
1547 || XMARKER (o1
)->bytepos
== XMARKER (o2
)->bytepos
));
1551 case Lisp_Vectorlike
:
1553 register int i
, size
;
1554 size
= XVECTOR (o1
)->size
;
1555 /* Pseudovectors have the type encoded in the size field, so this test
1556 actually checks that the objects have the same type as well as the
1558 if (XVECTOR (o2
)->size
!= size
)
1560 /* Boolvectors are compared much like strings. */
1561 if (BOOL_VECTOR_P (o1
))
1564 = (XBOOL_VECTOR (o1
)->size
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
;
1566 if (XBOOL_VECTOR (o1
)->size
!= XBOOL_VECTOR (o2
)->size
)
1568 if (bcmp (XBOOL_VECTOR (o1
)->data
, XBOOL_VECTOR (o2
)->data
,
1573 if (WINDOW_CONFIGURATIONP (o1
))
1574 return compare_window_configurations (o1
, o2
, 0);
1576 /* Aside from them, only true vectors, char-tables, and compiled
1577 functions are sensible to compare, so eliminate the others now. */
1578 if (size
& PSEUDOVECTOR_FLAG
)
1580 if (!(size
& (PVEC_COMPILED
| PVEC_CHAR_TABLE
)))
1582 size
&= PSEUDOVECTOR_SIZE_MASK
;
1584 for (i
= 0; i
< size
; i
++)
1587 v1
= XVECTOR (o1
)->contents
[i
];
1588 v2
= XVECTOR (o2
)->contents
[i
];
1589 if (!internal_equal (v1
, v2
, depth
+ 1))
1597 if (XSTRING (o1
)->size
!= XSTRING (o2
)->size
)
1599 if (STRING_BYTES (XSTRING (o1
)) != STRING_BYTES (XSTRING (o2
)))
1601 if (bcmp (XSTRING (o1
)->data
, XSTRING (o2
)->data
,
1602 STRING_BYTES (XSTRING (o1
))))
1609 extern Lisp_Object
Fmake_char_internal ();
1611 DEFUN ("fillarray", Ffillarray
, Sfillarray
, 2, 2, 0,
1612 "Store each element of ARRAY with ITEM.\n\
1613 ARRAY is a vector, string, char-table, or bool-vector.")
1615 Lisp_Object array
, item
;
1617 register int size
, index
, charval
;
1619 if (VECTORP (array
))
1621 register Lisp_Object
*p
= XVECTOR (array
)->contents
;
1622 size
= XVECTOR (array
)->size
;
1623 for (index
= 0; index
< size
; index
++)
1626 else if (CHAR_TABLE_P (array
))
1628 register Lisp_Object
*p
= XCHAR_TABLE (array
)->contents
;
1629 size
= CHAR_TABLE_ORDINARY_SLOTS
;
1630 for (index
= 0; index
< size
; index
++)
1632 XCHAR_TABLE (array
)->defalt
= Qnil
;
1634 else if (STRINGP (array
))
1636 register unsigned char *p
= XSTRING (array
)->data
;
1637 CHECK_NUMBER (item
, 1);
1638 charval
= XINT (item
);
1639 size
= XSTRING (array
)->size
;
1640 for (index
= 0; index
< size
; index
++)
1643 else if (BOOL_VECTOR_P (array
))
1645 register unsigned char *p
= XBOOL_VECTOR (array
)->data
;
1647 = (XBOOL_VECTOR (array
)->size
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
;
1649 charval
= (! NILP (item
) ? -1 : 0);
1650 for (index
= 0; index
< size_in_chars
; index
++)
1655 array
= wrong_type_argument (Qarrayp
, array
);
1661 DEFUN ("char-table-subtype", Fchar_table_subtype
, Schar_table_subtype
,
1663 "Return the subtype of char-table CHAR-TABLE. The value is a symbol.")
1665 Lisp_Object char_table
;
1667 CHECK_CHAR_TABLE (char_table
, 0);
1669 return XCHAR_TABLE (char_table
)->purpose
;
1672 DEFUN ("char-table-parent", Fchar_table_parent
, Schar_table_parent
,
1674 "Return the parent char-table of CHAR-TABLE.\n\
1675 The value is either nil or another char-table.\n\
1676 If CHAR-TABLE holds nil for a given character,\n\
1677 then the actual applicable value is inherited from the parent char-table\n\
1678 \(or from its parents, if necessary).")
1680 Lisp_Object char_table
;
1682 CHECK_CHAR_TABLE (char_table
, 0);
1684 return XCHAR_TABLE (char_table
)->parent
;
1687 DEFUN ("set-char-table-parent", Fset_char_table_parent
, Sset_char_table_parent
,
1689 "Set the parent char-table of CHAR-TABLE to PARENT.\n\
1690 PARENT must be either nil or another char-table.")
1691 (char_table
, parent
)
1692 Lisp_Object char_table
, parent
;
1696 CHECK_CHAR_TABLE (char_table
, 0);
1700 CHECK_CHAR_TABLE (parent
, 0);
1702 for (temp
= parent
; !NILP (temp
); temp
= XCHAR_TABLE (temp
)->parent
)
1703 if (EQ (temp
, char_table
))
1704 error ("Attempt to make a chartable be its own parent");
1707 XCHAR_TABLE (char_table
)->parent
= parent
;
1712 DEFUN ("char-table-extra-slot", Fchar_table_extra_slot
, Schar_table_extra_slot
,
1714 "Return the value of CHAR-TABLE's extra-slot number N.")
1716 Lisp_Object char_table
, n
;
1718 CHECK_CHAR_TABLE (char_table
, 1);
1719 CHECK_NUMBER (n
, 2);
1721 || XINT (n
) >= CHAR_TABLE_EXTRA_SLOTS (XCHAR_TABLE (char_table
)))
1722 args_out_of_range (char_table
, n
);
1724 return XCHAR_TABLE (char_table
)->extras
[XINT (n
)];
1727 DEFUN ("set-char-table-extra-slot", Fset_char_table_extra_slot
,
1728 Sset_char_table_extra_slot
,
1730 "Set CHAR-TABLE's extra-slot number N to VALUE.")
1731 (char_table
, n
, value
)
1732 Lisp_Object char_table
, n
, value
;
1734 CHECK_CHAR_TABLE (char_table
, 1);
1735 CHECK_NUMBER (n
, 2);
1737 || XINT (n
) >= CHAR_TABLE_EXTRA_SLOTS (XCHAR_TABLE (char_table
)))
1738 args_out_of_range (char_table
, n
);
1740 return XCHAR_TABLE (char_table
)->extras
[XINT (n
)] = value
;
1743 DEFUN ("char-table-range", Fchar_table_range
, Schar_table_range
,
1745 "Return the value in CHAR-TABLE for a range of characters RANGE.\n\
1746 RANGE should be nil (for the default value)\n\
1747 a vector which identifies a character set or a row of a character set,\n\
1748 a character set name, or a character code.")
1750 Lisp_Object char_table
, range
;
1754 CHECK_CHAR_TABLE (char_table
, 0);
1756 if (EQ (range
, Qnil
))
1757 return XCHAR_TABLE (char_table
)->defalt
;
1758 else if (INTEGERP (range
))
1759 return Faref (char_table
, range
);
1760 else if (SYMBOLP (range
))
1762 Lisp_Object charset_info
;
1764 charset_info
= Fget (range
, Qcharset
);
1765 CHECK_VECTOR (charset_info
, 0);
1767 return Faref (char_table
,
1768 make_number (XINT (XVECTOR (charset_info
)->contents
[0])
1771 else if (VECTORP (range
))
1773 if (XVECTOR (range
)->size
== 1)
1774 return Faref (char_table
,
1775 make_number (XINT (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
,
1816 make_number (XINT (XVECTOR (charset_info
)->contents
[0])
1820 else if (INTEGERP (range
))
1821 Faset (char_table
, range
, value
);
1822 else if (VECTORP (range
))
1824 if (XVECTOR (range
)->size
== 1)
1825 return Faset (char_table
,
1826 make_number (XINT (XVECTOR (range
)->contents
[0]) + 128),
1830 int size
= XVECTOR (range
)->size
;
1831 Lisp_Object
*val
= XVECTOR (range
)->contents
;
1832 Lisp_Object ch
= Fmake_char_internal (size
<= 0 ? Qnil
: val
[0],
1833 size
<= 1 ? Qnil
: val
[1],
1834 size
<= 2 ? Qnil
: val
[2]);
1835 return Faset (char_table
, ch
, value
);
1839 error ("Invalid RANGE argument to `set-char-table-range'");
1844 DEFUN ("set-char-table-default", Fset_char_table_default
,
1845 Sset_char_table_default
, 3, 3, 0,
1846 "Set the default value in CHAR-TABLE for a generic character CHAR to VALUE.\n\
1847 The generic character specifies the group of characters.\n\
1848 See also the documentation of make-char.")
1849 (char_table
, ch
, value
)
1850 Lisp_Object char_table
, ch
, value
;
1852 int c
, i
, charset
, code1
, code2
;
1855 CHECK_CHAR_TABLE (char_table
, 0);
1856 CHECK_NUMBER (ch
, 1);
1859 SPLIT_NON_ASCII_CHAR (c
, charset
, code1
, code2
);
1860 if (! CHARSET_DEFINED_P (charset
))
1861 invalid_character (c
);
1863 if (charset
== CHARSET_ASCII
)
1864 return (XCHAR_TABLE (char_table
)->defalt
= value
);
1866 /* Even if C is not a generic char, we had better behave as if a
1867 generic char is specified. */
1868 if (CHARSET_DIMENSION (charset
) == 1)
1870 temp
= XCHAR_TABLE (char_table
)->contents
[charset
+ 128];
1873 if (SUB_CHAR_TABLE_P (temp
))
1874 XCHAR_TABLE (temp
)->defalt
= value
;
1876 XCHAR_TABLE (char_table
)->contents
[charset
+ 128] = value
;
1880 if (! SUB_CHAR_TABLE_P (char_table
))
1881 char_table
= (XCHAR_TABLE (char_table
)->contents
[charset
+ 128]
1882 = make_sub_char_table (temp
));
1883 temp
= XCHAR_TABLE (char_table
)->contents
[code1
];
1884 if (SUB_CHAR_TABLE_P (temp
))
1885 XCHAR_TABLE (temp
)->defalt
= value
;
1887 XCHAR_TABLE (char_table
)->contents
[code1
] = value
;
1891 /* Look up the element in TABLE at index CH,
1892 and return it as an integer.
1893 If the element is nil, return CH itself.
1894 (Actually we do that for any non-integer.) */
1897 char_table_translate (table
, ch
)
1902 value
= Faref (table
, make_number (ch
));
1903 if (! INTEGERP (value
))
1905 return XINT (value
);
1908 /* Map C_FUNCTION or FUNCTION over SUBTABLE, calling it for each
1909 character or group of characters that share a value.
1910 DEPTH is the current depth in the originally specified
1911 chartable, and INDICES contains the vector indices
1912 for the levels our callers have descended.
1914 ARG is passed to C_FUNCTION when that is called. */
1917 map_char_table (c_function
, function
, subtable
, arg
, depth
, indices
)
1918 void (*c_function
) P_ ((Lisp_Object
, Lisp_Object
, Lisp_Object
));
1919 Lisp_Object function
, subtable
, arg
, *indices
;
1926 /* At first, handle ASCII and 8-bit European characters. */
1927 for (i
= 0; i
< CHAR_TABLE_SINGLE_BYTE_SLOTS
; i
++)
1929 Lisp_Object elt
= XCHAR_TABLE (subtable
)->contents
[i
];
1931 (*c_function
) (arg
, make_number (i
), elt
);
1933 call2 (function
, make_number (i
), elt
);
1935 #if 0 /* If the char table has entries for higher characters,
1936 we should report them. */
1937 if (NILP (current_buffer
->enable_multibyte_characters
))
1940 to
= CHAR_TABLE_ORDINARY_SLOTS
;
1945 to
= SUB_CHAR_TABLE_ORDINARY_SLOTS
;
1950 Lisp_Object elt
= XCHAR_TABLE (subtable
)->contents
[i
];
1952 XSETFASTINT (indices
[depth
], i
);
1954 if (SUB_CHAR_TABLE_P (elt
))
1957 error ("Too deep char table");
1958 map_char_table (c_function
, function
, elt
, arg
, depth
+ 1, indices
);
1962 int charset
= XFASTINT (indices
[0]) - 128, c1
, c2
, c
;
1964 if (CHARSET_DEFINED_P (charset
))
1966 c1
= depth
>= 1 ? XFASTINT (indices
[1]) : 0;
1967 c2
= depth
>= 2 ? XFASTINT (indices
[2]) : 0;
1968 c
= MAKE_NON_ASCII_CHAR (charset
, c1
, c2
);
1970 (*c_function
) (arg
, make_number (c
), elt
);
1972 call2 (function
, make_number (c
), elt
);
1978 DEFUN ("map-char-table", Fmap_char_table
, Smap_char_table
,
1980 "Call FUNCTION for each (normal and generic) characters in CHAR-TABLE.\n\
1981 FUNCTION is called with two arguments--a key and a value.\n\
1982 The key is always a possible IDX argument to `aref'.")
1983 (function
, char_table
)
1984 Lisp_Object function
, char_table
;
1986 /* The depth of char table is at most 3. */
1987 Lisp_Object indices
[3];
1989 CHECK_CHAR_TABLE (char_table
, 1);
1991 map_char_table (NULL
, function
, char_table
, char_table
, 0, indices
);
2001 Lisp_Object args
[2];
2004 return Fnconc (2, args
);
2006 return Fnconc (2, &s1
);
2007 #endif /* NO_ARG_ARRAY */
2010 DEFUN ("nconc", Fnconc
, Snconc
, 0, MANY
, 0,
2011 "Concatenate any number of lists by altering them.\n\
2012 Only the last argument is not altered, and need not be a list.")
2017 register int argnum
;
2018 register Lisp_Object tail
, tem
, val
;
2022 for (argnum
= 0; argnum
< nargs
; argnum
++)
2025 if (NILP (tem
)) continue;
2030 if (argnum
+ 1 == nargs
) break;
2033 tem
= wrong_type_argument (Qlistp
, tem
);
2042 tem
= args
[argnum
+ 1];
2043 Fsetcdr (tail
, tem
);
2045 args
[argnum
+ 1] = tail
;
2051 /* This is the guts of all mapping functions.
2052 Apply FN to each element of SEQ, one by one,
2053 storing the results into elements of VALS, a C vector of Lisp_Objects.
2054 LENI is the length of VALS, which should also be the length of SEQ. */
2057 mapcar1 (leni
, vals
, fn
, seq
)
2060 Lisp_Object fn
, seq
;
2062 register Lisp_Object tail
;
2065 struct gcpro gcpro1
, gcpro2
, gcpro3
;
2067 /* Don't let vals contain any garbage when GC happens. */
2068 for (i
= 0; i
< leni
; i
++)
2071 GCPRO3 (dummy
, fn
, seq
);
2073 gcpro1
.nvars
= leni
;
2074 /* We need not explicitly protect `tail' because it is used only on lists, and
2075 1) lists are not relocated and 2) the list is marked via `seq' so will not be freed */
2079 for (i
= 0; i
< leni
; i
++)
2081 dummy
= XVECTOR (seq
)->contents
[i
];
2082 vals
[i
] = call1 (fn
, dummy
);
2085 else if (BOOL_VECTOR_P (seq
))
2087 for (i
= 0; i
< leni
; i
++)
2090 byte
= XBOOL_VECTOR (seq
)->data
[i
/ BITS_PER_CHAR
];
2091 if (byte
& (1 << (i
% BITS_PER_CHAR
)))
2096 vals
[i
] = call1 (fn
, dummy
);
2099 else if (STRINGP (seq
) && ! STRING_MULTIBYTE (seq
))
2101 /* Single-byte string. */
2102 for (i
= 0; i
< leni
; i
++)
2104 XSETFASTINT (dummy
, XSTRING (seq
)->data
[i
]);
2105 vals
[i
] = call1 (fn
, dummy
);
2108 else if (STRINGP (seq
))
2110 /* Multi-byte string. */
2111 int len_byte
= STRING_BYTES (XSTRING (seq
));
2114 for (i
= 0, i_byte
= 0; i
< leni
;)
2119 FETCH_STRING_CHAR_ADVANCE (c
, seq
, i
, i_byte
);
2120 XSETFASTINT (dummy
, c
);
2121 vals
[i_before
] = call1 (fn
, dummy
);
2124 else /* Must be a list, since Flength did not get an error */
2127 for (i
= 0; i
< leni
; i
++)
2129 vals
[i
] = call1 (fn
, Fcar (tail
));
2130 tail
= XCONS (tail
)->cdr
;
2137 DEFUN ("mapconcat", Fmapconcat
, Smapconcat
, 3, 3, 0,
2138 "Apply FUNCTION to each element of SEQUENCE, and concat the results as strings.\n\
2139 In between each pair of results, stick in SEPARATOR. Thus, \" \" as\n\
2140 SEPARATOR results in spaces between the values returned by FUNCTION.\n\
2141 SEQUENCE may be a list, a vector, a bool-vector, or a string.")
2142 (function
, sequence
, separator
)
2143 Lisp_Object function
, sequence
, separator
;
2148 register Lisp_Object
*args
;
2150 struct gcpro gcpro1
;
2152 len
= Flength (sequence
);
2154 nargs
= leni
+ leni
- 1;
2155 if (nargs
< 0) return build_string ("");
2157 args
= (Lisp_Object
*) alloca (nargs
* sizeof (Lisp_Object
));
2160 mapcar1 (leni
, args
, function
, sequence
);
2163 for (i
= leni
- 1; i
>= 0; i
--)
2164 args
[i
+ i
] = args
[i
];
2166 for (i
= 1; i
< nargs
; i
+= 2)
2167 args
[i
] = separator
;
2169 return Fconcat (nargs
, args
);
2172 DEFUN ("mapcar", Fmapcar
, Smapcar
, 2, 2, 0,
2173 "Apply FUNCTION to each element of SEQUENCE, and make a list of the results.\n\
2174 The result is a list just as long as SEQUENCE.\n\
2175 SEQUENCE may be a list, a vector, a bool-vector, or a string.")
2176 (function
, sequence
)
2177 Lisp_Object function
, sequence
;
2179 register Lisp_Object len
;
2181 register Lisp_Object
*args
;
2183 len
= Flength (sequence
);
2184 leni
= XFASTINT (len
);
2185 args
= (Lisp_Object
*) alloca (leni
* sizeof (Lisp_Object
));
2187 mapcar1 (leni
, args
, function
, sequence
);
2189 return Flist (leni
, args
);
2192 /* Anything that calls this function must protect from GC! */
2194 DEFUN ("y-or-n-p", Fy_or_n_p
, Sy_or_n_p
, 1, 1, 0,
2195 "Ask user a \"y or n\" question. Return t if answer is \"y\".\n\
2196 Takes one argument, which is the string to display to ask the question.\n\
2197 It should end in a space; `y-or-n-p' adds `(y or n) ' to it.\n\
2198 No confirmation of the answer is requested; a single character is enough.\n\
2199 Also accepts Space to mean yes, or Delete to mean no.")
2203 register Lisp_Object obj
, key
, def
, answer_string
, map
;
2204 register int answer
;
2205 Lisp_Object xprompt
;
2206 Lisp_Object args
[2];
2207 struct gcpro gcpro1
, gcpro2
;
2208 int count
= specpdl_ptr
- specpdl
;
2210 specbind (Qcursor_in_echo_area
, Qt
);
2212 map
= Fsymbol_value (intern ("query-replace-map"));
2214 CHECK_STRING (prompt
, 0);
2216 GCPRO2 (prompt
, xprompt
);
2222 if ((NILP (last_nonmenu_event
) || CONSP (last_nonmenu_event
))
2226 Lisp_Object pane
, menu
;
2227 redisplay_preserve_echo_area ();
2228 pane
= Fcons (Fcons (build_string ("Yes"), Qt
),
2229 Fcons (Fcons (build_string ("No"), Qnil
),
2231 menu
= Fcons (prompt
, pane
);
2232 obj
= Fx_popup_dialog (Qt
, menu
);
2233 answer
= !NILP (obj
);
2236 #endif /* HAVE_MENUS */
2237 cursor_in_echo_area
= 1;
2238 choose_minibuf_frame ();
2239 message_with_string ("%s(y or n) ", xprompt
, 0);
2241 if (minibuffer_auto_raise
)
2243 Lisp_Object mini_frame
;
2245 mini_frame
= WINDOW_FRAME (XWINDOW (minibuf_window
));
2247 Fraise_frame (mini_frame
);
2250 obj
= read_filtered_event (1, 0, 0);
2251 cursor_in_echo_area
= 0;
2252 /* If we need to quit, quit with cursor_in_echo_area = 0. */
2255 key
= Fmake_vector (make_number (1), obj
);
2256 def
= Flookup_key (map
, key
, Qt
);
2257 answer_string
= Fsingle_key_description (obj
);
2259 if (EQ (def
, intern ("skip")))
2264 else if (EQ (def
, intern ("act")))
2269 else if (EQ (def
, intern ("recenter")))
2275 else if (EQ (def
, intern ("quit")))
2277 /* We want to exit this command for exit-prefix,
2278 and this is the only way to do it. */
2279 else if (EQ (def
, intern ("exit-prefix")))
2284 /* If we don't clear this, then the next call to read_char will
2285 return quit_char again, and we'll enter an infinite loop. */
2290 if (EQ (xprompt
, prompt
))
2292 args
[0] = build_string ("Please answer y or n. ");
2294 xprompt
= Fconcat (2, args
);
2299 if (! noninteractive
)
2301 cursor_in_echo_area
= -1;
2302 message_with_string (answer
? "%s(y or n) y" : "%s(y or n) n",
2306 unbind_to (count
, Qnil
);
2307 return answer
? Qt
: Qnil
;
2310 /* This is how C code calls `yes-or-no-p' and allows the user
2313 Anything that calls this function must protect from GC! */
2316 do_yes_or_no_p (prompt
)
2319 return call1 (intern ("yes-or-no-p"), prompt
);
2322 /* Anything that calls this function must protect from GC! */
2324 DEFUN ("yes-or-no-p", Fyes_or_no_p
, Syes_or_no_p
, 1, 1, 0,
2325 "Ask user a yes-or-no question. Return t if answer is yes.\n\
2326 Takes one argument, which is the string to display to ask the question.\n\
2327 It should end in a space; `yes-or-no-p' adds `(yes or no) ' to it.\n\
2328 The user must confirm the answer with RET,\n\
2329 and can edit it until it has been confirmed.")
2333 register Lisp_Object ans
;
2334 Lisp_Object args
[2];
2335 struct gcpro gcpro1
;
2338 CHECK_STRING (prompt
, 0);
2341 if ((NILP (last_nonmenu_event
) || CONSP (last_nonmenu_event
))
2345 Lisp_Object pane
, menu
, obj
;
2346 redisplay_preserve_echo_area ();
2347 pane
= Fcons (Fcons (build_string ("Yes"), Qt
),
2348 Fcons (Fcons (build_string ("No"), Qnil
),
2351 menu
= Fcons (prompt
, pane
);
2352 obj
= Fx_popup_dialog (Qt
, menu
);
2356 #endif /* HAVE_MENUS */
2359 args
[1] = build_string ("(yes or no) ");
2360 prompt
= Fconcat (2, args
);
2366 ans
= Fdowncase (Fread_from_minibuffer (prompt
, Qnil
, Qnil
, Qnil
,
2367 Qyes_or_no_p_history
, Qnil
,
2369 if (XSTRING (ans
)->size
== 3 && !strcmp (XSTRING (ans
)->data
, "yes"))
2374 if (XSTRING (ans
)->size
== 2 && !strcmp (XSTRING (ans
)->data
, "no"))
2382 message ("Please answer yes or no.");
2383 Fsleep_for (make_number (2), Qnil
);
2387 DEFUN ("load-average", Fload_average
, Sload_average
, 0, 0, 0,
2388 "Return list of 1 minute, 5 minute and 15 minute load averages.\n\
2389 Each of the three load averages is multiplied by 100,\n\
2390 then converted to integer.\n\
2391 If the 5-minute or 15-minute load averages are not available, return a\n\
2392 shortened list, containing only those averages which are available.")
2396 int loads
= getloadavg (load_ave
, 3);
2400 error ("load-average not implemented for this operating system");
2404 ret
= Fcons (make_number ((int) (load_ave
[--loads
] * 100.0)), ret
);
2409 Lisp_Object Vfeatures
;
2411 DEFUN ("featurep", Ffeaturep
, Sfeaturep
, 1, 1, 0,
2412 "Returns t if FEATURE is present in this Emacs.\n\
2413 Use this to conditionalize execution of lisp code based on the presence or\n\
2414 absence of emacs or environment extensions.\n\
2415 Use `provide' to declare that a feature is available.\n\
2416 This function looks at the value of the variable `features'.")
2418 Lisp_Object feature
;
2420 register Lisp_Object tem
;
2421 CHECK_SYMBOL (feature
, 0);
2422 tem
= Fmemq (feature
, Vfeatures
);
2423 return (NILP (tem
)) ? Qnil
: Qt
;
2426 DEFUN ("provide", Fprovide
, Sprovide
, 1, 1, 0,
2427 "Announce that FEATURE is a feature of the current Emacs.")
2429 Lisp_Object feature
;
2431 register Lisp_Object tem
;
2432 CHECK_SYMBOL (feature
, 0);
2433 if (!NILP (Vautoload_queue
))
2434 Vautoload_queue
= Fcons (Fcons (Vfeatures
, Qnil
), Vautoload_queue
);
2435 tem
= Fmemq (feature
, Vfeatures
);
2437 Vfeatures
= Fcons (feature
, Vfeatures
);
2438 LOADHIST_ATTACH (Fcons (Qprovide
, feature
));
2442 DEFUN ("require", Frequire
, Srequire
, 1, 2, 0,
2443 "If feature FEATURE is not loaded, load it from FILENAME.\n\
2444 If FEATURE is not a member of the list `features', then the feature\n\
2445 is not loaded; so load the file FILENAME.\n\
2446 If FILENAME is omitted, the printname of FEATURE is used as the file name.")
2447 (feature
, file_name
)
2448 Lisp_Object feature
, file_name
;
2450 register Lisp_Object tem
;
2451 CHECK_SYMBOL (feature
, 0);
2452 tem
= Fmemq (feature
, Vfeatures
);
2453 LOADHIST_ATTACH (Fcons (Qrequire
, feature
));
2456 int count
= specpdl_ptr
- specpdl
;
2458 /* Value saved here is to be restored into Vautoload_queue */
2459 record_unwind_protect (un_autoload
, Vautoload_queue
);
2460 Vautoload_queue
= Qt
;
2462 Fload (NILP (file_name
) ? Fsymbol_name (feature
) : file_name
,
2463 Qnil
, Qt
, Qnil
, (NILP (file_name
) ? Qt
: Qnil
));
2465 tem
= Fmemq (feature
, Vfeatures
);
2467 error ("Required feature %s was not provided",
2468 XSYMBOL (feature
)->name
->data
);
2470 /* Once loading finishes, don't undo it. */
2471 Vautoload_queue
= Qt
;
2472 feature
= unbind_to (count
, feature
);
2477 /* Primitives for work of the "widget" library.
2478 In an ideal world, this section would not have been necessary.
2479 However, lisp function calls being as slow as they are, it turns
2480 out that some functions in the widget library (wid-edit.el) are the
2481 bottleneck of Widget operation. Here is their translation to C,
2482 for the sole reason of efficiency. */
2484 DEFUN ("widget-plist-member", Fwidget_plist_member
, Swidget_plist_member
, 2, 2, 0,
2485 "Return non-nil if PLIST has the property PROP.\n\
2486 PLIST is a property list, which is a list of the form\n\
2487 \(PROP1 VALUE1 PROP2 VALUE2 ...\). PROP is a symbol.\n\
2488 Unlike `plist-get', this allows you to distinguish between a missing\n\
2489 property and a property with the value nil.\n\
2490 The value is actually the tail of PLIST whose car is PROP.")
2492 Lisp_Object plist
, prop
;
2494 while (CONSP (plist
) && !EQ (XCAR (plist
), prop
))
2497 plist
= XCDR (plist
);
2498 plist
= CDR (plist
);
2503 DEFUN ("widget-put", Fwidget_put
, Swidget_put
, 3, 3, 0,
2504 "In WIDGET, set PROPERTY to VALUE.\n\
2505 The value can later be retrieved with `widget-get'.")
2506 (widget
, property
, value
)
2507 Lisp_Object widget
, property
, value
;
2509 CHECK_CONS (widget
, 1);
2510 XCDR (widget
) = Fplist_put (XCDR (widget
), property
, value
);
2513 DEFUN ("widget-get", Fwidget_get
, Swidget_get
, 2, 2, 0,
2514 "In WIDGET, get the value of PROPERTY.\n\
2515 The value could either be specified when the widget was created, or\n\
2516 later with `widget-put'.")
2518 Lisp_Object widget
, property
;
2526 CHECK_CONS (widget
, 1);
2527 tmp
= Fwidget_plist_member (XCDR (widget
), property
);
2533 tmp
= XCAR (widget
);
2536 widget
= Fget (tmp
, Qwidget_type
);
2540 DEFUN ("widget-apply", Fwidget_apply
, Swidget_apply
, 2, MANY
, 0,
2541 "Apply the value of WIDGET's PROPERTY to the widget itself.\n\
2542 ARGS are passed as extra arguments to the function.")
2547 /* This function can GC. */
2548 Lisp_Object newargs
[3];
2549 struct gcpro gcpro1
, gcpro2
;
2552 newargs
[0] = Fwidget_get (args
[0], args
[1]);
2553 newargs
[1] = args
[0];
2554 newargs
[2] = Flist (nargs
- 2, args
+ 2);
2555 GCPRO2 (newargs
[0], newargs
[2]);
2556 result
= Fapply (3, newargs
);
2564 Qstring_lessp
= intern ("string-lessp");
2565 staticpro (&Qstring_lessp
);
2566 Qprovide
= intern ("provide");
2567 staticpro (&Qprovide
);
2568 Qrequire
= intern ("require");
2569 staticpro (&Qrequire
);
2570 Qyes_or_no_p_history
= intern ("yes-or-no-p-history");
2571 staticpro (&Qyes_or_no_p_history
);
2572 Qcursor_in_echo_area
= intern ("cursor-in-echo-area");
2573 staticpro (&Qcursor_in_echo_area
);
2574 Qwidget_type
= intern ("widget-type");
2575 staticpro (&Qwidget_type
);
2577 staticpro (&string_char_byte_cache_string
);
2578 string_char_byte_cache_string
= Qnil
;
2580 Fset (Qyes_or_no_p_history
, Qnil
);
2582 DEFVAR_LISP ("features", &Vfeatures
,
2583 "A list of symbols which are the features of the executing emacs.\n\
2584 Used by `featurep' and `require', and altered by `provide'.");
2587 DEFVAR_BOOL ("use-dialog-box", &use_dialog_box
,
2588 "*Non-nil means mouse commands use dialog boxes to ask questions.\n\
2589 This applies to y-or-n and yes-or-no questions asked by commands\n\
2590 invoked by mouse clicks and mouse menu items.");
2593 defsubr (&Sidentity
);
2596 defsubr (&Ssafe_length
);
2597 defsubr (&Sstring_bytes
);
2598 defsubr (&Sstring_equal
);
2599 defsubr (&Sstring_lessp
);
2602 defsubr (&Svconcat
);
2603 defsubr (&Scopy_sequence
);
2604 defsubr (&Sstring_make_multibyte
);
2605 defsubr (&Sstring_make_unibyte
);
2606 defsubr (&Sstring_as_multibyte
);
2607 defsubr (&Sstring_as_unibyte
);
2608 defsubr (&Scopy_alist
);
2609 defsubr (&Ssubstring
);
2621 defsubr (&Snreverse
);
2622 defsubr (&Sreverse
);
2624 defsubr (&Splist_get
);
2626 defsubr (&Splist_put
);
2629 defsubr (&Sfillarray
);
2630 defsubr (&Schar_table_subtype
);
2631 defsubr (&Schar_table_parent
);
2632 defsubr (&Sset_char_table_parent
);
2633 defsubr (&Schar_table_extra_slot
);
2634 defsubr (&Sset_char_table_extra_slot
);
2635 defsubr (&Schar_table_range
);
2636 defsubr (&Sset_char_table_range
);
2637 defsubr (&Sset_char_table_default
);
2638 defsubr (&Smap_char_table
);
2641 defsubr (&Smapconcat
);
2642 defsubr (&Sy_or_n_p
);
2643 defsubr (&Syes_or_no_p
);
2644 defsubr (&Sload_average
);
2645 defsubr (&Sfeaturep
);
2646 defsubr (&Srequire
);
2647 defsubr (&Sprovide
);
2648 defsubr (&Swidget_plist_member
);
2649 defsubr (&Swidget_put
);
2650 defsubr (&Swidget_get
);
2651 defsubr (&Swidget_apply
);