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 /* Nonzero enables use of dialog boxes for questions
44 asked by mouse commands. */
47 extern Lisp_Object
Flookup_key ();
49 extern int minibuffer_auto_raise
;
50 extern Lisp_Object minibuf_window
;
52 Lisp_Object Qstring_lessp
, Qprovide
, Qrequire
;
53 Lisp_Object Qyes_or_no_p_history
;
54 Lisp_Object Qcursor_in_echo_area
;
55 Lisp_Object Qwidget_type
;
57 static int internal_equal ();
59 DEFUN ("identity", Fidentity
, Sidentity
, 1, 1, 0,
60 "Return the argument unchanged.")
67 extern long get_random ();
68 extern void seed_random ();
71 DEFUN ("random", Frandom
, Srandom
, 0, 1, 0,
72 "Return a pseudo-random number.\n\
73 All integers representable in Lisp are equally likely.\n\
74 On most systems, this is 28 bits' worth.\n\
75 With positive integer argument N, return random number in interval [0,N).\n\
76 With argument t, set the random number seed from the current time and pid.")
81 Lisp_Object lispy_val
;
82 unsigned long denominator
;
85 seed_random (getpid () + time (NULL
));
86 if (NATNUMP (n
) && XFASTINT (n
) != 0)
88 /* Try to take our random number from the higher bits of VAL,
89 not the lower, since (says Gentzel) the low bits of `random'
90 are less random than the higher ones. We do this by using the
91 quotient rather than the remainder. At the high end of the RNG
92 it's possible to get a quotient larger than n; discarding
93 these values eliminates the bias that would otherwise appear
94 when using a large n. */
95 denominator
= ((unsigned long)1 << VALBITS
) / XFASTINT (n
);
97 val
= get_random () / denominator
;
98 while (val
>= XFASTINT (n
));
102 XSETINT (lispy_val
, val
);
106 /* Random data-structure functions */
108 DEFUN ("length", Flength
, Slength
, 1, 1, 0,
109 "Return the length of vector, list or string SEQUENCE.\n\
110 A byte-code function object is also allowed.\n\
111 If the string contains multibyte characters, this is not the necessarily\n\
112 the number of bytes in the string; it is the number of characters.\n\
113 To get the number of bytes, use `string-bytes'")
115 register Lisp_Object sequence
;
117 register Lisp_Object tail
, val
;
121 if (STRINGP (sequence
))
122 XSETFASTINT (val
, XSTRING (sequence
)->size
);
123 else if (VECTORP (sequence
))
124 XSETFASTINT (val
, XVECTOR (sequence
)->size
);
125 else if (CHAR_TABLE_P (sequence
))
126 XSETFASTINT (val
, (MIN_CHAR_COMPOSITION
127 + (CHAR_FIELD2_MASK
| CHAR_FIELD3_MASK
)
129 else if (BOOL_VECTOR_P (sequence
))
130 XSETFASTINT (val
, XBOOL_VECTOR (sequence
)->size
);
131 else if (COMPILEDP (sequence
))
132 XSETFASTINT (val
, XVECTOR (sequence
)->size
& PSEUDOVECTOR_SIZE_MASK
);
133 else if (CONSP (sequence
))
135 for (i
= 0, tail
= sequence
; !NILP (tail
); i
++)
141 XSETFASTINT (val
, i
);
143 else if (NILP (sequence
))
144 XSETFASTINT (val
, 0);
147 sequence
= wrong_type_argument (Qsequencep
, sequence
);
153 /* This does not check for quits. That is safe
154 since it must terminate. */
156 DEFUN ("safe-length", Fsafe_length
, Ssafe_length
, 1, 1, 0,
157 "Return the length of a list, but avoid error or infinite loop.\n\
158 This function never gets an error. If LIST is not really a list,\n\
159 it returns 0. If LIST is circular, it returns a finite value\n\
160 which is at least the number of distinct elements.")
164 Lisp_Object tail
, halftail
, length
;
167 /* halftail is used to detect circular lists. */
169 for (tail
= list
; CONSP (tail
); tail
= XCONS (tail
)->cdr
)
171 if (EQ (tail
, halftail
) && len
!= 0)
175 halftail
= XCONS (halftail
)->cdr
;
178 XSETINT (length
, len
);
182 DEFUN ("string-bytes", Fstring_bytes
, Sstring_bytes
, 1, 1, 0,
183 "Return the number of bytes in STRING.\n\
184 If STRING is a multibyte string, this is greater than the length of STRING.")
188 CHECK_STRING (string
, 1);
189 return make_number (STRING_BYTES (XSTRING (string
)));
192 DEFUN ("string-equal", Fstring_equal
, Sstring_equal
, 2, 2, 0,
193 "Return t if two strings have identical contents.\n\
194 Case is significant, but text properties are ignored.\n\
195 Symbols are also allowed; their print names are used instead.")
197 register Lisp_Object s1
, s2
;
200 XSETSTRING (s1
, XSYMBOL (s1
)->name
);
202 XSETSTRING (s2
, XSYMBOL (s2
)->name
);
203 CHECK_STRING (s1
, 0);
204 CHECK_STRING (s2
, 1);
206 if (XSTRING (s1
)->size
!= XSTRING (s2
)->size
207 || STRING_BYTES (XSTRING (s1
)) != STRING_BYTES (XSTRING (s2
))
208 || bcmp (XSTRING (s1
)->data
, XSTRING (s2
)->data
, STRING_BYTES (XSTRING (s1
))))
213 DEFUN ("string-lessp", Fstring_lessp
, Sstring_lessp
, 2, 2, 0,
214 "Return t if first arg string is less than second in lexicographic order.\n\
215 Case is significant.\n\
216 Symbols are also allowed; their print names are used instead.")
218 register Lisp_Object s1
, s2
;
221 register int i1
, i1_byte
, i2
, i2_byte
;
224 XSETSTRING (s1
, XSYMBOL (s1
)->name
);
226 XSETSTRING (s2
, XSYMBOL (s2
)->name
);
227 CHECK_STRING (s1
, 0);
228 CHECK_STRING (s2
, 1);
230 i1
= i1_byte
= i2
= i2_byte
= 0;
232 end
= XSTRING (s1
)->size
;
233 if (end
> XSTRING (s2
)->size
)
234 end
= XSTRING (s2
)->size
;
238 /* When we find a mismatch, we must compare the
239 characters, not just the bytes. */
242 if (STRING_MULTIBYTE (s1
))
243 FETCH_STRING_CHAR_ADVANCE (c1
, s1
, i1
, i1_byte
);
245 c1
= XSTRING (s1
)->data
[i1
++];
247 if (STRING_MULTIBYTE (s2
))
248 FETCH_STRING_CHAR_ADVANCE (c2
, s2
, i2
, i2_byte
);
250 c2
= XSTRING (s2
)->data
[i2
++];
253 return c1
< c2
? Qt
: Qnil
;
255 return i1
< XSTRING (s2
)->size
? Qt
: Qnil
;
258 static Lisp_Object
concat ();
269 return concat (2, args
, Lisp_String
, 0);
271 return concat (2, &s1
, Lisp_String
, 0);
272 #endif /* NO_ARG_ARRAY */
278 Lisp_Object s1
, s2
, s3
;
285 return concat (3, args
, Lisp_String
, 0);
287 return concat (3, &s1
, Lisp_String
, 0);
288 #endif /* NO_ARG_ARRAY */
291 DEFUN ("append", Fappend
, Sappend
, 0, MANY
, 0,
292 "Concatenate all the arguments and make the result a list.\n\
293 The result is a list whose elements are the elements of all the arguments.\n\
294 Each argument may be a list, vector or string.\n\
295 The last argument is not copied, just used as the tail of the new list.")
300 return concat (nargs
, args
, Lisp_Cons
, 1);
303 DEFUN ("concat", Fconcat
, Sconcat
, 0, MANY
, 0,
304 "Concatenate all the arguments and make the result a string.\n\
305 The result is a string whose elements are the elements of all the arguments.\n\
306 Each argument may be a string or a list or vector of characters (integers).\n\
308 Do not use individual integers as arguments!\n\
309 The behavior of `concat' in that case will be changed later!\n\
310 If your program passes an integer as an argument to `concat',\n\
311 you should change it right away not to do so.")
316 return concat (nargs
, args
, Lisp_String
, 0);
319 DEFUN ("vconcat", Fvconcat
, Svconcat
, 0, MANY
, 0,
320 "Concatenate all the arguments and make the result a vector.\n\
321 The result is a vector whose elements are the elements of all the arguments.\n\
322 Each argument may be a list, vector or string.")
327 return concat (nargs
, args
, Lisp_Vectorlike
, 0);
330 /* Retrun a copy of a sub char table ARG. The elements except for a
331 nested sub char table are not copied. */
333 copy_sub_char_table (arg
)
336 Lisp_Object copy
= make_sub_char_table (XCHAR_TABLE (arg
)->defalt
);
339 /* Copy all the contents. */
340 bcopy (XCHAR_TABLE (arg
)->contents
, XCHAR_TABLE (copy
)->contents
,
341 SUB_CHAR_TABLE_ORDINARY_SLOTS
* sizeof (Lisp_Object
));
342 /* Recursively copy any sub char-tables in the ordinary slots. */
343 for (i
= 32; i
< SUB_CHAR_TABLE_ORDINARY_SLOTS
; i
++)
344 if (SUB_CHAR_TABLE_P (XCHAR_TABLE (arg
)->contents
[i
]))
345 XCHAR_TABLE (copy
)->contents
[i
]
346 = copy_sub_char_table (XCHAR_TABLE (copy
)->contents
[i
]);
352 DEFUN ("copy-sequence", Fcopy_sequence
, Scopy_sequence
, 1, 1, 0,
353 "Return a copy of a list, vector or string.\n\
354 The elements of a list or vector are not copied; they are shared\n\
359 if (NILP (arg
)) return arg
;
361 if (CHAR_TABLE_P (arg
))
366 copy
= Fmake_char_table (XCHAR_TABLE (arg
)->purpose
, Qnil
);
367 /* Copy all the slots, including the extra ones. */
368 bcopy (XVECTOR (arg
)->contents
, XVECTOR (copy
)->contents
,
369 ((XCHAR_TABLE (arg
)->size
& PSEUDOVECTOR_SIZE_MASK
)
370 * sizeof (Lisp_Object
)));
372 /* Recursively copy any sub char tables in the ordinary slots
373 for multibyte characters. */
374 for (i
= CHAR_TABLE_SINGLE_BYTE_SLOTS
;
375 i
< CHAR_TABLE_ORDINARY_SLOTS
; i
++)
376 if (SUB_CHAR_TABLE_P (XCHAR_TABLE (arg
)->contents
[i
]))
377 XCHAR_TABLE (copy
)->contents
[i
]
378 = copy_sub_char_table (XCHAR_TABLE (copy
)->contents
[i
]);
383 if (BOOL_VECTOR_P (arg
))
387 = (XBOOL_VECTOR (arg
)->size
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
;
389 val
= Fmake_bool_vector (Flength (arg
), Qnil
);
390 bcopy (XBOOL_VECTOR (arg
)->data
, XBOOL_VECTOR (val
)->data
,
395 if (!CONSP (arg
) && !VECTORP (arg
) && !STRINGP (arg
))
396 arg
= wrong_type_argument (Qsequencep
, arg
);
397 return concat (1, &arg
, CONSP (arg
) ? Lisp_Cons
: XTYPE (arg
), 0);
401 concat (nargs
, args
, target_type
, last_special
)
404 enum Lisp_Type target_type
;
408 register Lisp_Object tail
;
409 register Lisp_Object
this;
412 register int result_len
;
413 register int result_len_byte
;
415 Lisp_Object last_tail
;
419 /* In append, the last arg isn't treated like the others */
420 if (last_special
&& nargs
> 0)
423 last_tail
= args
[nargs
];
428 /* Canonicalize each argument. */
429 for (argnum
= 0; argnum
< nargs
; argnum
++)
432 if (!(CONSP (this) || NILP (this) || VECTORP (this) || STRINGP (this)
433 || COMPILEDP (this) || BOOL_VECTOR_P (this)))
436 args
[argnum
] = Fnumber_to_string (this);
438 args
[argnum
] = wrong_type_argument (Qsequencep
, this);
442 /* Compute total length in chars of arguments in RESULT_LEN.
443 If desired output is a string, also compute length in bytes
444 in RESULT_LEN_BYTE, and determine in SOME_MULTIBYTE
445 whether the result should be a multibyte string. */
449 for (argnum
= 0; argnum
< nargs
; argnum
++)
453 len
= XFASTINT (Flength (this));
454 if (target_type
== Lisp_String
)
456 /* We must count the number of bytes needed in the string
457 as well as the number of characters. */
463 for (i
= 0; i
< len
; i
++)
465 ch
= XVECTOR (this)->contents
[i
];
467 wrong_type_argument (Qintegerp
, ch
);
468 this_len_byte
= XFASTINT (Fchar_bytes (ch
));
469 result_len_byte
+= this_len_byte
;
470 if (this_len_byte
> 1)
473 else if (BOOL_VECTOR_P (this) && XBOOL_VECTOR (this)->size
> 0)
474 wrong_type_argument (Qintegerp
, Faref (this, make_number (0)));
475 else if (CONSP (this))
476 for (; CONSP (this); this = XCONS (this)->cdr
)
478 ch
= XCONS (this)->car
;
480 wrong_type_argument (Qintegerp
, ch
);
481 this_len_byte
= XFASTINT (Fchar_bytes (ch
));
482 result_len_byte
+= this_len_byte
;
483 if (this_len_byte
> 1)
486 else if (STRINGP (this))
488 if (STRING_MULTIBYTE (this))
491 result_len_byte
+= STRING_BYTES (XSTRING (this));
494 result_len_byte
+= count_size_as_multibyte (XSTRING (this)->data
,
495 XSTRING (this)->size
);
502 if (! some_multibyte
)
503 result_len_byte
= result_len
;
505 /* Create the output object. */
506 if (target_type
== Lisp_Cons
)
507 val
= Fmake_list (make_number (result_len
), Qnil
);
508 else if (target_type
== Lisp_Vectorlike
)
509 val
= Fmake_vector (make_number (result_len
), Qnil
);
510 else if (some_multibyte
)
511 val
= make_uninit_multibyte_string (result_len
, result_len_byte
);
513 val
= make_uninit_string (result_len
);
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
= STRING_BYTES (XSTRING (this));
548 bcopy (XSTRING (this)->data
, XSTRING (val
)->data
+ toindex_byte
,
549 STRING_BYTES (XSTRING (this)));
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))
577 if (STRING_MULTIBYTE (this))
579 FETCH_STRING_CHAR_ADVANCE (c
, this,
582 XSETFASTINT (elt
, c
);
586 XSETFASTINT (elt
, XSTRING (this)->data
[thisindex
++]);
587 if (some_multibyte
&& XINT (elt
) >= 0200
588 && XINT (elt
) < 0400)
590 c
= unibyte_char_to_multibyte (XINT (elt
));
595 else if (BOOL_VECTOR_P (this))
598 byte
= XBOOL_VECTOR (this)->data
[thisindex
/ BITS_PER_CHAR
];
599 if (byte
& (1 << (thisindex
% BITS_PER_CHAR
)))
606 elt
= XVECTOR (this)->contents
[thisindex
++];
608 /* Store this element into the result. */
611 XCONS (tail
)->car
= elt
;
613 tail
= XCONS (tail
)->cdr
;
615 else if (VECTORP (val
))
616 XVECTOR (val
)->contents
[toindex
++] = elt
;
619 CHECK_NUMBER (elt
, 0);
620 if (SINGLE_BYTE_CHAR_P (XINT (elt
)))
622 XSTRING (val
)->data
[toindex
++] = XINT (elt
);
626 /* If we have any multibyte characters,
627 we already decided to make a multibyte string. */
630 unsigned char work
[4], *str
;
631 int i
= CHAR_STRING (c
, work
, str
);
633 /* P exists as a variable
634 to avoid a bug on the Masscomp C compiler. */
635 unsigned char *p
= & XSTRING (val
)->data
[toindex_byte
];
644 XCONS (prev
)->cdr
= last_tail
;
649 static Lisp_Object string_char_byte_cache_string
;
650 static int string_char_byte_cache_charpos
;
651 static int string_char_byte_cache_bytepos
;
653 /* Return the character index corresponding to CHAR_INDEX in STRING. */
656 string_char_to_byte (string
, char_index
)
661 int best_below
, best_below_byte
;
662 int best_above
, best_above_byte
;
664 if (! STRING_MULTIBYTE (string
))
667 best_below
= best_below_byte
= 0;
668 best_above
= XSTRING (string
)->size
;
669 best_above_byte
= STRING_BYTES (XSTRING (string
));
671 if (EQ (string
, string_char_byte_cache_string
))
673 if (string_char_byte_cache_charpos
< char_index
)
675 best_below
= string_char_byte_cache_charpos
;
676 best_below_byte
= string_char_byte_cache_bytepos
;
680 best_above
= string_char_byte_cache_charpos
;
681 best_above_byte
= string_char_byte_cache_bytepos
;
685 if (char_index
- best_below
< best_above
- char_index
)
687 while (best_below
< char_index
)
690 FETCH_STRING_CHAR_ADVANCE (c
, string
, best_below
, best_below_byte
);
693 i_byte
= best_below_byte
;
697 while (best_above
> char_index
)
699 int best_above_byte_saved
= --best_above_byte
;
701 while (best_above_byte
> 0
702 && !CHAR_HEAD_P (XSTRING (string
)->data
[best_above_byte
]))
704 if (XSTRING (string
)->data
[best_above_byte
] < 0x80)
705 best_above_byte
= best_above_byte_saved
;
709 i_byte
= best_above_byte
;
712 string_char_byte_cache_bytepos
= i_byte
;
713 string_char_byte_cache_charpos
= i
;
714 string_char_byte_cache_string
= string
;
719 /* Return the character index corresponding to BYTE_INDEX in STRING. */
722 string_byte_to_char (string
, byte_index
)
727 int best_below
, best_below_byte
;
728 int best_above
, best_above_byte
;
730 if (! STRING_MULTIBYTE (string
))
733 best_below
= best_below_byte
= 0;
734 best_above
= XSTRING (string
)->size
;
735 best_above_byte
= STRING_BYTES (XSTRING (string
));
737 if (EQ (string
, string_char_byte_cache_string
))
739 if (string_char_byte_cache_bytepos
< byte_index
)
741 best_below
= string_char_byte_cache_charpos
;
742 best_below_byte
= string_char_byte_cache_bytepos
;
746 best_above
= string_char_byte_cache_charpos
;
747 best_above_byte
= string_char_byte_cache_bytepos
;
751 if (byte_index
- best_below_byte
< best_above_byte
- byte_index
)
753 while (best_below_byte
< byte_index
)
756 FETCH_STRING_CHAR_ADVANCE (c
, string
, best_below
, best_below_byte
);
759 i_byte
= best_below_byte
;
763 while (best_above_byte
> byte_index
)
765 int best_above_byte_saved
= --best_above_byte
;
767 while (best_above_byte
> 0
768 && !CHAR_HEAD_P (XSTRING (string
)->data
[best_above_byte
]))
770 if (XSTRING (string
)->data
[best_above_byte
] < 0x80)
771 best_above_byte
= best_above_byte_saved
;
775 i_byte
= best_above_byte
;
778 string_char_byte_cache_bytepos
= i_byte
;
779 string_char_byte_cache_charpos
= i
;
780 string_char_byte_cache_string
= string
;
785 /* Convert STRING to a multibyte string.
786 Single-byte characters 0240 through 0377 are converted
787 by adding nonascii_insert_offset to each. */
790 string_make_multibyte (string
)
796 if (STRING_MULTIBYTE (string
))
799 nbytes
= count_size_as_multibyte (XSTRING (string
)->data
,
800 XSTRING (string
)->size
);
801 /* If all the chars are ASCII, they won't need any more bytes
802 once converted. In that case, we can return STRING itself. */
803 if (nbytes
== STRING_BYTES (XSTRING (string
)))
806 buf
= (unsigned char *) alloca (nbytes
);
807 copy_text (XSTRING (string
)->data
, buf
, STRING_BYTES (XSTRING (string
)),
810 return make_multibyte_string (buf
, XSTRING (string
)->size
, nbytes
);
813 /* Convert STRING to a single-byte string. */
816 string_make_unibyte (string
)
821 if (! STRING_MULTIBYTE (string
))
824 buf
= (unsigned char *) alloca (XSTRING (string
)->size
);
826 copy_text (XSTRING (string
)->data
, buf
, STRING_BYTES (XSTRING (string
)),
829 return make_unibyte_string (buf
, XSTRING (string
)->size
);
832 DEFUN ("string-make-multibyte", Fstring_make_multibyte
, Sstring_make_multibyte
,
834 "Return the multibyte equivalent of STRING.")
838 return string_make_multibyte (string
);
841 DEFUN ("string-make-unibyte", Fstring_make_unibyte
, Sstring_make_unibyte
,
843 "Return the unibyte equivalent of STRING.")
847 return string_make_unibyte (string
);
850 DEFUN ("string-as-unibyte", Fstring_as_unibyte
, Sstring_as_unibyte
,
852 "Return a unibyte string with the same individual bytes as STRING.\n\
853 If STRING is unibyte, the result is STRING itself.")
857 if (STRING_MULTIBYTE (string
))
859 string
= Fcopy_sequence (string
);
860 XSTRING (string
)->size
= STRING_BYTES (XSTRING (string
));
861 SET_STRING_BYTES (XSTRING (string
), -1);
866 DEFUN ("string-as-multibyte", Fstring_as_multibyte
, Sstring_as_multibyte
,
868 "Return a multibyte string with the same individual bytes as STRING.\n\
869 If STRING is multibyte, the result is STRING itself.")
873 if (! STRING_MULTIBYTE (string
))
875 int nbytes
= STRING_BYTES (XSTRING (string
));
876 int newlen
= multibyte_chars_in_text (XSTRING (string
)->data
, nbytes
);
878 string
= Fcopy_sequence (string
);
879 XSTRING (string
)->size
= newlen
;
880 XSTRING (string
)->size_byte
= nbytes
;
885 DEFUN ("copy-alist", Fcopy_alist
, Scopy_alist
, 1, 1, 0,
886 "Return a copy of ALIST.\n\
887 This is an alist which represents the same mapping from objects to objects,\n\
888 but does not share the alist structure with ALIST.\n\
889 The objects mapped (cars and cdrs of elements of the alist)\n\
890 are shared, however.\n\
891 Elements of ALIST that are not conses are also shared.")
895 register Lisp_Object tem
;
897 CHECK_LIST (alist
, 0);
900 alist
= concat (1, &alist
, Lisp_Cons
, 0);
901 for (tem
= alist
; CONSP (tem
); tem
= XCONS (tem
)->cdr
)
903 register Lisp_Object car
;
904 car
= XCONS (tem
)->car
;
907 XCONS (tem
)->car
= Fcons (XCONS (car
)->car
, XCONS (car
)->cdr
);
912 DEFUN ("substring", Fsubstring
, Ssubstring
, 2, 3, 0,
913 "Return a substring of STRING, starting at index FROM and ending before TO.\n\
914 TO may be nil or omitted; then the substring runs to the end of STRING.\n\
915 If FROM or TO is negative, it counts from the end.\n\
917 This function allows vectors as well as strings.")
920 register Lisp_Object from
, to
;
925 int from_char
, to_char
;
926 int from_byte
, to_byte
;
928 if (! (STRINGP (string
) || VECTORP (string
)))
929 wrong_type_argument (Qarrayp
, string
);
931 CHECK_NUMBER (from
, 1);
933 if (STRINGP (string
))
935 size
= XSTRING (string
)->size
;
936 size_byte
= STRING_BYTES (XSTRING (string
));
939 size
= XVECTOR (string
)->size
;
948 CHECK_NUMBER (to
, 2);
954 if (STRINGP (string
))
955 to_byte
= string_char_to_byte (string
, to_char
);
958 from_char
= XINT (from
);
961 if (STRINGP (string
))
962 from_byte
= string_char_to_byte (string
, from_char
);
964 if (!(0 <= from_char
&& from_char
<= to_char
&& to_char
<= size
))
965 args_out_of_range_3 (string
, make_number (from_char
),
966 make_number (to_char
));
968 if (STRINGP (string
))
970 res
= make_specified_string (XSTRING (string
)->data
+ from_byte
,
971 to_char
- from_char
, to_byte
- from_byte
,
972 STRING_MULTIBYTE (string
));
973 copy_text_properties (from_char
, to_char
, string
,
974 make_number (0), res
, Qnil
);
977 res
= Fvector (to_char
- from_char
,
978 XVECTOR (string
)->contents
+ from_char
);
983 /* Extract a substring of STRING, giving start and end positions
984 both in characters and in bytes. */
987 substring_both (string
, from
, from_byte
, to
, to_byte
)
989 int from
, from_byte
, to
, to_byte
;
995 if (! (STRINGP (string
) || VECTORP (string
)))
996 wrong_type_argument (Qarrayp
, string
);
998 if (STRINGP (string
))
1000 size
= XSTRING (string
)->size
;
1001 size_byte
= STRING_BYTES (XSTRING (string
));
1004 size
= XVECTOR (string
)->size
;
1006 if (!(0 <= from
&& from
<= to
&& to
<= size
))
1007 args_out_of_range_3 (string
, make_number (from
), make_number (to
));
1009 if (STRINGP (string
))
1011 res
= make_specified_string (XSTRING (string
)->data
+ from_byte
,
1012 to
- from
, to_byte
- from_byte
,
1013 STRING_MULTIBYTE (string
));
1014 copy_text_properties (from
, to
, string
, make_number (0), res
, Qnil
);
1017 res
= Fvector (to
- from
,
1018 XVECTOR (string
)->contents
+ from
);
1023 DEFUN ("nthcdr", Fnthcdr
, Snthcdr
, 2, 2, 0,
1024 "Take cdr N times on LIST, returns the result.")
1027 register Lisp_Object list
;
1029 register int i
, num
;
1030 CHECK_NUMBER (n
, 0);
1032 for (i
= 0; i
< num
&& !NILP (list
); i
++)
1040 DEFUN ("nth", Fnth
, Snth
, 2, 2, 0,
1041 "Return the Nth element of LIST.\n\
1042 N counts from zero. If LIST is not that long, nil is returned.")
1044 Lisp_Object n
, list
;
1046 return Fcar (Fnthcdr (n
, list
));
1049 DEFUN ("elt", Felt
, Selt
, 2, 2, 0,
1050 "Return element of SEQUENCE at index N.")
1052 register Lisp_Object sequence
, n
;
1054 CHECK_NUMBER (n
, 0);
1057 if (CONSP (sequence
) || NILP (sequence
))
1058 return Fcar (Fnthcdr (n
, sequence
));
1059 else if (STRINGP (sequence
) || VECTORP (sequence
)
1060 || BOOL_VECTOR_P (sequence
) || CHAR_TABLE_P (sequence
))
1061 return Faref (sequence
, n
);
1063 sequence
= wrong_type_argument (Qsequencep
, sequence
);
1067 DEFUN ("member", Fmember
, Smember
, 2, 2, 0,
1068 "Return non-nil if ELT is an element of LIST. Comparison done with `equal'.\n\
1069 The value is actually the tail of LIST whose car is ELT.")
1071 register Lisp_Object elt
;
1074 register Lisp_Object tail
;
1075 for (tail
= list
; !NILP (tail
); tail
= XCONS (tail
)->cdr
)
1077 register Lisp_Object tem
;
1079 if (! NILP (Fequal (elt
, tem
)))
1086 DEFUN ("memq", Fmemq
, Smemq
, 2, 2, 0,
1087 "Return non-nil if ELT is an element of LIST. Comparison done with EQ.\n\
1088 The value is actually the tail of LIST whose car is ELT.")
1090 register Lisp_Object elt
;
1093 register Lisp_Object tail
;
1094 for (tail
= list
; !NILP (tail
); tail
= XCONS (tail
)->cdr
)
1096 register Lisp_Object tem
;
1098 if (EQ (elt
, tem
)) return tail
;
1104 DEFUN ("assq", Fassq
, Sassq
, 2, 2, 0,
1105 "Return non-nil if KEY is `eq' to the car of an element of LIST.\n\
1106 The value is actually the element of LIST whose car is KEY.\n\
1107 Elements of LIST that are not conses are ignored.")
1109 register Lisp_Object key
;
1112 register Lisp_Object tail
;
1113 for (tail
= list
; !NILP (tail
); tail
= XCONS (tail
)->cdr
)
1115 register Lisp_Object elt
, tem
;
1117 if (!CONSP (elt
)) continue;
1118 tem
= XCONS (elt
)->car
;
1119 if (EQ (key
, tem
)) return elt
;
1125 /* Like Fassq but never report an error and do not allow quits.
1126 Use only on lists known never to be circular. */
1129 assq_no_quit (key
, list
)
1130 register Lisp_Object key
;
1133 register Lisp_Object tail
;
1134 for (tail
= list
; CONSP (tail
); tail
= XCONS (tail
)->cdr
)
1136 register Lisp_Object elt
, tem
;
1138 if (!CONSP (elt
)) continue;
1139 tem
= XCONS (elt
)->car
;
1140 if (EQ (key
, tem
)) return elt
;
1145 DEFUN ("assoc", Fassoc
, Sassoc
, 2, 2, 0,
1146 "Return non-nil if KEY is `equal' to the car of an element of LIST.\n\
1147 The value is actually the element of LIST whose car equals KEY.")
1149 register Lisp_Object key
;
1152 register Lisp_Object tail
;
1153 for (tail
= list
; !NILP (tail
); tail
= XCONS (tail
)->cdr
)
1155 register Lisp_Object elt
, tem
;
1157 if (!CONSP (elt
)) continue;
1158 tem
= Fequal (XCONS (elt
)->car
, key
);
1159 if (!NILP (tem
)) return elt
;
1165 DEFUN ("rassq", Frassq
, Srassq
, 2, 2, 0,
1166 "Return non-nil if ELT is `eq' to the cdr of an element of LIST.\n\
1167 The value is actually the element of LIST whose cdr is ELT.")
1169 register Lisp_Object key
;
1172 register Lisp_Object tail
;
1173 for (tail
= list
; !NILP (tail
); tail
= XCONS (tail
)->cdr
)
1175 register Lisp_Object elt
, tem
;
1177 if (!CONSP (elt
)) continue;
1178 tem
= XCONS (elt
)->cdr
;
1179 if (EQ (key
, tem
)) return elt
;
1185 DEFUN ("rassoc", Frassoc
, Srassoc
, 2, 2, 0,
1186 "Return non-nil if KEY is `equal' to the cdr of an element of LIST.\n\
1187 The value is actually the element of LIST whose cdr equals KEY.")
1189 register Lisp_Object key
;
1192 register Lisp_Object tail
;
1193 for (tail
= list
; !NILP (tail
); tail
= XCONS (tail
)->cdr
)
1195 register Lisp_Object elt
, tem
;
1197 if (!CONSP (elt
)) continue;
1198 tem
= Fequal (XCONS (elt
)->cdr
, key
);
1199 if (!NILP (tem
)) return elt
;
1205 DEFUN ("delq", Fdelq
, Sdelq
, 2, 2, 0,
1206 "Delete by side effect any occurrences of ELT as a member of LIST.\n\
1207 The modified LIST is returned. Comparison is done with `eq'.\n\
1208 If the first member of LIST is ELT, there is no way to remove it by side effect;\n\
1209 therefore, write `(setq foo (delq element foo))'\n\
1210 to be sure of changing the value of `foo'.")
1212 register Lisp_Object elt
;
1215 register Lisp_Object tail
, prev
;
1216 register Lisp_Object tem
;
1220 while (!NILP (tail
))
1226 list
= XCONS (tail
)->cdr
;
1228 Fsetcdr (prev
, XCONS (tail
)->cdr
);
1232 tail
= XCONS (tail
)->cdr
;
1238 DEFUN ("delete", Fdelete
, Sdelete
, 2, 2, 0,
1239 "Delete by side effect any occurrences of ELT as a member of LIST.\n\
1240 The modified LIST is returned. Comparison is done with `equal'.\n\
1241 If the first member of LIST is ELT, deleting it is not a side effect;\n\
1242 it is simply using a different list.\n\
1243 Therefore, write `(setq foo (delete element foo))'\n\
1244 to be sure of changing the value of `foo'.")
1246 register Lisp_Object elt
;
1249 register Lisp_Object tail
, prev
;
1250 register Lisp_Object tem
;
1254 while (!NILP (tail
))
1257 if (! NILP (Fequal (elt
, tem
)))
1260 list
= XCONS (tail
)->cdr
;
1262 Fsetcdr (prev
, XCONS (tail
)->cdr
);
1266 tail
= XCONS (tail
)->cdr
;
1272 DEFUN ("nreverse", Fnreverse
, Snreverse
, 1, 1, 0,
1273 "Reverse LIST by modifying cdr pointers.\n\
1274 Returns the beginning of the reversed list.")
1278 register Lisp_Object prev
, tail
, next
;
1280 if (NILP (list
)) return list
;
1283 while (!NILP (tail
))
1287 Fsetcdr (tail
, prev
);
1294 DEFUN ("reverse", Freverse
, Sreverse
, 1, 1, 0,
1295 "Reverse LIST, copying. Returns the beginning of the reversed list.\n\
1296 See also the function `nreverse', which is used more often.")
1302 for (new = Qnil
; CONSP (list
); list
= XCONS (list
)->cdr
)
1303 new = Fcons (XCONS (list
)->car
, new);
1305 wrong_type_argument (Qconsp
, list
);
1309 Lisp_Object
merge ();
1311 DEFUN ("sort", Fsort
, Ssort
, 2, 2, 0,
1312 "Sort LIST, stably, comparing elements using PREDICATE.\n\
1313 Returns the sorted list. LIST is modified by side effects.\n\
1314 PREDICATE is called with two elements of LIST, and should return T\n\
1315 if the first element is \"less\" than the second.")
1317 Lisp_Object list
, predicate
;
1319 Lisp_Object front
, back
;
1320 register Lisp_Object len
, tem
;
1321 struct gcpro gcpro1
, gcpro2
;
1322 register int length
;
1325 len
= Flength (list
);
1326 length
= XINT (len
);
1330 XSETINT (len
, (length
/ 2) - 1);
1331 tem
= Fnthcdr (len
, list
);
1333 Fsetcdr (tem
, Qnil
);
1335 GCPRO2 (front
, back
);
1336 front
= Fsort (front
, predicate
);
1337 back
= Fsort (back
, predicate
);
1339 return merge (front
, back
, predicate
);
1343 merge (org_l1
, org_l2
, pred
)
1344 Lisp_Object org_l1
, org_l2
;
1348 register Lisp_Object tail
;
1350 register Lisp_Object l1
, l2
;
1351 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
1358 /* It is sufficient to protect org_l1 and org_l2.
1359 When l1 and l2 are updated, we copy the new values
1360 back into the org_ vars. */
1361 GCPRO4 (org_l1
, org_l2
, pred
, value
);
1381 tem
= call2 (pred
, Fcar (l2
), Fcar (l1
));
1397 Fsetcdr (tail
, tem
);
1403 DEFUN ("plist-get", Fplist_get
, Splist_get
, 2, 2, 0,
1404 "Extract a value from a property list.\n\
1405 PLIST is a property list, which is a list of the form\n\
1406 \(PROP1 VALUE1 PROP2 VALUE2...). This function returns the value\n\
1407 corresponding to the given PROP, or nil if PROP is not\n\
1408 one of the properties on the list.")
1411 register Lisp_Object prop
;
1413 register Lisp_Object tail
;
1414 for (tail
= plist
; !NILP (tail
); tail
= Fcdr (XCONS (tail
)->cdr
))
1416 register Lisp_Object tem
;
1419 return Fcar (XCONS (tail
)->cdr
);
1424 DEFUN ("get", Fget
, Sget
, 2, 2, 0,
1425 "Return the value of SYMBOL's PROPNAME property.\n\
1426 This is the last value stored with `(put SYMBOL PROPNAME VALUE)'.")
1428 Lisp_Object symbol
, propname
;
1430 CHECK_SYMBOL (symbol
, 0);
1431 return Fplist_get (XSYMBOL (symbol
)->plist
, propname
);
1434 DEFUN ("plist-put", Fplist_put
, Splist_put
, 3, 3, 0,
1435 "Change value in PLIST of PROP to VAL.\n\
1436 PLIST is a property list, which is a list of the form\n\
1437 \(PROP1 VALUE1 PROP2 VALUE2 ...). PROP is a symbol and VAL is any object.\n\
1438 If PROP is already a property on the list, its value is set to VAL,\n\
1439 otherwise the new PROP VAL pair is added. The new plist is returned;\n\
1440 use `(setq x (plist-put x prop val))' to be sure to use the new value.\n\
1441 The PLIST is modified by side effects.")
1444 register Lisp_Object prop
;
1447 register Lisp_Object tail
, prev
;
1448 Lisp_Object newcell
;
1450 for (tail
= plist
; CONSP (tail
) && CONSP (XCONS (tail
)->cdr
);
1451 tail
= XCONS (XCONS (tail
)->cdr
)->cdr
)
1453 if (EQ (prop
, XCONS (tail
)->car
))
1455 Fsetcar (XCONS (tail
)->cdr
, val
);
1460 newcell
= Fcons (prop
, Fcons (val
, Qnil
));
1464 Fsetcdr (XCONS (prev
)->cdr
, newcell
);
1468 DEFUN ("put", Fput
, Sput
, 3, 3, 0,
1469 "Store SYMBOL's PROPNAME property with value VALUE.\n\
1470 It can be retrieved with `(get SYMBOL PROPNAME)'.")
1471 (symbol
, propname
, value
)
1472 Lisp_Object symbol
, propname
, value
;
1474 CHECK_SYMBOL (symbol
, 0);
1475 XSYMBOL (symbol
)->plist
1476 = Fplist_put (XSYMBOL (symbol
)->plist
, propname
, value
);
1480 DEFUN ("equal", Fequal
, Sequal
, 2, 2, 0,
1481 "Return t if two Lisp objects have similar structure and contents.\n\
1482 They must have the same data type.\n\
1483 Conses are compared by comparing the cars and the cdrs.\n\
1484 Vectors and strings are compared element by element.\n\
1485 Numbers are compared by value, but integers cannot equal floats.\n\
1486 (Use `=' if you want integers and floats to be able to be equal.)\n\
1487 Symbols must match exactly.")
1489 register Lisp_Object o1
, o2
;
1491 return internal_equal (o1
, o2
, 0) ? Qt
: Qnil
;
1495 internal_equal (o1
, o2
, depth
)
1496 register Lisp_Object o1
, o2
;
1500 error ("Stack overflow in equal");
1506 if (XTYPE (o1
) != XTYPE (o2
))
1511 #ifdef LISP_FLOAT_TYPE
1513 return (extract_float (o1
) == extract_float (o2
));
1517 if (!internal_equal (XCONS (o1
)->car
, XCONS (o2
)->car
, depth
+ 1))
1519 o1
= XCONS (o1
)->cdr
;
1520 o2
= XCONS (o2
)->cdr
;
1524 if (XMISCTYPE (o1
) != XMISCTYPE (o2
))
1528 if (!internal_equal (OVERLAY_START (o1
), OVERLAY_START (o1
),
1530 || !internal_equal (OVERLAY_END (o1
), OVERLAY_END (o1
),
1533 o1
= XOVERLAY (o1
)->plist
;
1534 o2
= XOVERLAY (o2
)->plist
;
1539 return (XMARKER (o1
)->buffer
== XMARKER (o2
)->buffer
1540 && (XMARKER (o1
)->buffer
== 0
1541 || XMARKER (o1
)->bytepos
== XMARKER (o2
)->bytepos
));
1545 case Lisp_Vectorlike
:
1547 register int i
, size
;
1548 size
= XVECTOR (o1
)->size
;
1549 /* Pseudovectors have the type encoded in the size field, so this test
1550 actually checks that the objects have the same type as well as the
1552 if (XVECTOR (o2
)->size
!= size
)
1554 /* Boolvectors are compared much like strings. */
1555 if (BOOL_VECTOR_P (o1
))
1558 = (XBOOL_VECTOR (o1
)->size
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
;
1560 if (XBOOL_VECTOR (o1
)->size
!= XBOOL_VECTOR (o2
)->size
)
1562 if (bcmp (XBOOL_VECTOR (o1
)->data
, XBOOL_VECTOR (o2
)->data
,
1567 if (WINDOW_CONFIGURATIONP (o1
))
1568 return compare_window_configurations (o1
, o2
, 0);
1570 /* Aside from them, only true vectors, char-tables, and compiled
1571 functions are sensible to compare, so eliminate the others now. */
1572 if (size
& PSEUDOVECTOR_FLAG
)
1574 if (!(size
& (PVEC_COMPILED
| PVEC_CHAR_TABLE
)))
1576 size
&= PSEUDOVECTOR_SIZE_MASK
;
1578 for (i
= 0; i
< size
; i
++)
1581 v1
= XVECTOR (o1
)->contents
[i
];
1582 v2
= XVECTOR (o2
)->contents
[i
];
1583 if (!internal_equal (v1
, v2
, depth
+ 1))
1591 if (XSTRING (o1
)->size
!= XSTRING (o2
)->size
)
1593 if (STRING_BYTES (XSTRING (o1
)) != STRING_BYTES (XSTRING (o2
)))
1595 if (bcmp (XSTRING (o1
)->data
, XSTRING (o2
)->data
,
1596 STRING_BYTES (XSTRING (o1
))))
1603 extern Lisp_Object
Fmake_char_internal ();
1605 DEFUN ("fillarray", Ffillarray
, Sfillarray
, 2, 2, 0,
1606 "Store each element of ARRAY with ITEM.\n\
1607 ARRAY is a vector, string, char-table, or bool-vector.")
1609 Lisp_Object array
, item
;
1611 register int size
, index
, charval
;
1613 if (VECTORP (array
))
1615 register Lisp_Object
*p
= XVECTOR (array
)->contents
;
1616 size
= XVECTOR (array
)->size
;
1617 for (index
= 0; index
< size
; index
++)
1620 else if (CHAR_TABLE_P (array
))
1622 register Lisp_Object
*p
= XCHAR_TABLE (array
)->contents
;
1623 size
= CHAR_TABLE_ORDINARY_SLOTS
;
1624 for (index
= 0; index
< size
; index
++)
1626 XCHAR_TABLE (array
)->defalt
= Qnil
;
1628 else if (STRINGP (array
))
1630 register unsigned char *p
= XSTRING (array
)->data
;
1631 CHECK_NUMBER (item
, 1);
1632 charval
= XINT (item
);
1633 size
= XSTRING (array
)->size
;
1634 for (index
= 0; index
< size
; index
++)
1637 else if (BOOL_VECTOR_P (array
))
1639 register unsigned char *p
= XBOOL_VECTOR (array
)->data
;
1641 = (XBOOL_VECTOR (array
)->size
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
;
1643 charval
= (! NILP (item
) ? -1 : 0);
1644 for (index
= 0; index
< size_in_chars
; index
++)
1649 array
= wrong_type_argument (Qarrayp
, array
);
1655 DEFUN ("char-table-subtype", Fchar_table_subtype
, Schar_table_subtype
,
1657 "Return the subtype of char-table CHAR-TABLE. The value is a symbol.")
1659 Lisp_Object char_table
;
1661 CHECK_CHAR_TABLE (char_table
, 0);
1663 return XCHAR_TABLE (char_table
)->purpose
;
1666 DEFUN ("char-table-parent", Fchar_table_parent
, Schar_table_parent
,
1668 "Return the parent char-table of CHAR-TABLE.\n\
1669 The value is either nil or another char-table.\n\
1670 If CHAR-TABLE holds nil for a given character,\n\
1671 then the actual applicable value is inherited from the parent char-table\n\
1672 \(or from its parents, if necessary).")
1674 Lisp_Object char_table
;
1676 CHECK_CHAR_TABLE (char_table
, 0);
1678 return XCHAR_TABLE (char_table
)->parent
;
1681 DEFUN ("set-char-table-parent", Fset_char_table_parent
, Sset_char_table_parent
,
1683 "Set the parent char-table of CHAR-TABLE to PARENT.\n\
1684 PARENT must be either nil or another char-table.")
1685 (char_table
, parent
)
1686 Lisp_Object char_table
, parent
;
1690 CHECK_CHAR_TABLE (char_table
, 0);
1694 CHECK_CHAR_TABLE (parent
, 0);
1696 for (temp
= parent
; !NILP (temp
); temp
= XCHAR_TABLE (temp
)->parent
)
1697 if (EQ (temp
, char_table
))
1698 error ("Attempt to make a chartable be its own parent");
1701 XCHAR_TABLE (char_table
)->parent
= parent
;
1706 DEFUN ("char-table-extra-slot", Fchar_table_extra_slot
, Schar_table_extra_slot
,
1708 "Return the value of CHAR-TABLE's extra-slot number N.")
1710 Lisp_Object char_table
, n
;
1712 CHECK_CHAR_TABLE (char_table
, 1);
1713 CHECK_NUMBER (n
, 2);
1715 || XINT (n
) >= CHAR_TABLE_EXTRA_SLOTS (XCHAR_TABLE (char_table
)))
1716 args_out_of_range (char_table
, n
);
1718 return XCHAR_TABLE (char_table
)->extras
[XINT (n
)];
1721 DEFUN ("set-char-table-extra-slot", Fset_char_table_extra_slot
,
1722 Sset_char_table_extra_slot
,
1724 "Set CHAR-TABLE's extra-slot number N to VALUE.")
1725 (char_table
, n
, value
)
1726 Lisp_Object char_table
, n
, value
;
1728 CHECK_CHAR_TABLE (char_table
, 1);
1729 CHECK_NUMBER (n
, 2);
1731 || XINT (n
) >= CHAR_TABLE_EXTRA_SLOTS (XCHAR_TABLE (char_table
)))
1732 args_out_of_range (char_table
, n
);
1734 return XCHAR_TABLE (char_table
)->extras
[XINT (n
)] = value
;
1737 DEFUN ("char-table-range", Fchar_table_range
, Schar_table_range
,
1739 "Return the value in CHAR-TABLE for a range of characters RANGE.\n\
1740 RANGE should be nil (for the default value)\n\
1741 a vector which identifies a character set or a row of a character set,\n\
1742 a character set name, or a character code.")
1744 Lisp_Object char_table
, range
;
1748 CHECK_CHAR_TABLE (char_table
, 0);
1750 if (EQ (range
, Qnil
))
1751 return XCHAR_TABLE (char_table
)->defalt
;
1752 else if (INTEGERP (range
))
1753 return Faref (char_table
, range
);
1754 else if (SYMBOLP (range
))
1756 Lisp_Object charset_info
;
1758 charset_info
= Fget (range
, Qcharset
);
1759 CHECK_VECTOR (charset_info
, 0);
1761 return Faref (char_table
, XVECTOR (charset_info
)->contents
[0] + 128);
1763 else if (VECTORP (range
))
1765 if (XVECTOR (range
)->size
== 1)
1766 return Faref (char_table
, XVECTOR (range
)->contents
[0] + 128);
1769 int size
= XVECTOR (range
)->size
;
1770 Lisp_Object
*val
= XVECTOR (range
)->contents
;
1771 Lisp_Object ch
= Fmake_char_internal (size
<= 0 ? Qnil
: val
[0],
1772 size
<= 1 ? Qnil
: val
[1],
1773 size
<= 2 ? Qnil
: val
[2]);
1774 return Faref (char_table
, ch
);
1778 error ("Invalid RANGE argument to `char-table-range'");
1781 DEFUN ("set-char-table-range", Fset_char_table_range
, Sset_char_table_range
,
1783 "Set the value in CHAR-TABLE for a range of characters RANGE to VALUE.\n\
1784 RANGE should be t (for all characters), nil (for the default value)\n\
1785 a vector which identifies a character set or a row of a character set,\n\
1786 a coding system, or a character code.")
1787 (char_table
, range
, value
)
1788 Lisp_Object char_table
, range
, value
;
1792 CHECK_CHAR_TABLE (char_table
, 0);
1795 for (i
= 0; i
< CHAR_TABLE_ORDINARY_SLOTS
; i
++)
1796 XCHAR_TABLE (char_table
)->contents
[i
] = value
;
1797 else if (EQ (range
, Qnil
))
1798 XCHAR_TABLE (char_table
)->defalt
= value
;
1799 else if (SYMBOLP (range
))
1801 Lisp_Object charset_info
;
1803 charset_info
= Fget (range
, Qcharset
);
1804 CHECK_VECTOR (charset_info
, 0);
1806 return Faset (char_table
, XVECTOR (charset_info
)->contents
[0] + 128,
1809 else if (INTEGERP (range
))
1810 Faset (char_table
, range
, value
);
1811 else if (VECTORP (range
))
1813 if (XVECTOR (range
)->size
== 1)
1814 return Faset (char_table
, XVECTOR (range
)->contents
[0] + 128, value
);
1817 int size
= XVECTOR (range
)->size
;
1818 Lisp_Object
*val
= XVECTOR (range
)->contents
;
1819 Lisp_Object ch
= Fmake_char_internal (size
<= 0 ? Qnil
: val
[0],
1820 size
<= 1 ? Qnil
: val
[1],
1821 size
<= 2 ? Qnil
: val
[2]);
1822 return Faset (char_table
, ch
, value
);
1826 error ("Invalid RANGE argument to `set-char-table-range'");
1831 DEFUN ("set-char-table-default", Fset_char_table_default
,
1832 Sset_char_table_default
, 3, 3, 0,
1833 "Set the default value in CHAR-TABLE for a generic character CHAR to VALUE.\n\
1834 The generic character specifies the group of characters.\n\
1835 See also the documentation of make-char.")
1836 (char_table
, ch
, value
)
1837 Lisp_Object char_table
, ch
, value
;
1839 int c
, i
, charset
, code1
, code2
;
1842 CHECK_CHAR_TABLE (char_table
, 0);
1843 CHECK_NUMBER (ch
, 1);
1846 SPLIT_NON_ASCII_CHAR (c
, charset
, code1
, code2
);
1847 if (! CHARSET_DEFINED_P (charset
))
1848 invalid_character (c
);
1850 if (charset
== CHARSET_ASCII
)
1851 return (XCHAR_TABLE (char_table
)->defalt
= value
);
1853 /* Even if C is not a generic char, we had better behave as if a
1854 generic char is specified. */
1855 if (CHARSET_DIMENSION (charset
) == 1)
1857 temp
= XCHAR_TABLE (char_table
)->contents
[charset
+ 128];
1860 if (SUB_CHAR_TABLE_P (temp
))
1861 XCHAR_TABLE (temp
)->defalt
= value
;
1863 XCHAR_TABLE (char_table
)->contents
[charset
+ 128] = value
;
1867 if (! SUB_CHAR_TABLE_P (char_table
))
1868 char_table
= (XCHAR_TABLE (char_table
)->contents
[charset
+ 128]
1869 = make_sub_char_table (temp
));
1870 temp
= XCHAR_TABLE (char_table
)->contents
[code1
];
1871 if (SUB_CHAR_TABLE_P (temp
))
1872 XCHAR_TABLE (temp
)->defalt
= value
;
1874 XCHAR_TABLE (char_table
)->contents
[code1
] = value
;
1878 /* Look up the element in TABLE at index CH,
1879 and return it as an integer.
1880 If the element is nil, return CH itself.
1881 (Actually we do that for any non-integer.) */
1884 char_table_translate (table
, ch
)
1889 value
= Faref (table
, make_number (ch
));
1890 if (! INTEGERP (value
))
1892 return XINT (value
);
1895 /* Map C_FUNCTION or FUNCTION over SUBTABLE, calling it for each
1896 character or group of characters that share a value.
1897 DEPTH is the current depth in the originally specified
1898 chartable, and INDICES contains the vector indices
1899 for the levels our callers have descended.
1901 ARG is passed to C_FUNCTION when that is called. */
1904 map_char_table (c_function
, function
, subtable
, arg
, depth
, indices
)
1905 void (*c_function
) P_ ((Lisp_Object
, Lisp_Object
, Lisp_Object
));
1906 Lisp_Object function
, subtable
, arg
, *indices
;
1913 /* At first, handle ASCII and 8-bit European characters. */
1914 for (i
= 0; i
< CHAR_TABLE_SINGLE_BYTE_SLOTS
; i
++)
1916 Lisp_Object elt
= XCHAR_TABLE (subtable
)->contents
[i
];
1918 (*c_function
) (arg
, make_number (i
), elt
);
1920 call2 (function
, make_number (i
), elt
);
1922 #if 0 /* If the char table has entries for higher characters,
1923 we should report them. */
1924 if (NILP (current_buffer
->enable_multibyte_characters
))
1927 to
= CHAR_TABLE_ORDINARY_SLOTS
;
1932 to
= SUB_CHAR_TABLE_ORDINARY_SLOTS
;
1937 Lisp_Object elt
= XCHAR_TABLE (subtable
)->contents
[i
];
1939 XSETFASTINT (indices
[depth
], i
);
1941 if (SUB_CHAR_TABLE_P (elt
))
1944 error ("Too deep char table");
1945 map_char_table (c_function
, function
, elt
, arg
, depth
+ 1, indices
);
1949 int charset
= XFASTINT (indices
[0]) - 128, c1
, c2
, c
;
1951 if (CHARSET_DEFINED_P (charset
))
1953 c1
= depth
>= 1 ? XFASTINT (indices
[1]) : 0;
1954 c2
= depth
>= 2 ? XFASTINT (indices
[2]) : 0;
1955 c
= MAKE_NON_ASCII_CHAR (charset
, c1
, c2
);
1957 (*c_function
) (arg
, make_number (c
), elt
);
1959 call2 (function
, make_number (c
), elt
);
1965 DEFUN ("map-char-table", Fmap_char_table
, Smap_char_table
,
1967 "Call FUNCTION for each (normal and generic) characters in CHAR-TABLE.\n\
1968 FUNCTION is called with two arguments--a key and a value.\n\
1969 The key is always a possible IDX argument to `aref'.")
1970 (function
, char_table
)
1971 Lisp_Object function
, char_table
;
1973 /* The depth of char table is at most 3. */
1974 Lisp_Object indices
[3];
1976 CHECK_CHAR_TABLE (char_table
, 1);
1978 map_char_table (NULL
, function
, char_table
, char_table
, 0, indices
);
1988 Lisp_Object args
[2];
1991 return Fnconc (2, args
);
1993 return Fnconc (2, &s1
);
1994 #endif /* NO_ARG_ARRAY */
1997 DEFUN ("nconc", Fnconc
, Snconc
, 0, MANY
, 0,
1998 "Concatenate any number of lists by altering them.\n\
1999 Only the last argument is not altered, and need not be a list.")
2004 register int argnum
;
2005 register Lisp_Object tail
, tem
, val
;
2009 for (argnum
= 0; argnum
< nargs
; argnum
++)
2012 if (NILP (tem
)) continue;
2017 if (argnum
+ 1 == nargs
) break;
2020 tem
= wrong_type_argument (Qlistp
, tem
);
2029 tem
= args
[argnum
+ 1];
2030 Fsetcdr (tail
, tem
);
2032 args
[argnum
+ 1] = tail
;
2038 /* This is the guts of all mapping functions.
2039 Apply FN to each element of SEQ, one by one,
2040 storing the results into elements of VALS, a C vector of Lisp_Objects.
2041 LENI is the length of VALS, which should also be the length of SEQ. */
2044 mapcar1 (leni
, vals
, fn
, seq
)
2047 Lisp_Object fn
, seq
;
2049 register Lisp_Object tail
;
2052 struct gcpro gcpro1
, gcpro2
, gcpro3
;
2054 /* Don't let vals contain any garbage when GC happens. */
2055 for (i
= 0; i
< leni
; i
++)
2058 GCPRO3 (dummy
, fn
, seq
);
2060 gcpro1
.nvars
= leni
;
2061 /* We need not explicitly protect `tail' because it is used only on lists, and
2062 1) lists are not relocated and 2) the list is marked via `seq' so will not be freed */
2066 for (i
= 0; i
< leni
; i
++)
2068 dummy
= XVECTOR (seq
)->contents
[i
];
2069 vals
[i
] = call1 (fn
, dummy
);
2072 else if (BOOL_VECTOR_P (seq
))
2074 for (i
= 0; i
< leni
; i
++)
2077 byte
= XBOOL_VECTOR (seq
)->data
[i
/ BITS_PER_CHAR
];
2078 if (byte
& (1 << (i
% BITS_PER_CHAR
)))
2083 vals
[i
] = call1 (fn
, dummy
);
2086 else if (STRINGP (seq
) && ! STRING_MULTIBYTE (seq
))
2088 /* Single-byte string. */
2089 for (i
= 0; i
< leni
; i
++)
2091 XSETFASTINT (dummy
, XSTRING (seq
)->data
[i
]);
2092 vals
[i
] = call1 (fn
, dummy
);
2095 else if (STRINGP (seq
))
2097 /* Multi-byte string. */
2098 int len_byte
= STRING_BYTES (XSTRING (seq
));
2101 for (i
= 0, i_byte
= 0; i
< leni
;)
2106 FETCH_STRING_CHAR_ADVANCE (c
, seq
, i
, i_byte
);
2107 XSETFASTINT (dummy
, c
);
2108 vals
[i_before
] = call1 (fn
, dummy
);
2111 else /* Must be a list, since Flength did not get an error */
2114 for (i
= 0; i
< leni
; i
++)
2116 vals
[i
] = call1 (fn
, Fcar (tail
));
2117 tail
= XCONS (tail
)->cdr
;
2124 DEFUN ("mapconcat", Fmapconcat
, Smapconcat
, 3, 3, 0,
2125 "Apply FUNCTION to each element of SEQUENCE, and concat the results as strings.\n\
2126 In between each pair of results, stick in SEPARATOR. Thus, \" \" as\n\
2127 SEPARATOR results in spaces between the values returned by FUNCTION.\n\
2128 SEQUENCE may be a list, a vector, a bool-vector, or a string.")
2129 (function
, sequence
, separator
)
2130 Lisp_Object function
, sequence
, separator
;
2135 register Lisp_Object
*args
;
2137 struct gcpro gcpro1
;
2139 len
= Flength (sequence
);
2141 nargs
= leni
+ leni
- 1;
2142 if (nargs
< 0) return build_string ("");
2144 args
= (Lisp_Object
*) alloca (nargs
* sizeof (Lisp_Object
));
2147 mapcar1 (leni
, args
, function
, sequence
);
2150 for (i
= leni
- 1; i
>= 0; i
--)
2151 args
[i
+ i
] = args
[i
];
2153 for (i
= 1; i
< nargs
; i
+= 2)
2154 args
[i
] = separator
;
2156 return Fconcat (nargs
, args
);
2159 DEFUN ("mapcar", Fmapcar
, Smapcar
, 2, 2, 0,
2160 "Apply FUNCTION to each element of SEQUENCE, and make a list of the results.\n\
2161 The result is a list just as long as SEQUENCE.\n\
2162 SEQUENCE may be a list, a vector, a bool-vector, or a string.")
2163 (function
, sequence
)
2164 Lisp_Object function
, sequence
;
2166 register Lisp_Object len
;
2168 register Lisp_Object
*args
;
2170 len
= Flength (sequence
);
2171 leni
= XFASTINT (len
);
2172 args
= (Lisp_Object
*) alloca (leni
* sizeof (Lisp_Object
));
2174 mapcar1 (leni
, args
, function
, sequence
);
2176 return Flist (leni
, args
);
2179 /* Anything that calls this function must protect from GC! */
2181 DEFUN ("y-or-n-p", Fy_or_n_p
, Sy_or_n_p
, 1, 1, 0,
2182 "Ask user a \"y or n\" question. Return t if answer is \"y\".\n\
2183 Takes one argument, which is the string to display to ask the question.\n\
2184 It should end in a space; `y-or-n-p' adds `(y or n) ' to it.\n\
2185 No confirmation of the answer is requested; a single character is enough.\n\
2186 Also accepts Space to mean yes, or Delete to mean no.")
2190 register Lisp_Object obj
, key
, def
, answer_string
, map
;
2191 register int answer
;
2192 Lisp_Object xprompt
;
2193 Lisp_Object args
[2];
2194 struct gcpro gcpro1
, gcpro2
;
2195 int count
= specpdl_ptr
- specpdl
;
2197 specbind (Qcursor_in_echo_area
, Qt
);
2199 map
= Fsymbol_value (intern ("query-replace-map"));
2201 CHECK_STRING (prompt
, 0);
2203 GCPRO2 (prompt
, xprompt
);
2209 if ((NILP (last_nonmenu_event
) || CONSP (last_nonmenu_event
))
2213 Lisp_Object pane
, menu
;
2214 redisplay_preserve_echo_area ();
2215 pane
= Fcons (Fcons (build_string ("Yes"), Qt
),
2216 Fcons (Fcons (build_string ("No"), Qnil
),
2218 menu
= Fcons (prompt
, pane
);
2219 obj
= Fx_popup_dialog (Qt
, menu
);
2220 answer
= !NILP (obj
);
2223 #endif /* HAVE_MENUS */
2224 cursor_in_echo_area
= 1;
2225 choose_minibuf_frame ();
2226 message_with_string ("%s(y or n) ", xprompt
, 0);
2228 if (minibuffer_auto_raise
)
2230 Lisp_Object mini_frame
;
2232 mini_frame
= WINDOW_FRAME (XWINDOW (minibuf_window
));
2234 Fraise_frame (mini_frame
);
2237 obj
= read_filtered_event (1, 0, 0);
2238 cursor_in_echo_area
= 0;
2239 /* If we need to quit, quit with cursor_in_echo_area = 0. */
2242 key
= Fmake_vector (make_number (1), obj
);
2243 def
= Flookup_key (map
, key
, Qt
);
2244 answer_string
= Fsingle_key_description (obj
);
2246 if (EQ (def
, intern ("skip")))
2251 else if (EQ (def
, intern ("act")))
2256 else if (EQ (def
, intern ("recenter")))
2262 else if (EQ (def
, intern ("quit")))
2264 /* We want to exit this command for exit-prefix,
2265 and this is the only way to do it. */
2266 else if (EQ (def
, intern ("exit-prefix")))
2271 /* If we don't clear this, then the next call to read_char will
2272 return quit_char again, and we'll enter an infinite loop. */
2277 if (EQ (xprompt
, prompt
))
2279 args
[0] = build_string ("Please answer y or n. ");
2281 xprompt
= Fconcat (2, args
);
2286 if (! noninteractive
)
2288 cursor_in_echo_area
= -1;
2289 message_with_string (answer
? "%s(y or n) y" : "%s(y or n) n",
2293 unbind_to (count
, Qnil
);
2294 return answer
? Qt
: Qnil
;
2297 /* This is how C code calls `yes-or-no-p' and allows the user
2300 Anything that calls this function must protect from GC! */
2303 do_yes_or_no_p (prompt
)
2306 return call1 (intern ("yes-or-no-p"), prompt
);
2309 /* Anything that calls this function must protect from GC! */
2311 DEFUN ("yes-or-no-p", Fyes_or_no_p
, Syes_or_no_p
, 1, 1, 0,
2312 "Ask user a yes-or-no question. Return t if answer is yes.\n\
2313 Takes one argument, which is the string to display to ask the question.\n\
2314 It should end in a space; `yes-or-no-p' adds `(yes or no) ' to it.\n\
2315 The user must confirm the answer with RET,\n\
2316 and can edit it until it has been confirmed.")
2320 register Lisp_Object ans
;
2321 Lisp_Object args
[2];
2322 struct gcpro gcpro1
;
2325 CHECK_STRING (prompt
, 0);
2328 if ((NILP (last_nonmenu_event
) || CONSP (last_nonmenu_event
))
2332 Lisp_Object pane
, menu
, obj
;
2333 redisplay_preserve_echo_area ();
2334 pane
= Fcons (Fcons (build_string ("Yes"), Qt
),
2335 Fcons (Fcons (build_string ("No"), Qnil
),
2338 menu
= Fcons (prompt
, pane
);
2339 obj
= Fx_popup_dialog (Qt
, menu
);
2343 #endif /* HAVE_MENUS */
2346 args
[1] = build_string ("(yes or no) ");
2347 prompt
= Fconcat (2, args
);
2353 ans
= Fdowncase (Fread_from_minibuffer (prompt
, Qnil
, Qnil
, Qnil
,
2354 Qyes_or_no_p_history
, Qnil
,
2356 if (XSTRING (ans
)->size
== 3 && !strcmp (XSTRING (ans
)->data
, "yes"))
2361 if (XSTRING (ans
)->size
== 2 && !strcmp (XSTRING (ans
)->data
, "no"))
2369 message ("Please answer yes or no.");
2370 Fsleep_for (make_number (2), Qnil
);
2374 DEFUN ("load-average", Fload_average
, Sload_average
, 0, 0, 0,
2375 "Return list of 1 minute, 5 minute and 15 minute load averages.\n\
2376 Each of the three load averages is multiplied by 100,\n\
2377 then converted to integer.\n\
2378 If the 5-minute or 15-minute load averages are not available, return a\n\
2379 shortened list, containing only those averages which are available.")
2383 int loads
= getloadavg (load_ave
, 3);
2387 error ("load-average not implemented for this operating system");
2391 ret
= Fcons (make_number ((int) (load_ave
[--loads
] * 100.0)), ret
);
2396 Lisp_Object Vfeatures
;
2398 DEFUN ("featurep", Ffeaturep
, Sfeaturep
, 1, 1, 0,
2399 "Returns t if FEATURE is present in this Emacs.\n\
2400 Use this to conditionalize execution of lisp code based on the presence or\n\
2401 absence of emacs or environment extensions.\n\
2402 Use `provide' to declare that a feature is available.\n\
2403 This function looks at the value of the variable `features'.")
2405 Lisp_Object feature
;
2407 register Lisp_Object tem
;
2408 CHECK_SYMBOL (feature
, 0);
2409 tem
= Fmemq (feature
, Vfeatures
);
2410 return (NILP (tem
)) ? Qnil
: Qt
;
2413 DEFUN ("provide", Fprovide
, Sprovide
, 1, 1, 0,
2414 "Announce that FEATURE is a feature of the current Emacs.")
2416 Lisp_Object feature
;
2418 register Lisp_Object tem
;
2419 CHECK_SYMBOL (feature
, 0);
2420 if (!NILP (Vautoload_queue
))
2421 Vautoload_queue
= Fcons (Fcons (Vfeatures
, Qnil
), Vautoload_queue
);
2422 tem
= Fmemq (feature
, Vfeatures
);
2424 Vfeatures
= Fcons (feature
, Vfeatures
);
2425 LOADHIST_ATTACH (Fcons (Qprovide
, feature
));
2429 DEFUN ("require", Frequire
, Srequire
, 1, 2, 0,
2430 "If feature FEATURE is not loaded, load it from FILENAME.\n\
2431 If FEATURE is not a member of the list `features', then the feature\n\
2432 is not loaded; so load the file FILENAME.\n\
2433 If FILENAME is omitted, the printname of FEATURE is used as the file name.")
2434 (feature
, file_name
)
2435 Lisp_Object feature
, file_name
;
2437 register Lisp_Object tem
;
2438 CHECK_SYMBOL (feature
, 0);
2439 tem
= Fmemq (feature
, Vfeatures
);
2440 LOADHIST_ATTACH (Fcons (Qrequire
, feature
));
2443 int count
= specpdl_ptr
- specpdl
;
2445 /* Value saved here is to be restored into Vautoload_queue */
2446 record_unwind_protect (un_autoload
, Vautoload_queue
);
2447 Vautoload_queue
= Qt
;
2449 Fload (NILP (file_name
) ? Fsymbol_name (feature
) : file_name
,
2450 Qnil
, Qt
, Qnil
, (NILP (file_name
) ? Qt
: Qnil
));
2452 tem
= Fmemq (feature
, Vfeatures
);
2454 error ("Required feature %s was not provided",
2455 XSYMBOL (feature
)->name
->data
);
2457 /* Once loading finishes, don't undo it. */
2458 Vautoload_queue
= Qt
;
2459 feature
= unbind_to (count
, feature
);
2464 /* Primitives for work of the "widget" library.
2465 In an ideal world, this section would not have been necessary.
2466 However, lisp function calls being as slow as they are, it turns
2467 out that some functions in the widget library (wid-edit.el) are the
2468 bottleneck of Widget operation. Here is their translation to C,
2469 for the sole reason of efficiency. */
2471 DEFUN ("widget-plist-member", Fwidget_plist_member
, Swidget_plist_member
, 2, 2, 0,
2472 "Return non-nil if PLIST has the property PROP.\n\
2473 PLIST is a property list, which is a list of the form\n\
2474 \(PROP1 VALUE1 PROP2 VALUE2 ...\). PROP is a symbol.\n\
2475 Unlike `plist-get', this allows you to distinguish between a missing\n\
2476 property and a property with the value nil.\n\
2477 The value is actually the tail of PLIST whose car is PROP.")
2479 Lisp_Object plist
, prop
;
2481 while (CONSP (plist
) && !EQ (XCAR (plist
), prop
))
2484 plist
= XCDR (plist
);
2485 plist
= CDR (plist
);
2490 DEFUN ("widget-put", Fwidget_put
, Swidget_put
, 3, 3, 0,
2491 "In WIDGET, set PROPERTY to VALUE.\n\
2492 The value can later be retrieved with `widget-get'.")
2493 (widget
, property
, value
)
2494 Lisp_Object widget
, property
, value
;
2496 CHECK_CONS (widget
, 1);
2497 XCDR (widget
) = Fplist_put (XCDR (widget
), property
, value
);
2500 DEFUN ("widget-get", Fwidget_get
, Swidget_get
, 2, 2, 0,
2501 "In WIDGET, get the value of PROPERTY.\n\
2502 The value could either be specified when the widget was created, or\n\
2503 later with `widget-put'.")
2505 Lisp_Object widget
, property
;
2513 CHECK_CONS (widget
, 1);
2514 tmp
= Fwidget_plist_member (XCDR (widget
), property
);
2520 tmp
= XCAR (widget
);
2523 widget
= Fget (tmp
, Qwidget_type
);
2527 DEFUN ("widget-apply", Fwidget_apply
, Swidget_apply
, 2, MANY
, 0,
2528 "Apply the value of WIDGET's PROPERTY to the widget itself.\n\
2529 ARGS are passed as extra arguments to the function.")
2534 /* This function can GC. */
2535 Lisp_Object newargs
[3];
2536 struct gcpro gcpro1
, gcpro2
;
2539 newargs
[0] = Fwidget_get (args
[0], args
[1]);
2540 newargs
[1] = args
[0];
2541 newargs
[2] = Flist (nargs
- 2, args
+ 2);
2542 GCPRO2 (newargs
[0], newargs
[2]);
2543 result
= Fapply (3, newargs
);
2550 Qstring_lessp
= intern ("string-lessp");
2551 staticpro (&Qstring_lessp
);
2552 Qprovide
= intern ("provide");
2553 staticpro (&Qprovide
);
2554 Qrequire
= intern ("require");
2555 staticpro (&Qrequire
);
2556 Qyes_or_no_p_history
= intern ("yes-or-no-p-history");
2557 staticpro (&Qyes_or_no_p_history
);
2558 Qcursor_in_echo_area
= intern ("cursor-in-echo-area");
2559 staticpro (&Qcursor_in_echo_area
);
2560 Qwidget_type
= intern ("widget-type");
2561 staticpro (&Qwidget_type
);
2563 staticpro (&string_char_byte_cache_string
);
2564 string_char_byte_cache_string
= Qnil
;
2566 Fset (Qyes_or_no_p_history
, Qnil
);
2568 DEFVAR_LISP ("features", &Vfeatures
,
2569 "A list of symbols which are the features of the executing emacs.\n\
2570 Used by `featurep' and `require', and altered by `provide'.");
2573 DEFVAR_BOOL ("use-dialog-box", &use_dialog_box
,
2574 "*Non-nil means mouse commands use dialog boxes to ask questions.\n\
2575 This applies to y-or-n and yes-or-no questions asked by commands\n\
2576 invoked by mouse clicks and mouse menu items.");
2579 defsubr (&Sidentity
);
2582 defsubr (&Ssafe_length
);
2583 defsubr (&Sstring_bytes
);
2584 defsubr (&Sstring_equal
);
2585 defsubr (&Sstring_lessp
);
2588 defsubr (&Svconcat
);
2589 defsubr (&Scopy_sequence
);
2590 defsubr (&Sstring_make_multibyte
);
2591 defsubr (&Sstring_make_unibyte
);
2592 defsubr (&Sstring_as_multibyte
);
2593 defsubr (&Sstring_as_unibyte
);
2594 defsubr (&Scopy_alist
);
2595 defsubr (&Ssubstring
);
2607 defsubr (&Snreverse
);
2608 defsubr (&Sreverse
);
2610 defsubr (&Splist_get
);
2612 defsubr (&Splist_put
);
2615 defsubr (&Sfillarray
);
2616 defsubr (&Schar_table_subtype
);
2617 defsubr (&Schar_table_parent
);
2618 defsubr (&Sset_char_table_parent
);
2619 defsubr (&Schar_table_extra_slot
);
2620 defsubr (&Sset_char_table_extra_slot
);
2621 defsubr (&Schar_table_range
);
2622 defsubr (&Sset_char_table_range
);
2623 defsubr (&Sset_char_table_default
);
2624 defsubr (&Smap_char_table
);
2627 defsubr (&Smapconcat
);
2628 defsubr (&Sy_or_n_p
);
2629 defsubr (&Syes_or_no_p
);
2630 defsubr (&Sload_average
);
2631 defsubr (&Sfeaturep
);
2632 defsubr (&Srequire
);
2633 defsubr (&Sprovide
);
2634 defsubr (&Swidget_plist_member
);
2635 defsubr (&Swidget_put
);
2636 defsubr (&Swidget_get
);
2637 defsubr (&Swidget_apply
);