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 characters in the string; it is the number of bytes.\n\
113 To get the number of characters, use `chars-in-string'")
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
));
865 DEFUN ("string-as-multibyte", Fstring_as_multibyte
, Sstring_as_multibyte
,
867 "Return a multibyte string with the same individual bytes as STRING.\n\
868 If STRING is multibyte, the result is STRING itself.")
872 if (! STRING_MULTIBYTE (string
))
874 int nbytes
= STRING_BYTES (XSTRING (string
));
875 int newlen
= multibyte_chars_in_text (XSTRING (string
)->data
, nbytes
);
877 string
= Fcopy_sequence (string
);
878 XSTRING (string
)->size
= newlen
;
879 XSTRING (string
)->size_byte
= nbytes
;
884 DEFUN ("copy-alist", Fcopy_alist
, Scopy_alist
, 1, 1, 0,
885 "Return a copy of ALIST.\n\
886 This is an alist which represents the same mapping from objects to objects,\n\
887 but does not share the alist structure with ALIST.\n\
888 The objects mapped (cars and cdrs of elements of the alist)\n\
889 are shared, however.\n\
890 Elements of ALIST that are not conses are also shared.")
894 register Lisp_Object tem
;
896 CHECK_LIST (alist
, 0);
899 alist
= concat (1, &alist
, Lisp_Cons
, 0);
900 for (tem
= alist
; CONSP (tem
); tem
= XCONS (tem
)->cdr
)
902 register Lisp_Object car
;
903 car
= XCONS (tem
)->car
;
906 XCONS (tem
)->car
= Fcons (XCONS (car
)->car
, XCONS (car
)->cdr
);
911 DEFUN ("substring", Fsubstring
, Ssubstring
, 2, 3, 0,
912 "Return a substring of STRING, starting at index FROM and ending before TO.\n\
913 TO may be nil or omitted; then the substring runs to the end of STRING.\n\
914 If FROM or TO is negative, it counts from the end.\n\
916 This function allows vectors as well as strings.")
919 register Lisp_Object from
, to
;
924 int from_char
, to_char
;
925 int from_byte
, to_byte
;
927 if (! (STRINGP (string
) || VECTORP (string
)))
928 wrong_type_argument (Qarrayp
, string
);
930 CHECK_NUMBER (from
, 1);
932 if (STRINGP (string
))
934 size
= XSTRING (string
)->size
;
935 size_byte
= STRING_BYTES (XSTRING (string
));
938 size
= XVECTOR (string
)->size
;
947 CHECK_NUMBER (to
, 2);
953 if (STRINGP (string
))
954 to_byte
= string_char_to_byte (string
, to_char
);
957 from_char
= XINT (from
);
960 if (STRINGP (string
))
961 from_byte
= string_char_to_byte (string
, from_char
);
963 if (!(0 <= from_char
&& from_char
<= to_char
&& to_char
<= size
))
964 args_out_of_range_3 (string
, make_number (from_char
),
965 make_number (to_char
));
967 if (STRINGP (string
))
969 res
= make_specified_string (XSTRING (string
)->data
+ from_byte
,
970 to_char
- from_char
, to_byte
- from_byte
,
971 STRING_MULTIBYTE (string
));
972 copy_text_properties (from_char
, to_char
, string
,
973 make_number (0), res
, Qnil
);
976 res
= Fvector (to_char
- from_char
,
977 XVECTOR (string
)->contents
+ from_char
);
982 /* Extract a substring of STRING, giving start and end positions
983 both in characters and in bytes. */
986 substring_both (string
, from
, from_byte
, to
, to_byte
)
988 int from
, from_byte
, to
, to_byte
;
994 if (! (STRINGP (string
) || VECTORP (string
)))
995 wrong_type_argument (Qarrayp
, string
);
997 if (STRINGP (string
))
999 size
= XSTRING (string
)->size
;
1000 size_byte
= STRING_BYTES (XSTRING (string
));
1003 size
= XVECTOR (string
)->size
;
1005 if (!(0 <= from
&& from
<= to
&& to
<= size
))
1006 args_out_of_range_3 (string
, make_number (from
), make_number (to
));
1008 if (STRINGP (string
))
1010 res
= make_specified_string (XSTRING (string
)->data
+ from_byte
,
1011 to
- from
, to_byte
- from_byte
,
1012 STRING_MULTIBYTE (string
));
1013 copy_text_properties (from
, to
, string
, make_number (0), res
, Qnil
);
1016 res
= Fvector (to
- from
,
1017 XVECTOR (string
)->contents
+ from
);
1022 DEFUN ("nthcdr", Fnthcdr
, Snthcdr
, 2, 2, 0,
1023 "Take cdr N times on LIST, returns the result.")
1026 register Lisp_Object list
;
1028 register int i
, num
;
1029 CHECK_NUMBER (n
, 0);
1031 for (i
= 0; i
< num
&& !NILP (list
); i
++)
1039 DEFUN ("nth", Fnth
, Snth
, 2, 2, 0,
1040 "Return the Nth element of LIST.\n\
1041 N counts from zero. If LIST is not that long, nil is returned.")
1043 Lisp_Object n
, list
;
1045 return Fcar (Fnthcdr (n
, list
));
1048 DEFUN ("elt", Felt
, Selt
, 2, 2, 0,
1049 "Return element of SEQUENCE at index N.")
1051 register Lisp_Object sequence
, n
;
1053 CHECK_NUMBER (n
, 0);
1056 if (CONSP (sequence
) || NILP (sequence
))
1057 return Fcar (Fnthcdr (n
, sequence
));
1058 else if (STRINGP (sequence
) || VECTORP (sequence
)
1059 || BOOL_VECTOR_P (sequence
) || CHAR_TABLE_P (sequence
))
1060 return Faref (sequence
, n
);
1062 sequence
= wrong_type_argument (Qsequencep
, sequence
);
1066 DEFUN ("member", Fmember
, Smember
, 2, 2, 0,
1067 "Return non-nil if ELT is an element of LIST. Comparison done with `equal'.\n\
1068 The value is actually the tail of LIST whose car is ELT.")
1070 register Lisp_Object elt
;
1073 register Lisp_Object tail
;
1074 for (tail
= list
; !NILP (tail
); tail
= XCONS (tail
)->cdr
)
1076 register Lisp_Object tem
;
1078 if (! NILP (Fequal (elt
, tem
)))
1085 DEFUN ("memq", Fmemq
, Smemq
, 2, 2, 0,
1086 "Return non-nil if ELT is an element of LIST. Comparison done with EQ.\n\
1087 The value is actually the tail of LIST whose car is ELT.")
1089 register Lisp_Object elt
;
1092 register Lisp_Object tail
;
1093 for (tail
= list
; !NILP (tail
); tail
= XCONS (tail
)->cdr
)
1095 register Lisp_Object tem
;
1097 if (EQ (elt
, tem
)) return tail
;
1103 DEFUN ("assq", Fassq
, Sassq
, 2, 2, 0,
1104 "Return non-nil if KEY is `eq' to the car of an element of LIST.\n\
1105 The value is actually the element of LIST whose car is KEY.\n\
1106 Elements of LIST that are not conses are ignored.")
1108 register Lisp_Object key
;
1111 register Lisp_Object tail
;
1112 for (tail
= list
; !NILP (tail
); tail
= XCONS (tail
)->cdr
)
1114 register Lisp_Object elt
, tem
;
1116 if (!CONSP (elt
)) continue;
1117 tem
= XCONS (elt
)->car
;
1118 if (EQ (key
, tem
)) return elt
;
1124 /* Like Fassq but never report an error and do not allow quits.
1125 Use only on lists known never to be circular. */
1128 assq_no_quit (key
, list
)
1129 register Lisp_Object key
;
1132 register Lisp_Object tail
;
1133 for (tail
= list
; CONSP (tail
); tail
= XCONS (tail
)->cdr
)
1135 register Lisp_Object elt
, tem
;
1137 if (!CONSP (elt
)) continue;
1138 tem
= XCONS (elt
)->car
;
1139 if (EQ (key
, tem
)) return elt
;
1144 DEFUN ("assoc", Fassoc
, Sassoc
, 2, 2, 0,
1145 "Return non-nil if KEY is `equal' to the car of an element of LIST.\n\
1146 The value is actually the element of LIST whose car equals KEY.")
1148 register Lisp_Object key
;
1151 register Lisp_Object tail
;
1152 for (tail
= list
; !NILP (tail
); tail
= XCONS (tail
)->cdr
)
1154 register Lisp_Object elt
, tem
;
1156 if (!CONSP (elt
)) continue;
1157 tem
= Fequal (XCONS (elt
)->car
, key
);
1158 if (!NILP (tem
)) return elt
;
1164 DEFUN ("rassq", Frassq
, Srassq
, 2, 2, 0,
1165 "Return non-nil if ELT is `eq' to the cdr of an element of LIST.\n\
1166 The value is actually the element of LIST whose cdr is ELT.")
1168 register Lisp_Object key
;
1171 register Lisp_Object tail
;
1172 for (tail
= list
; !NILP (tail
); tail
= XCONS (tail
)->cdr
)
1174 register Lisp_Object elt
, tem
;
1176 if (!CONSP (elt
)) continue;
1177 tem
= XCONS (elt
)->cdr
;
1178 if (EQ (key
, tem
)) return elt
;
1184 DEFUN ("rassoc", Frassoc
, Srassoc
, 2, 2, 0,
1185 "Return non-nil if KEY is `equal' to the cdr of an element of LIST.\n\
1186 The value is actually the element of LIST whose cdr equals KEY.")
1188 register Lisp_Object key
;
1191 register Lisp_Object tail
;
1192 for (tail
= list
; !NILP (tail
); tail
= XCONS (tail
)->cdr
)
1194 register Lisp_Object elt
, tem
;
1196 if (!CONSP (elt
)) continue;
1197 tem
= Fequal (XCONS (elt
)->cdr
, key
);
1198 if (!NILP (tem
)) return elt
;
1204 DEFUN ("delq", Fdelq
, Sdelq
, 2, 2, 0,
1205 "Delete by side effect any occurrences of ELT as a member of LIST.\n\
1206 The modified LIST is returned. Comparison is done with `eq'.\n\
1207 If the first member of LIST is ELT, there is no way to remove it by side effect;\n\
1208 therefore, write `(setq foo (delq element foo))'\n\
1209 to be sure of changing the value of `foo'.")
1211 register Lisp_Object elt
;
1214 register Lisp_Object tail
, prev
;
1215 register Lisp_Object tem
;
1219 while (!NILP (tail
))
1225 list
= XCONS (tail
)->cdr
;
1227 Fsetcdr (prev
, XCONS (tail
)->cdr
);
1231 tail
= XCONS (tail
)->cdr
;
1237 DEFUN ("delete", Fdelete
, Sdelete
, 2, 2, 0,
1238 "Delete by side effect any occurrences of ELT as a member of LIST.\n\
1239 The modified LIST is returned. Comparison is done with `equal'.\n\
1240 If the first member of LIST is ELT, deleting it is not a side effect;\n\
1241 it is simply using a different list.\n\
1242 Therefore, write `(setq foo (delete element foo))'\n\
1243 to be sure of changing the value of `foo'.")
1245 register Lisp_Object elt
;
1248 register Lisp_Object tail
, prev
;
1249 register Lisp_Object tem
;
1253 while (!NILP (tail
))
1256 if (! NILP (Fequal (elt
, tem
)))
1259 list
= XCONS (tail
)->cdr
;
1261 Fsetcdr (prev
, XCONS (tail
)->cdr
);
1265 tail
= XCONS (tail
)->cdr
;
1271 DEFUN ("nreverse", Fnreverse
, Snreverse
, 1, 1, 0,
1272 "Reverse LIST by modifying cdr pointers.\n\
1273 Returns the beginning of the reversed list.")
1277 register Lisp_Object prev
, tail
, next
;
1279 if (NILP (list
)) return list
;
1282 while (!NILP (tail
))
1286 Fsetcdr (tail
, prev
);
1293 DEFUN ("reverse", Freverse
, Sreverse
, 1, 1, 0,
1294 "Reverse LIST, copying. Returns the beginning of the reversed list.\n\
1295 See also the function `nreverse', which is used more often.")
1301 for (new = Qnil
; CONSP (list
); list
= XCONS (list
)->cdr
)
1302 new = Fcons (XCONS (list
)->car
, new);
1304 wrong_type_argument (Qconsp
, list
);
1308 Lisp_Object
merge ();
1310 DEFUN ("sort", Fsort
, Ssort
, 2, 2, 0,
1311 "Sort LIST, stably, comparing elements using PREDICATE.\n\
1312 Returns the sorted list. LIST is modified by side effects.\n\
1313 PREDICATE is called with two elements of LIST, and should return T\n\
1314 if the first element is \"less\" than the second.")
1316 Lisp_Object list
, predicate
;
1318 Lisp_Object front
, back
;
1319 register Lisp_Object len
, tem
;
1320 struct gcpro gcpro1
, gcpro2
;
1321 register int length
;
1324 len
= Flength (list
);
1325 length
= XINT (len
);
1329 XSETINT (len
, (length
/ 2) - 1);
1330 tem
= Fnthcdr (len
, list
);
1332 Fsetcdr (tem
, Qnil
);
1334 GCPRO2 (front
, back
);
1335 front
= Fsort (front
, predicate
);
1336 back
= Fsort (back
, predicate
);
1338 return merge (front
, back
, predicate
);
1342 merge (org_l1
, org_l2
, pred
)
1343 Lisp_Object org_l1
, org_l2
;
1347 register Lisp_Object tail
;
1349 register Lisp_Object l1
, l2
;
1350 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
1357 /* It is sufficient to protect org_l1 and org_l2.
1358 When l1 and l2 are updated, we copy the new values
1359 back into the org_ vars. */
1360 GCPRO4 (org_l1
, org_l2
, pred
, value
);
1380 tem
= call2 (pred
, Fcar (l2
), Fcar (l1
));
1396 Fsetcdr (tail
, tem
);
1402 DEFUN ("plist-get", Fplist_get
, Splist_get
, 2, 2, 0,
1403 "Extract a value from a property list.\n\
1404 PLIST is a property list, which is a list of the form\n\
1405 \(PROP1 VALUE1 PROP2 VALUE2...). This function returns the value\n\
1406 corresponding to the given PROP, or nil if PROP is not\n\
1407 one of the properties on the list.")
1410 register Lisp_Object prop
;
1412 register Lisp_Object tail
;
1413 for (tail
= plist
; !NILP (tail
); tail
= Fcdr (XCONS (tail
)->cdr
))
1415 register Lisp_Object tem
;
1418 return Fcar (XCONS (tail
)->cdr
);
1423 DEFUN ("get", Fget
, Sget
, 2, 2, 0,
1424 "Return the value of SYMBOL's PROPNAME property.\n\
1425 This is the last value stored with `(put SYMBOL PROPNAME VALUE)'.")
1427 Lisp_Object symbol
, propname
;
1429 CHECK_SYMBOL (symbol
, 0);
1430 return Fplist_get (XSYMBOL (symbol
)->plist
, propname
);
1433 DEFUN ("plist-put", Fplist_put
, Splist_put
, 3, 3, 0,
1434 "Change value in PLIST of PROP to VAL.\n\
1435 PLIST is a property list, which is a list of the form\n\
1436 \(PROP1 VALUE1 PROP2 VALUE2 ...). PROP is a symbol and VAL is any object.\n\
1437 If PROP is already a property on the list, its value is set to VAL,\n\
1438 otherwise the new PROP VAL pair is added. The new plist is returned;\n\
1439 use `(setq x (plist-put x prop val))' to be sure to use the new value.\n\
1440 The PLIST is modified by side effects.")
1443 register Lisp_Object prop
;
1446 register Lisp_Object tail
, prev
;
1447 Lisp_Object newcell
;
1449 for (tail
= plist
; CONSP (tail
) && CONSP (XCONS (tail
)->cdr
);
1450 tail
= XCONS (XCONS (tail
)->cdr
)->cdr
)
1452 if (EQ (prop
, XCONS (tail
)->car
))
1454 Fsetcar (XCONS (tail
)->cdr
, val
);
1459 newcell
= Fcons (prop
, Fcons (val
, Qnil
));
1463 Fsetcdr (XCONS (prev
)->cdr
, newcell
);
1467 DEFUN ("put", Fput
, Sput
, 3, 3, 0,
1468 "Store SYMBOL's PROPNAME property with value VALUE.\n\
1469 It can be retrieved with `(get SYMBOL PROPNAME)'.")
1470 (symbol
, propname
, value
)
1471 Lisp_Object symbol
, propname
, value
;
1473 CHECK_SYMBOL (symbol
, 0);
1474 XSYMBOL (symbol
)->plist
1475 = Fplist_put (XSYMBOL (symbol
)->plist
, propname
, value
);
1479 DEFUN ("equal", Fequal
, Sequal
, 2, 2, 0,
1480 "Return t if two Lisp objects have similar structure and contents.\n\
1481 They must have the same data type.\n\
1482 Conses are compared by comparing the cars and the cdrs.\n\
1483 Vectors and strings are compared element by element.\n\
1484 Numbers are compared by value, but integers cannot equal floats.\n\
1485 (Use `=' if you want integers and floats to be able to be equal.)\n\
1486 Symbols must match exactly.")
1488 register Lisp_Object o1
, o2
;
1490 return internal_equal (o1
, o2
, 0) ? Qt
: Qnil
;
1494 internal_equal (o1
, o2
, depth
)
1495 register Lisp_Object o1
, o2
;
1499 error ("Stack overflow in equal");
1505 if (XTYPE (o1
) != XTYPE (o2
))
1510 #ifdef LISP_FLOAT_TYPE
1512 return (extract_float (o1
) == extract_float (o2
));
1516 if (!internal_equal (XCONS (o1
)->car
, XCONS (o2
)->car
, depth
+ 1))
1518 o1
= XCONS (o1
)->cdr
;
1519 o2
= XCONS (o2
)->cdr
;
1523 if (XMISCTYPE (o1
) != XMISCTYPE (o2
))
1527 if (!internal_equal (OVERLAY_START (o1
), OVERLAY_START (o1
),
1529 || !internal_equal (OVERLAY_END (o1
), OVERLAY_END (o1
),
1532 o1
= XOVERLAY (o1
)->plist
;
1533 o2
= XOVERLAY (o2
)->plist
;
1538 return (XMARKER (o1
)->buffer
== XMARKER (o2
)->buffer
1539 && (XMARKER (o1
)->buffer
== 0
1540 || XMARKER (o1
)->bytepos
== XMARKER (o2
)->bytepos
));
1544 case Lisp_Vectorlike
:
1546 register int i
, size
;
1547 size
= XVECTOR (o1
)->size
;
1548 /* Pseudovectors have the type encoded in the size field, so this test
1549 actually checks that the objects have the same type as well as the
1551 if (XVECTOR (o2
)->size
!= size
)
1553 /* Boolvectors are compared much like strings. */
1554 if (BOOL_VECTOR_P (o1
))
1557 = (XBOOL_VECTOR (o1
)->size
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
;
1559 if (XBOOL_VECTOR (o1
)->size
!= XBOOL_VECTOR (o2
)->size
)
1561 if (bcmp (XBOOL_VECTOR (o1
)->data
, XBOOL_VECTOR (o2
)->data
,
1566 if (WINDOW_CONFIGURATIONP (o1
))
1567 return compare_window_configurations (o1
, o2
, 0);
1569 /* Aside from them, only true vectors, char-tables, and compiled
1570 functions are sensible to compare, so eliminate the others now. */
1571 if (size
& PSEUDOVECTOR_FLAG
)
1573 if (!(size
& (PVEC_COMPILED
| PVEC_CHAR_TABLE
)))
1575 size
&= PSEUDOVECTOR_SIZE_MASK
;
1577 for (i
= 0; i
< size
; i
++)
1580 v1
= XVECTOR (o1
)->contents
[i
];
1581 v2
= XVECTOR (o2
)->contents
[i
];
1582 if (!internal_equal (v1
, v2
, depth
+ 1))
1590 if (XSTRING (o1
)->size
!= XSTRING (o2
)->size
)
1592 if (STRING_BYTES (XSTRING (o1
)) != STRING_BYTES (XSTRING (o2
)))
1594 if (bcmp (XSTRING (o1
)->data
, XSTRING (o2
)->data
,
1595 STRING_BYTES (XSTRING (o1
))))
1602 extern Lisp_Object
Fmake_char_internal ();
1604 DEFUN ("fillarray", Ffillarray
, Sfillarray
, 2, 2, 0,
1605 "Store each element of ARRAY with ITEM.\n\
1606 ARRAY is a vector, string, char-table, or bool-vector.")
1608 Lisp_Object array
, item
;
1610 register int size
, index
, charval
;
1612 if (VECTORP (array
))
1614 register Lisp_Object
*p
= XVECTOR (array
)->contents
;
1615 size
= XVECTOR (array
)->size
;
1616 for (index
= 0; index
< size
; index
++)
1619 else if (CHAR_TABLE_P (array
))
1621 register Lisp_Object
*p
= XCHAR_TABLE (array
)->contents
;
1622 size
= CHAR_TABLE_ORDINARY_SLOTS
;
1623 for (index
= 0; index
< size
; index
++)
1625 XCHAR_TABLE (array
)->defalt
= Qnil
;
1627 else if (STRINGP (array
))
1629 register unsigned char *p
= XSTRING (array
)->data
;
1630 CHECK_NUMBER (item
, 1);
1631 charval
= XINT (item
);
1632 size
= XSTRING (array
)->size
;
1633 for (index
= 0; index
< size
; index
++)
1636 else if (BOOL_VECTOR_P (array
))
1638 register unsigned char *p
= XBOOL_VECTOR (array
)->data
;
1640 = (XBOOL_VECTOR (array
)->size
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
;
1642 charval
= (! NILP (item
) ? -1 : 0);
1643 for (index
= 0; index
< size_in_chars
; index
++)
1648 array
= wrong_type_argument (Qarrayp
, array
);
1654 DEFUN ("char-table-subtype", Fchar_table_subtype
, Schar_table_subtype
,
1656 "Return the subtype of char-table CHAR-TABLE. The value is a symbol.")
1658 Lisp_Object char_table
;
1660 CHECK_CHAR_TABLE (char_table
, 0);
1662 return XCHAR_TABLE (char_table
)->purpose
;
1665 DEFUN ("char-table-parent", Fchar_table_parent
, Schar_table_parent
,
1667 "Return the parent char-table of CHAR-TABLE.\n\
1668 The value is either nil or another char-table.\n\
1669 If CHAR-TABLE holds nil for a given character,\n\
1670 then the actual applicable value is inherited from the parent char-table\n\
1671 \(or from its parents, if necessary).")
1673 Lisp_Object char_table
;
1675 CHECK_CHAR_TABLE (char_table
, 0);
1677 return XCHAR_TABLE (char_table
)->parent
;
1680 DEFUN ("set-char-table-parent", Fset_char_table_parent
, Sset_char_table_parent
,
1682 "Set the parent char-table of CHAR-TABLE to PARENT.\n\
1683 PARENT must be either nil or another char-table.")
1684 (char_table
, parent
)
1685 Lisp_Object char_table
, parent
;
1689 CHECK_CHAR_TABLE (char_table
, 0);
1693 CHECK_CHAR_TABLE (parent
, 0);
1695 for (temp
= parent
; !NILP (temp
); temp
= XCHAR_TABLE (temp
)->parent
)
1696 if (EQ (temp
, char_table
))
1697 error ("Attempt to make a chartable be its own parent");
1700 XCHAR_TABLE (char_table
)->parent
= parent
;
1705 DEFUN ("char-table-extra-slot", Fchar_table_extra_slot
, Schar_table_extra_slot
,
1707 "Return the value of CHAR-TABLE's extra-slot number N.")
1709 Lisp_Object char_table
, n
;
1711 CHECK_CHAR_TABLE (char_table
, 1);
1712 CHECK_NUMBER (n
, 2);
1714 || XINT (n
) >= CHAR_TABLE_EXTRA_SLOTS (XCHAR_TABLE (char_table
)))
1715 args_out_of_range (char_table
, n
);
1717 return XCHAR_TABLE (char_table
)->extras
[XINT (n
)];
1720 DEFUN ("set-char-table-extra-slot", Fset_char_table_extra_slot
,
1721 Sset_char_table_extra_slot
,
1723 "Set CHAR-TABLE's extra-slot number N to VALUE.")
1724 (char_table
, n
, value
)
1725 Lisp_Object char_table
, n
, value
;
1727 CHECK_CHAR_TABLE (char_table
, 1);
1728 CHECK_NUMBER (n
, 2);
1730 || XINT (n
) >= CHAR_TABLE_EXTRA_SLOTS (XCHAR_TABLE (char_table
)))
1731 args_out_of_range (char_table
, n
);
1733 return XCHAR_TABLE (char_table
)->extras
[XINT (n
)] = value
;
1736 DEFUN ("char-table-range", Fchar_table_range
, Schar_table_range
,
1738 "Return the value in CHAR-TABLE for a range of characters RANGE.\n\
1739 RANGE should be nil (for the default value)\n\
1740 a vector which identifies a character set or a row of a character set,\n\
1741 a character set name, or a character code.")
1743 Lisp_Object char_table
, range
;
1747 CHECK_CHAR_TABLE (char_table
, 0);
1749 if (EQ (range
, Qnil
))
1750 return XCHAR_TABLE (char_table
)->defalt
;
1751 else if (INTEGERP (range
))
1752 return Faref (char_table
, range
);
1753 else if (SYMBOLP (range
))
1755 Lisp_Object charset_info
;
1757 charset_info
= Fget (range
, Qcharset
);
1758 CHECK_VECTOR (charset_info
, 0);
1760 return Faref (char_table
, XVECTOR (charset_info
)->contents
[0] + 128);
1762 else if (VECTORP (range
))
1764 if (XVECTOR (range
)->size
== 1)
1765 return Faref (char_table
, XVECTOR (range
)->contents
[0] + 128);
1768 int size
= XVECTOR (range
)->size
;
1769 Lisp_Object
*val
= XVECTOR (range
)->contents
;
1770 Lisp_Object ch
= Fmake_char_internal (size
<= 0 ? Qnil
: val
[0],
1771 size
<= 1 ? Qnil
: val
[1],
1772 size
<= 2 ? Qnil
: val
[2]);
1773 return Faref (char_table
, ch
);
1777 error ("Invalid RANGE argument to `char-table-range'");
1780 DEFUN ("set-char-table-range", Fset_char_table_range
, Sset_char_table_range
,
1782 "Set the value in CHAR-TABLE for a range of characters RANGE to VALUE.\n\
1783 RANGE should be t (for all characters), nil (for the default value)\n\
1784 a vector which identifies a character set or a row of a character set,\n\
1785 a coding system, or a character code.")
1786 (char_table
, range
, value
)
1787 Lisp_Object char_table
, range
, value
;
1791 CHECK_CHAR_TABLE (char_table
, 0);
1794 for (i
= 0; i
< CHAR_TABLE_ORDINARY_SLOTS
; i
++)
1795 XCHAR_TABLE (char_table
)->contents
[i
] = value
;
1796 else if (EQ (range
, Qnil
))
1797 XCHAR_TABLE (char_table
)->defalt
= value
;
1798 else if (SYMBOLP (range
))
1800 Lisp_Object charset_info
;
1802 charset_info
= Fget (range
, Qcharset
);
1803 CHECK_VECTOR (charset_info
, 0);
1805 return Faset (char_table
, XVECTOR (charset_info
)->contents
[0] + 128,
1808 else if (INTEGERP (range
))
1809 Faset (char_table
, range
, value
);
1810 else if (VECTORP (range
))
1812 if (XVECTOR (range
)->size
== 1)
1813 return Faset (char_table
, XVECTOR (range
)->contents
[0] + 128, value
);
1816 int size
= XVECTOR (range
)->size
;
1817 Lisp_Object
*val
= XVECTOR (range
)->contents
;
1818 Lisp_Object ch
= Fmake_char_internal (size
<= 0 ? Qnil
: val
[0],
1819 size
<= 1 ? Qnil
: val
[1],
1820 size
<= 2 ? Qnil
: val
[2]);
1821 return Faset (char_table
, ch
, value
);
1825 error ("Invalid RANGE argument to `set-char-table-range'");
1830 DEFUN ("set-char-table-default", Fset_char_table_default
,
1831 Sset_char_table_default
, 3, 3, 0,
1832 "Set the default value in CHAR-TABLE for a generic character CHAR to VALUE.\n\
1833 The generic character specifies the group of characters.\n\
1834 See also the documentation of make-char.")
1835 (char_table
, ch
, value
)
1836 Lisp_Object char_table
, ch
, value
;
1838 int c
, i
, charset
, code1
, code2
;
1841 CHECK_CHAR_TABLE (char_table
, 0);
1842 CHECK_NUMBER (ch
, 1);
1845 SPLIT_NON_ASCII_CHAR (c
, charset
, code1
, code2
);
1846 if (! CHARSET_DEFINED_P (charset
))
1847 invalid_character (c
);
1849 if (charset
== CHARSET_ASCII
)
1850 return (XCHAR_TABLE (char_table
)->defalt
= value
);
1852 /* Even if C is not a generic char, we had better behave as if a
1853 generic char is specified. */
1854 if (CHARSET_DIMENSION (charset
) == 1)
1856 temp
= XCHAR_TABLE (char_table
)->contents
[charset
+ 128];
1859 if (SUB_CHAR_TABLE_P (temp
))
1860 XCHAR_TABLE (temp
)->defalt
= value
;
1862 XCHAR_TABLE (char_table
)->contents
[charset
+ 128] = value
;
1866 if (! SUB_CHAR_TABLE_P (char_table
))
1867 char_table
= (XCHAR_TABLE (char_table
)->contents
[charset
+ 128]
1868 = make_sub_char_table (temp
));
1869 temp
= XCHAR_TABLE (char_table
)->contents
[code1
];
1870 if (SUB_CHAR_TABLE_P (temp
))
1871 XCHAR_TABLE (temp
)->defalt
= value
;
1873 XCHAR_TABLE (char_table
)->contents
[code1
] = value
;
1877 /* Look up the element in TABLE at index CH,
1878 and return it as an integer.
1879 If the element is nil, return CH itself.
1880 (Actually we do that for any non-integer.) */
1883 char_table_translate (table
, ch
)
1888 value
= Faref (table
, make_number (ch
));
1889 if (! INTEGERP (value
))
1891 return XINT (value
);
1894 /* Map C_FUNCTION or FUNCTION over SUBTABLE, calling it for each
1895 character or group of characters that share a value.
1896 DEPTH is the current depth in the originally specified
1897 chartable, and INDICES contains the vector indices
1898 for the levels our callers have descended.
1900 ARG is passed to C_FUNCTION when that is called. */
1903 map_char_table (c_function
, function
, subtable
, arg
, depth
, indices
)
1904 void (*c_function
) P_ ((Lisp_Object
, Lisp_Object
, Lisp_Object
));
1905 Lisp_Object function
, subtable
, arg
, *indices
;
1912 /* At first, handle ASCII and 8-bit European characters. */
1913 for (i
= 0; i
< CHAR_TABLE_SINGLE_BYTE_SLOTS
; i
++)
1915 Lisp_Object elt
= XCHAR_TABLE (subtable
)->contents
[i
];
1917 (*c_function
) (arg
, make_number (i
), elt
);
1919 call2 (function
, make_number (i
), elt
);
1921 #if 0 /* If the char table has entries for higher characters,
1922 we should report them. */
1923 if (NILP (current_buffer
->enable_multibyte_characters
))
1926 to
= CHAR_TABLE_ORDINARY_SLOTS
;
1931 to
= SUB_CHAR_TABLE_ORDINARY_SLOTS
;
1936 Lisp_Object elt
= XCHAR_TABLE (subtable
)->contents
[i
];
1938 XSETFASTINT (indices
[depth
], i
);
1940 if (SUB_CHAR_TABLE_P (elt
))
1943 error ("Too deep char table");
1944 map_char_table (c_function
, function
, elt
, arg
, depth
+ 1, indices
);
1948 int charset
= XFASTINT (indices
[0]) - 128, c1
, c2
, c
;
1950 if (CHARSET_DEFINED_P (charset
))
1952 c1
= depth
>= 1 ? XFASTINT (indices
[1]) : 0;
1953 c2
= depth
>= 2 ? XFASTINT (indices
[2]) : 0;
1954 c
= MAKE_NON_ASCII_CHAR (charset
, c1
, c2
);
1956 (*c_function
) (arg
, make_number (c
), elt
);
1958 call2 (function
, make_number (c
), elt
);
1964 DEFUN ("map-char-table", Fmap_char_table
, Smap_char_table
,
1966 "Call FUNCTION for each (normal and generic) characters in CHAR-TABLE.\n\
1967 FUNCTION is called with two arguments--a key and a value.\n\
1968 The key is always a possible IDX argument to `aref'.")
1969 (function
, char_table
)
1970 Lisp_Object function
, char_table
;
1972 /* The depth of char table is at most 3. */
1973 Lisp_Object indices
[3];
1975 CHECK_CHAR_TABLE (char_table
, 1);
1977 map_char_table (NULL
, function
, char_table
, char_table
, 0, indices
);
1987 Lisp_Object args
[2];
1990 return Fnconc (2, args
);
1992 return Fnconc (2, &s1
);
1993 #endif /* NO_ARG_ARRAY */
1996 DEFUN ("nconc", Fnconc
, Snconc
, 0, MANY
, 0,
1997 "Concatenate any number of lists by altering them.\n\
1998 Only the last argument is not altered, and need not be a list.")
2003 register int argnum
;
2004 register Lisp_Object tail
, tem
, val
;
2008 for (argnum
= 0; argnum
< nargs
; argnum
++)
2011 if (NILP (tem
)) continue;
2016 if (argnum
+ 1 == nargs
) break;
2019 tem
= wrong_type_argument (Qlistp
, tem
);
2028 tem
= args
[argnum
+ 1];
2029 Fsetcdr (tail
, tem
);
2031 args
[argnum
+ 1] = tail
;
2037 /* This is the guts of all mapping functions.
2038 Apply FN to each element of SEQ, one by one,
2039 storing the results into elements of VALS, a C vector of Lisp_Objects.
2040 LENI is the length of VALS, which should also be the length of SEQ. */
2043 mapcar1 (leni
, vals
, fn
, seq
)
2046 Lisp_Object fn
, seq
;
2048 register Lisp_Object tail
;
2051 struct gcpro gcpro1
, gcpro2
, gcpro3
;
2053 /* Don't let vals contain any garbage when GC happens. */
2054 for (i
= 0; i
< leni
; i
++)
2057 GCPRO3 (dummy
, fn
, seq
);
2059 gcpro1
.nvars
= leni
;
2060 /* We need not explicitly protect `tail' because it is used only on lists, and
2061 1) lists are not relocated and 2) the list is marked via `seq' so will not be freed */
2065 for (i
= 0; i
< leni
; i
++)
2067 dummy
= XVECTOR (seq
)->contents
[i
];
2068 vals
[i
] = call1 (fn
, dummy
);
2071 else if (BOOL_VECTOR_P (seq
))
2073 for (i
= 0; i
< leni
; i
++)
2076 byte
= XBOOL_VECTOR (seq
)->data
[i
/ BITS_PER_CHAR
];
2077 if (byte
& (1 << (i
% BITS_PER_CHAR
)))
2082 vals
[i
] = call1 (fn
, dummy
);
2085 else if (STRINGP (seq
) && ! STRING_MULTIBYTE (seq
))
2087 /* Single-byte string. */
2088 for (i
= 0; i
< leni
; i
++)
2090 XSETFASTINT (dummy
, XSTRING (seq
)->data
[i
]);
2091 vals
[i
] = call1 (fn
, dummy
);
2094 else if (STRINGP (seq
))
2096 /* Multi-byte string. */
2097 int len_byte
= STRING_BYTES (XSTRING (seq
));
2100 for (i
= 0, i_byte
= 0; i
< leni
;)
2105 FETCH_STRING_CHAR_ADVANCE (c
, seq
, i
, i_byte
);
2106 XSETFASTINT (dummy
, c
);
2107 vals
[i_before
] = call1 (fn
, dummy
);
2110 else /* Must be a list, since Flength did not get an error */
2113 for (i
= 0; i
< leni
; i
++)
2115 vals
[i
] = call1 (fn
, Fcar (tail
));
2116 tail
= XCONS (tail
)->cdr
;
2123 DEFUN ("mapconcat", Fmapconcat
, Smapconcat
, 3, 3, 0,
2124 "Apply FUNCTION to each element of SEQUENCE, and concat the results as strings.\n\
2125 In between each pair of results, stick in SEPARATOR. Thus, \" \" as\n\
2126 SEPARATOR results in spaces between the values returned by FUNCTION.\n\
2127 SEQUENCE may be a list, a vector, a bool-vector, or a string.")
2128 (function
, sequence
, separator
)
2129 Lisp_Object function
, sequence
, separator
;
2134 register Lisp_Object
*args
;
2136 struct gcpro gcpro1
;
2138 len
= Flength (sequence
);
2140 nargs
= leni
+ leni
- 1;
2141 if (nargs
< 0) return build_string ("");
2143 args
= (Lisp_Object
*) alloca (nargs
* sizeof (Lisp_Object
));
2146 mapcar1 (leni
, args
, function
, sequence
);
2149 for (i
= leni
- 1; i
>= 0; i
--)
2150 args
[i
+ i
] = args
[i
];
2152 for (i
= 1; i
< nargs
; i
+= 2)
2153 args
[i
] = separator
;
2155 return Fconcat (nargs
, args
);
2158 DEFUN ("mapcar", Fmapcar
, Smapcar
, 2, 2, 0,
2159 "Apply FUNCTION to each element of SEQUENCE, and make a list of the results.\n\
2160 The result is a list just as long as SEQUENCE.\n\
2161 SEQUENCE may be a list, a vector, a bool-vector, or a string.")
2162 (function
, sequence
)
2163 Lisp_Object function
, sequence
;
2165 register Lisp_Object len
;
2167 register Lisp_Object
*args
;
2169 len
= Flength (sequence
);
2170 leni
= XFASTINT (len
);
2171 args
= (Lisp_Object
*) alloca (leni
* sizeof (Lisp_Object
));
2173 mapcar1 (leni
, args
, function
, sequence
);
2175 return Flist (leni
, args
);
2178 /* Anything that calls this function must protect from GC! */
2180 DEFUN ("y-or-n-p", Fy_or_n_p
, Sy_or_n_p
, 1, 1, 0,
2181 "Ask user a \"y or n\" question. Return t if answer is \"y\".\n\
2182 Takes one argument, which is the string to display to ask the question.\n\
2183 It should end in a space; `y-or-n-p' adds `(y or n) ' to it.\n\
2184 No confirmation of the answer is requested; a single character is enough.\n\
2185 Also accepts Space to mean yes, or Delete to mean no.")
2189 register Lisp_Object obj
, key
, def
, answer_string
, map
;
2190 register int answer
;
2191 Lisp_Object xprompt
;
2192 Lisp_Object args
[2];
2193 struct gcpro gcpro1
, gcpro2
;
2194 int count
= specpdl_ptr
- specpdl
;
2196 specbind (Qcursor_in_echo_area
, Qt
);
2198 map
= Fsymbol_value (intern ("query-replace-map"));
2200 CHECK_STRING (prompt
, 0);
2202 GCPRO2 (prompt
, xprompt
);
2208 if ((NILP (last_nonmenu_event
) || CONSP (last_nonmenu_event
))
2212 Lisp_Object pane
, menu
;
2213 redisplay_preserve_echo_area ();
2214 pane
= Fcons (Fcons (build_string ("Yes"), Qt
),
2215 Fcons (Fcons (build_string ("No"), Qnil
),
2217 menu
= Fcons (prompt
, pane
);
2218 obj
= Fx_popup_dialog (Qt
, menu
);
2219 answer
= !NILP (obj
);
2222 #endif /* HAVE_MENUS */
2223 cursor_in_echo_area
= 1;
2224 choose_minibuf_frame ();
2225 message_with_string ("%s(y or n) ", xprompt
, 0);
2227 if (minibuffer_auto_raise
)
2229 Lisp_Object mini_frame
;
2231 mini_frame
= WINDOW_FRAME (XWINDOW (minibuf_window
));
2233 Fraise_frame (mini_frame
);
2236 obj
= read_filtered_event (1, 0, 0);
2237 cursor_in_echo_area
= 0;
2238 /* If we need to quit, quit with cursor_in_echo_area = 0. */
2241 key
= Fmake_vector (make_number (1), obj
);
2242 def
= Flookup_key (map
, key
, Qt
);
2243 answer_string
= Fsingle_key_description (obj
);
2245 if (EQ (def
, intern ("skip")))
2250 else if (EQ (def
, intern ("act")))
2255 else if (EQ (def
, intern ("recenter")))
2261 else if (EQ (def
, intern ("quit")))
2263 /* We want to exit this command for exit-prefix,
2264 and this is the only way to do it. */
2265 else if (EQ (def
, intern ("exit-prefix")))
2270 /* If we don't clear this, then the next call to read_char will
2271 return quit_char again, and we'll enter an infinite loop. */
2276 if (EQ (xprompt
, prompt
))
2278 args
[0] = build_string ("Please answer y or n. ");
2280 xprompt
= Fconcat (2, args
);
2285 if (! noninteractive
)
2287 cursor_in_echo_area
= -1;
2288 message_with_string (answer
? "%s(y or n) y" : "%s(y or n) n",
2292 unbind_to (count
, Qnil
);
2293 return answer
? Qt
: Qnil
;
2296 /* This is how C code calls `yes-or-no-p' and allows the user
2299 Anything that calls this function must protect from GC! */
2302 do_yes_or_no_p (prompt
)
2305 return call1 (intern ("yes-or-no-p"), prompt
);
2308 /* Anything that calls this function must protect from GC! */
2310 DEFUN ("yes-or-no-p", Fyes_or_no_p
, Syes_or_no_p
, 1, 1, 0,
2311 "Ask user a yes-or-no question. Return t if answer is yes.\n\
2312 Takes one argument, which is the string to display to ask the question.\n\
2313 It should end in a space; `yes-or-no-p' adds `(yes or no) ' to it.\n\
2314 The user must confirm the answer with RET,\n\
2315 and can edit it until it has been confirmed.")
2319 register Lisp_Object ans
;
2320 Lisp_Object args
[2];
2321 struct gcpro gcpro1
;
2324 CHECK_STRING (prompt
, 0);
2327 if ((NILP (last_nonmenu_event
) || CONSP (last_nonmenu_event
))
2331 Lisp_Object pane
, menu
, obj
;
2332 redisplay_preserve_echo_area ();
2333 pane
= Fcons (Fcons (build_string ("Yes"), Qt
),
2334 Fcons (Fcons (build_string ("No"), Qnil
),
2337 menu
= Fcons (prompt
, pane
);
2338 obj
= Fx_popup_dialog (Qt
, menu
);
2342 #endif /* HAVE_MENUS */
2345 args
[1] = build_string ("(yes or no) ");
2346 prompt
= Fconcat (2, args
);
2352 ans
= Fdowncase (Fread_from_minibuffer (prompt
, Qnil
, Qnil
, Qnil
,
2353 Qyes_or_no_p_history
, Qnil
,
2355 if (XSTRING (ans
)->size
== 3 && !strcmp (XSTRING (ans
)->data
, "yes"))
2360 if (XSTRING (ans
)->size
== 2 && !strcmp (XSTRING (ans
)->data
, "no"))
2368 message ("Please answer yes or no.");
2369 Fsleep_for (make_number (2), Qnil
);
2373 DEFUN ("load-average", Fload_average
, Sload_average
, 0, 0, 0,
2374 "Return list of 1 minute, 5 minute and 15 minute load averages.\n\
2375 Each of the three load averages is multiplied by 100,\n\
2376 then converted to integer.\n\
2377 If the 5-minute or 15-minute load averages are not available, return a\n\
2378 shortened list, containing only those averages which are available.")
2382 int loads
= getloadavg (load_ave
, 3);
2386 error ("load-average not implemented for this operating system");
2390 ret
= Fcons (make_number ((int) (load_ave
[--loads
] * 100.0)), ret
);
2395 Lisp_Object Vfeatures
;
2397 DEFUN ("featurep", Ffeaturep
, Sfeaturep
, 1, 1, 0,
2398 "Returns t if FEATURE is present in this Emacs.\n\
2399 Use this to conditionalize execution of lisp code based on the presence or\n\
2400 absence of emacs or environment extensions.\n\
2401 Use `provide' to declare that a feature is available.\n\
2402 This function looks at the value of the variable `features'.")
2404 Lisp_Object feature
;
2406 register Lisp_Object tem
;
2407 CHECK_SYMBOL (feature
, 0);
2408 tem
= Fmemq (feature
, Vfeatures
);
2409 return (NILP (tem
)) ? Qnil
: Qt
;
2412 DEFUN ("provide", Fprovide
, Sprovide
, 1, 1, 0,
2413 "Announce that FEATURE is a feature of the current Emacs.")
2415 Lisp_Object feature
;
2417 register Lisp_Object tem
;
2418 CHECK_SYMBOL (feature
, 0);
2419 if (!NILP (Vautoload_queue
))
2420 Vautoload_queue
= Fcons (Fcons (Vfeatures
, Qnil
), Vautoload_queue
);
2421 tem
= Fmemq (feature
, Vfeatures
);
2423 Vfeatures
= Fcons (feature
, Vfeatures
);
2424 LOADHIST_ATTACH (Fcons (Qprovide
, feature
));
2428 DEFUN ("require", Frequire
, Srequire
, 1, 2, 0,
2429 "If feature FEATURE is not loaded, load it from FILENAME.\n\
2430 If FEATURE is not a member of the list `features', then the feature\n\
2431 is not loaded; so load the file FILENAME.\n\
2432 If FILENAME is omitted, the printname of FEATURE is used as the file name.")
2433 (feature
, file_name
)
2434 Lisp_Object feature
, file_name
;
2436 register Lisp_Object tem
;
2437 CHECK_SYMBOL (feature
, 0);
2438 tem
= Fmemq (feature
, Vfeatures
);
2439 LOADHIST_ATTACH (Fcons (Qrequire
, feature
));
2442 int count
= specpdl_ptr
- specpdl
;
2444 /* Value saved here is to be restored into Vautoload_queue */
2445 record_unwind_protect (un_autoload
, Vautoload_queue
);
2446 Vautoload_queue
= Qt
;
2448 Fload (NILP (file_name
) ? Fsymbol_name (feature
) : file_name
,
2449 Qnil
, Qt
, Qnil
, (NILP (file_name
) ? Qt
: Qnil
));
2451 tem
= Fmemq (feature
, Vfeatures
);
2453 error ("Required feature %s was not provided",
2454 XSYMBOL (feature
)->name
->data
);
2456 /* Once loading finishes, don't undo it. */
2457 Vautoload_queue
= Qt
;
2458 feature
= unbind_to (count
, feature
);
2463 /* Primitives for work of the "widget" library.
2464 In an ideal world, this section would not have been necessary.
2465 However, lisp function calls being as slow as they are, it turns
2466 out that some functions in the widget library (wid-edit.el) are the
2467 bottleneck of Widget operation. Here is their translation to C,
2468 for the sole reason of efficiency. */
2470 DEFUN ("widget-plist-member", Fwidget_plist_member
, Swidget_plist_member
, 2, 2, 0,
2471 "Return non-nil if PLIST has the property PROP.\n\
2472 PLIST is a property list, which is a list of the form\n\
2473 \(PROP1 VALUE1 PROP2 VALUE2 ...\). PROP is a symbol.\n\
2474 Unlike `plist-get', this allows you to distinguish between a missing\n\
2475 property and a property with the value nil.\n\
2476 The value is actually the tail of PLIST whose car is PROP.")
2478 Lisp_Object plist
, prop
;
2480 while (CONSP (plist
) && !EQ (XCAR (plist
), prop
))
2483 plist
= XCDR (plist
);
2484 plist
= CDR (plist
);
2489 DEFUN ("widget-put", Fwidget_put
, Swidget_put
, 3, 3, 0,
2490 "In WIDGET, set PROPERTY to VALUE.\n\
2491 The value can later be retrieved with `widget-get'.")
2492 (widget
, property
, value
)
2493 Lisp_Object widget
, property
, value
;
2495 CHECK_CONS (widget
, 1);
2496 XCDR (widget
) = Fplist_put (XCDR (widget
), property
, value
);
2499 DEFUN ("widget-get", Fwidget_get
, Swidget_get
, 2, 2, 0,
2500 "In WIDGET, get the value of PROPERTY.\n\
2501 The value could either be specified when the widget was created, or\n\
2502 later with `widget-put'.")
2504 Lisp_Object widget
, property
;
2512 CHECK_CONS (widget
, 1);
2513 tmp
= Fwidget_plist_member (XCDR (widget
), property
);
2519 tmp
= XCAR (widget
);
2522 widget
= Fget (tmp
, Qwidget_type
);
2526 DEFUN ("widget-apply", Fwidget_apply
, Swidget_apply
, 2, MANY
, 0,
2527 "Apply the value of WIDGET's PROPERTY to the widget itself.\n\
2528 ARGS are passed as extra arguments to the function.")
2533 /* This function can GC. */
2534 Lisp_Object newargs
[3];
2535 struct gcpro gcpro1
, gcpro2
;
2538 newargs
[0] = Fwidget_get (args
[0], args
[1]);
2539 newargs
[1] = args
[0];
2540 newargs
[2] = Flist (nargs
- 2, args
+ 2);
2541 GCPRO2 (newargs
[0], newargs
[2]);
2542 result
= Fapply (3, newargs
);
2549 Qstring_lessp
= intern ("string-lessp");
2550 staticpro (&Qstring_lessp
);
2551 Qprovide
= intern ("provide");
2552 staticpro (&Qprovide
);
2553 Qrequire
= intern ("require");
2554 staticpro (&Qrequire
);
2555 Qyes_or_no_p_history
= intern ("yes-or-no-p-history");
2556 staticpro (&Qyes_or_no_p_history
);
2557 Qcursor_in_echo_area
= intern ("cursor-in-echo-area");
2558 staticpro (&Qcursor_in_echo_area
);
2559 Qwidget_type
= intern ("widget-type");
2560 staticpro (&Qwidget_type
);
2562 staticpro (&string_char_byte_cache_string
);
2563 string_char_byte_cache_string
= Qnil
;
2565 Fset (Qyes_or_no_p_history
, Qnil
);
2567 DEFVAR_LISP ("features", &Vfeatures
,
2568 "A list of symbols which are the features of the executing emacs.\n\
2569 Used by `featurep' and `require', and altered by `provide'.");
2572 DEFVAR_BOOL ("use-dialog-box", &use_dialog_box
,
2573 "*Non-nil means mouse commands use dialog boxes to ask questions.\n\
2574 This applies to y-or-n and yes-or-no questions asked by commands\n\
2575 invoked by mouse clicks and mouse menu items.");
2578 defsubr (&Sidentity
);
2581 defsubr (&Ssafe_length
);
2582 defsubr (&Sstring_bytes
);
2583 defsubr (&Sstring_equal
);
2584 defsubr (&Sstring_lessp
);
2587 defsubr (&Svconcat
);
2588 defsubr (&Scopy_sequence
);
2589 defsubr (&Sstring_make_multibyte
);
2590 defsubr (&Sstring_make_unibyte
);
2591 defsubr (&Sstring_as_multibyte
);
2592 defsubr (&Sstring_as_unibyte
);
2593 defsubr (&Scopy_alist
);
2594 defsubr (&Ssubstring
);
2606 defsubr (&Snreverse
);
2607 defsubr (&Sreverse
);
2609 defsubr (&Splist_get
);
2611 defsubr (&Splist_put
);
2614 defsubr (&Sfillarray
);
2615 defsubr (&Schar_table_subtype
);
2616 defsubr (&Schar_table_parent
);
2617 defsubr (&Sset_char_table_parent
);
2618 defsubr (&Schar_table_extra_slot
);
2619 defsubr (&Sset_char_table_extra_slot
);
2620 defsubr (&Schar_table_range
);
2621 defsubr (&Sset_char_table_range
);
2622 defsubr (&Sset_char_table_default
);
2623 defsubr (&Smap_char_table
);
2626 defsubr (&Smapconcat
);
2627 defsubr (&Sy_or_n_p
);
2628 defsubr (&Syes_or_no_p
);
2629 defsubr (&Sload_average
);
2630 defsubr (&Sfeaturep
);
2631 defsubr (&Srequire
);
2632 defsubr (&Sprovide
);
2633 defsubr (&Swidget_plist_member
);
2634 defsubr (&Swidget_put
);
2635 defsubr (&Swidget_get
);
2636 defsubr (&Swidget_apply
);