1 /* Random utility Lisp functions.
2 Copyright (C) 1985, 86, 87, 93, 94, 95, 97, 1998 Free Software Foundation, Inc.
4 This file is part of GNU Emacs.
6 GNU Emacs is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 2, or (at your option)
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs; see the file COPYING. If not, write to
18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
19 Boston, MA 02111-1307, USA. */
24 /* Note on some machines this defines `vector' as a typedef,
25 so make sure we don't use that name in this file. */
35 #include "intervals.h"
40 #define NULL (void *)0
43 #define DEFAULT_NONASCII_INSERT_OFFSET 0x800
45 /* Nonzero enables use of dialog boxes for questions
46 asked by mouse commands. */
49 extern Lisp_Object
Flookup_key ();
51 extern int minibuffer_auto_raise
;
52 extern Lisp_Object minibuf_window
;
54 Lisp_Object Qstring_lessp
, Qprovide
, Qrequire
;
55 Lisp_Object Qyes_or_no_p_history
;
56 Lisp_Object Qcursor_in_echo_area
;
57 Lisp_Object Qwidget_type
;
59 static int internal_equal ();
61 DEFUN ("identity", Fidentity
, Sidentity
, 1, 1, 0,
62 "Return the argument unchanged.")
69 extern long get_random ();
70 extern void seed_random ();
73 DEFUN ("random", Frandom
, Srandom
, 0, 1, 0,
74 "Return a pseudo-random number.\n\
75 All integers representable in Lisp are equally likely.\n\
76 On most systems, this is 28 bits' worth.\n\
77 With positive integer argument N, return random number in interval [0,N).\n\
78 With argument t, set the random number seed from the current time and pid.")
83 Lisp_Object lispy_val
;
84 unsigned long denominator
;
87 seed_random (getpid () + time (NULL
));
88 if (NATNUMP (n
) && XFASTINT (n
) != 0)
90 /* Try to take our random number from the higher bits of VAL,
91 not the lower, since (says Gentzel) the low bits of `random'
92 are less random than the higher ones. We do this by using the
93 quotient rather than the remainder. At the high end of the RNG
94 it's possible to get a quotient larger than n; discarding
95 these values eliminates the bias that would otherwise appear
96 when using a large n. */
97 denominator
= ((unsigned long)1 << VALBITS
) / XFASTINT (n
);
99 val
= get_random () / denominator
;
100 while (val
>= XFASTINT (n
));
104 XSETINT (lispy_val
, val
);
108 /* Random data-structure functions */
110 DEFUN ("length", Flength
, Slength
, 1, 1, 0,
111 "Return the length of vector, list or string SEQUENCE.\n\
112 A byte-code function object is also allowed.\n\
113 If the string contains multibyte characters, this is not the necessarily\n\
114 the number of characters in the string; it is the number of bytes.\n\
115 To get the number of characters, use `chars-in-string'")
117 register Lisp_Object sequence
;
119 register Lisp_Object tail
, val
;
123 if (STRINGP (sequence
))
124 XSETFASTINT (val
, XSTRING (sequence
)->size
);
125 else if (VECTORP (sequence
))
126 XSETFASTINT (val
, XVECTOR (sequence
)->size
);
127 else if (CHAR_TABLE_P (sequence
))
128 XSETFASTINT (val
, CHAR_TABLE_ORDINARY_SLOTS
);
129 else if (BOOL_VECTOR_P (sequence
))
130 XSETFASTINT (val
, XBOOL_VECTOR (sequence
)->size
);
131 else if (COMPILEDP (sequence
))
132 XSETFASTINT (val
, XVECTOR (sequence
)->size
& PSEUDOVECTOR_SIZE_MASK
);
133 else if (CONSP (sequence
))
135 for (i
= 0, tail
= sequence
; !NILP (tail
); i
++)
141 XSETFASTINT (val
, i
);
143 else if (NILP (sequence
))
144 XSETFASTINT (val
, 0);
147 sequence
= wrong_type_argument (Qsequencep
, sequence
);
153 /* This does not check for quits. That is safe
154 since it must terminate. */
156 DEFUN ("safe-length", Fsafe_length
, Ssafe_length
, 1, 1, 0,
157 "Return the length of a list, but avoid error or infinite loop.\n\
158 This function never gets an error. If LIST is not really a list,\n\
159 it returns 0. If LIST is circular, it returns a finite value\n\
160 which is at least the number of distinct elements.")
164 Lisp_Object tail
, halftail
, length
;
167 /* halftail is used to detect circular lists. */
169 for (tail
= list
; CONSP (tail
); tail
= XCONS (tail
)->cdr
)
171 if (EQ (tail
, halftail
) && len
!= 0)
175 halftail
= XCONS (halftail
)->cdr
;
178 XSETINT (length
, len
);
182 DEFUN ("string-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 (XSTRING (string
)->size_byte
);
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 || XSTRING (s1
)->size_byte
!= XSTRING (s2
)->size_byte
208 || bcmp (XSTRING (s1
)->data
, XSTRING (s2
)->data
, XSTRING (s1
)->size_byte
))
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
+= XSTRING (this)->size_byte
;
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
);
511 val
= make_uninit_multibyte_string (result_len
, result_len_byte
);
513 /* In `append', if all but last arg are nil, return last arg. */
514 if (target_type
== Lisp_Cons
&& EQ (val
, Qnil
))
517 /* Copy the contents of the args into the result. */
519 tail
= val
, toindex
= -1; /* -1 in toindex is flag we are making a list */
521 toindex
= 0, toindex_byte
= 0;
525 for (argnum
= 0; argnum
< nargs
; argnum
++)
529 register unsigned int thisindex
= 0;
530 register unsigned int thisindex_byte
= 0;
534 thislen
= Flength (this), thisleni
= XINT (thislen
);
536 if (STRINGP (this) && STRINGP (val
)
537 && ! NULL_INTERVAL_P (XSTRING (this)->intervals
))
538 copy_text_properties (make_number (0), thislen
, this,
539 make_number (toindex
), val
, Qnil
);
541 /* Between strings of the same kind, copy fast. */
542 if (STRINGP (this) && STRINGP (val
)
543 && STRING_MULTIBYTE (this) == some_multibyte
)
545 int thislen_byte
= XSTRING (this)->size_byte
;
546 bcopy (XSTRING (this)->data
, XSTRING (val
)->data
+ toindex_byte
,
547 XSTRING (this)->size_byte
);
548 toindex_byte
+= thislen_byte
;
551 /* Copy a single-byte string to a multibyte string. */
552 else if (STRINGP (this) && STRINGP (val
))
554 toindex_byte
+= copy_text (XSTRING (this)->data
,
555 XSTRING (val
)->data
+ toindex_byte
,
556 XSTRING (this)->size
, 0, 1);
560 /* Copy element by element. */
563 register Lisp_Object elt
;
565 /* Fetch next element of `this' arg into `elt', or break if
566 `this' is exhausted. */
567 if (NILP (this)) break;
569 elt
= XCONS (this)->car
, this = XCONS (this)->cdr
;
570 else if (thisindex
>= thisleni
)
572 else if (STRINGP (this))
574 if (STRING_MULTIBYTE (this))
577 FETCH_STRING_CHAR_ADVANCE (c
, this,
580 XSETFASTINT (elt
, c
);
585 XSETFASTINT (elt
, XSTRING (this)->data
[thisindex
++]);
586 if (some_multibyte
&& XINT (elt
) >= 0200
587 && XINT (elt
) < 0400)
591 if (! NILP (Vnonascii_translate_table
))
592 c
= XINT (Faref (Vnonascii_translate_table
,
594 else if (nonascii_insert_offset
> 0)
595 c
+= nonascii_insert_offset
;
597 c
+= DEFAULT_NONASCII_INSERT_OFFSET
;
603 else if (BOOL_VECTOR_P (this))
606 byte
= XBOOL_VECTOR (this)->data
[thisindex
/ BITS_PER_CHAR
];
607 if (byte
& (1 << (thisindex
% BITS_PER_CHAR
)))
614 elt
= XVECTOR (this)->contents
[thisindex
++];
616 /* Store this element into the result. */
619 XCONS (tail
)->car
= elt
;
621 tail
= XCONS (tail
)->cdr
;
623 else if (VECTORP (val
))
624 XVECTOR (val
)->contents
[toindex
++] = elt
;
627 CHECK_NUMBER (elt
, 0);
628 if (SINGLE_BYTE_CHAR_P (XINT (elt
)))
630 XSTRING (val
)->data
[toindex
++] = XINT (elt
);
634 /* If we have any multibyte characters,
635 we already decided to make a multibyte string. */
638 unsigned char work
[4], *str
;
639 int i
= CHAR_STRING (c
, work
, str
);
641 /* P exists as a variable
642 to avoid a bug on the Masscomp C compiler. */
643 unsigned char *p
= & XSTRING (val
)->data
[toindex_byte
];
652 XCONS (prev
)->cdr
= last_tail
;
657 static Lisp_Object string_char_byte_cache_string
;
658 static int string_char_byte_cache_charpos
;
659 static int string_char_byte_cache_bytepos
;
661 /* Return the character index corresponding to CHAR_INDEX in STRING. */
664 string_char_to_byte (string
, char_index
)
669 int best_below
, best_below_byte
;
670 int best_above
, best_above_byte
;
672 if (! STRING_MULTIBYTE (string
))
675 best_below
= best_below_byte
= 0;
676 best_above
= XSTRING (string
)->size
;
677 best_above_byte
= XSTRING (string
)->size_byte
;
679 if (EQ (string
, string_char_byte_cache_string
))
681 if (string_char_byte_cache_charpos
< char_index
)
683 best_below
= string_char_byte_cache_charpos
;
684 best_below_byte
= string_char_byte_cache_bytepos
;
688 best_above
= string_char_byte_cache_charpos
;
689 best_above_byte
= string_char_byte_cache_bytepos
;
693 if (char_index
- best_below
< best_above
- char_index
)
695 while (best_below
< char_index
)
698 FETCH_STRING_CHAR_ADVANCE (c
, string
, best_below
, best_below_byte
);
701 i_byte
= best_below_byte
;
705 while (best_above
> char_index
)
707 int best_above_byte_saved
= --best_above_byte
;
709 while (best_above_byte
> 0
710 && !CHAR_HEAD_P (XSTRING (string
)->data
[best_above_byte
]))
712 if (XSTRING (string
)->data
[best_above_byte
] < 0x80)
713 best_above_byte
= best_above_byte_saved
;
717 i_byte
= best_above_byte
;
720 string_char_byte_cache_bytepos
= i_byte
;
721 string_char_byte_cache_charpos
= i
;
722 string_char_byte_cache_string
= string
;
727 /* Return the character index corresponding to BYTE_INDEX in STRING. */
730 string_byte_to_char (string
, byte_index
)
735 int best_below
, best_below_byte
;
736 int best_above
, best_above_byte
;
738 if (! STRING_MULTIBYTE (string
))
741 best_below
= best_below_byte
= 0;
742 best_above
= XSTRING (string
)->size
;
743 best_above_byte
= XSTRING (string
)->size_byte
;
745 if (EQ (string
, string_char_byte_cache_string
))
747 if (string_char_byte_cache_bytepos
< byte_index
)
749 best_below
= string_char_byte_cache_charpos
;
750 best_below_byte
= string_char_byte_cache_bytepos
;
754 best_above
= string_char_byte_cache_charpos
;
755 best_above_byte
= string_char_byte_cache_bytepos
;
759 if (byte_index
- best_below_byte
< best_above_byte
- byte_index
)
761 while (best_below_byte
< byte_index
)
764 FETCH_STRING_CHAR_ADVANCE (c
, string
, best_below
, best_below_byte
);
767 i_byte
= best_below_byte
;
771 while (best_above_byte
> byte_index
)
773 int best_above_byte_saved
= --best_above_byte
;
775 while (best_above_byte
> 0
776 && !CHAR_HEAD_P (XSTRING (string
)->data
[best_above_byte
]))
778 if (XSTRING (string
)->data
[best_above_byte
] < 0x80)
779 best_above_byte
= best_above_byte_saved
;
783 i_byte
= best_above_byte
;
786 string_char_byte_cache_bytepos
= i_byte
;
787 string_char_byte_cache_charpos
= i
;
788 string_char_byte_cache_string
= string
;
793 /* Convert STRING to a multibyte string.
794 Single-byte characters 0200 through 0377 are converted
795 by adding nonascii_insert_offset to each. */
798 string_make_multibyte (string
)
804 if (STRING_MULTIBYTE (string
))
807 nbytes
= count_size_as_multibyte (XSTRING (string
)->data
,
808 XSTRING (string
)->size
);
809 /* If all the chars are ASCII, they won't need any more bytes
810 once converted. In that case, we can return STRING itself. */
811 if (nbytes
== XSTRING (string
)->size_byte
)
814 buf
= (unsigned char *) alloca (nbytes
);
815 copy_text (XSTRING (string
)->data
, buf
, XSTRING (string
)->size_byte
,
818 return make_multibyte_string (buf
, XSTRING (string
)->size
, nbytes
);
821 /* Convert STRING to a single-byte string. */
824 string_make_unibyte (string
)
829 if (! STRING_MULTIBYTE (string
))
832 buf
= (unsigned char *) alloca (XSTRING (string
)->size
);
834 copy_text (XSTRING (string
)->data
, buf
, XSTRING (string
)->size_byte
,
837 return make_unibyte_string (buf
, XSTRING (string
)->size
);
840 DEFUN ("string-make-multibyte", Fstring_make_multibyte
, Sstring_make_multibyte
,
842 "Return the multibyte equivalent of STRING.")
846 return string_make_multibyte (string
);
849 DEFUN ("string-make-unibyte", Fstring_make_unibyte
, Sstring_make_unibyte
,
851 "Return the unibyte equivalent of STRING.")
855 return string_make_unibyte (string
);
858 DEFUN ("string-as-unibyte", Fstring_as_unibyte
, Sstring_as_unibyte
,
860 "Return a unibyte string with the same individual bytes as STRING.\n\
861 If STRING is unibyte, the result is STRING itself.")
865 if (STRING_MULTIBYTE (string
))
867 string
= Fcopy_sequence (string
);
868 XSTRING (string
)->size
= XSTRING (string
)->size_byte
;
873 DEFUN ("string-as-multibyte", Fstring_as_multibyte
, Sstring_as_multibyte
,
875 "Return a multibyte string with the same individual bytes as STRING.\n\
876 If STRING is multibyte, the result is STRING itself.")
880 if (! STRING_MULTIBYTE (string
))
882 int newlen
= chars_in_text (XSTRING (string
)->data
,
883 XSTRING (string
)->size_byte
);
884 /* If all the chars are ASCII, STRING is already suitable. */
885 if (newlen
!= XSTRING (string
)->size_byte
)
887 string
= Fcopy_sequence (string
);
888 XSTRING (string
)->size
= newlen
;
894 DEFUN ("copy-alist", Fcopy_alist
, Scopy_alist
, 1, 1, 0,
895 "Return a copy of ALIST.\n\
896 This is an alist which represents the same mapping from objects to objects,\n\
897 but does not share the alist structure with ALIST.\n\
898 The objects mapped (cars and cdrs of elements of the alist)\n\
899 are shared, however.\n\
900 Elements of ALIST that are not conses are also shared.")
904 register Lisp_Object tem
;
906 CHECK_LIST (alist
, 0);
909 alist
= concat (1, &alist
, Lisp_Cons
, 0);
910 for (tem
= alist
; CONSP (tem
); tem
= XCONS (tem
)->cdr
)
912 register Lisp_Object car
;
913 car
= XCONS (tem
)->car
;
916 XCONS (tem
)->car
= Fcons (XCONS (car
)->car
, XCONS (car
)->cdr
);
921 DEFUN ("substring", Fsubstring
, Ssubstring
, 2, 3, 0,
922 "Return a substring of STRING, starting at index FROM and ending before TO.\n\
923 TO may be nil or omitted; then the substring runs to the end of STRING.\n\
924 If FROM or TO is negative, it counts from the end.\n\
926 This function allows vectors as well as strings.")
929 register Lisp_Object from
, to
;
934 int from_char
, to_char
;
935 int from_byte
, to_byte
;
937 if (! (STRINGP (string
) || VECTORP (string
)))
938 wrong_type_argument (Qarrayp
, string
);
940 CHECK_NUMBER (from
, 1);
942 if (STRINGP (string
))
944 size
= XSTRING (string
)->size
;
945 size_byte
= XSTRING (string
)->size_byte
;
948 size
= XVECTOR (string
)->size
;
957 CHECK_NUMBER (to
, 2);
963 if (STRINGP (string
))
964 to_byte
= string_char_to_byte (string
, to_char
);
967 from_char
= XINT (from
);
970 if (STRINGP (string
))
971 from_byte
= string_char_to_byte (string
, from_char
);
973 if (!(0 <= from_char
&& from_char
<= to_char
&& to_char
<= size
))
974 args_out_of_range_3 (string
, make_number (from_char
),
975 make_number (to_char
));
977 if (STRINGP (string
))
979 res
= make_multibyte_string (XSTRING (string
)->data
+ from_byte
,
980 to_char
- from_char
, to_byte
- from_byte
);
981 copy_text_properties (from_char
, to_char
, string
,
982 make_number (0), res
, Qnil
);
985 res
= Fvector (to_char
- from_char
,
986 XVECTOR (string
)->contents
+ from_char
);
991 /* Extract a substring of STRING, giving start and end positions
992 both in characters and in bytes. */
995 substring_both (string
, from
, from_byte
, to
, to_byte
)
997 int from
, from_byte
, to
, to_byte
;
1003 if (! (STRINGP (string
) || VECTORP (string
)))
1004 wrong_type_argument (Qarrayp
, string
);
1006 if (STRINGP (string
))
1008 size
= XSTRING (string
)->size
;
1009 size_byte
= XSTRING (string
)->size_byte
;
1012 size
= XVECTOR (string
)->size
;
1014 if (!(0 <= from
&& from
<= to
&& to
<= size
))
1015 args_out_of_range_3 (string
, make_number (from
), make_number (to
));
1017 if (STRINGP (string
))
1019 res
= make_multibyte_string (XSTRING (string
)->data
+ from_byte
,
1020 to
- from
, to_byte
- from_byte
);
1021 copy_text_properties (from
, to
, string
, make_number (0), res
, Qnil
);
1024 res
= Fvector (to
- from
,
1025 XVECTOR (string
)->contents
+ from
);
1030 DEFUN ("nthcdr", Fnthcdr
, Snthcdr
, 2, 2, 0,
1031 "Take cdr N times on LIST, returns the result.")
1034 register Lisp_Object list
;
1036 register int i
, num
;
1037 CHECK_NUMBER (n
, 0);
1039 for (i
= 0; i
< num
&& !NILP (list
); i
++)
1047 DEFUN ("nth", Fnth
, Snth
, 2, 2, 0,
1048 "Return the Nth element of LIST.\n\
1049 N counts from zero. If LIST is not that long, nil is returned.")
1051 Lisp_Object n
, list
;
1053 return Fcar (Fnthcdr (n
, list
));
1056 DEFUN ("elt", Felt
, Selt
, 2, 2, 0,
1057 "Return element of SEQUENCE at index N.")
1059 register Lisp_Object sequence
, n
;
1061 CHECK_NUMBER (n
, 0);
1064 if (CONSP (sequence
) || NILP (sequence
))
1065 return Fcar (Fnthcdr (n
, sequence
));
1066 else if (STRINGP (sequence
) || VECTORP (sequence
)
1067 || BOOL_VECTOR_P (sequence
) || CHAR_TABLE_P (sequence
))
1068 return Faref (sequence
, n
);
1070 sequence
= wrong_type_argument (Qsequencep
, sequence
);
1074 DEFUN ("member", Fmember
, Smember
, 2, 2, 0,
1075 "Return non-nil if ELT is an element of LIST. Comparison done with `equal'.\n\
1076 The value is actually the tail of LIST whose car is ELT.")
1078 register Lisp_Object elt
;
1081 register Lisp_Object tail
;
1082 for (tail
= list
; !NILP (tail
); tail
= XCONS (tail
)->cdr
)
1084 register Lisp_Object tem
;
1086 if (! NILP (Fequal (elt
, tem
)))
1093 DEFUN ("memq", Fmemq
, Smemq
, 2, 2, 0,
1094 "Return non-nil if ELT is an element of LIST. Comparison done with EQ.\n\
1095 The value is actually the tail of LIST whose car is ELT.")
1097 register Lisp_Object elt
;
1100 register Lisp_Object tail
;
1101 for (tail
= list
; !NILP (tail
); tail
= XCONS (tail
)->cdr
)
1103 register Lisp_Object tem
;
1105 if (EQ (elt
, tem
)) return tail
;
1111 DEFUN ("assq", Fassq
, Sassq
, 2, 2, 0,
1112 "Return non-nil if KEY is `eq' to the car of an element of LIST.\n\
1113 The value is actually the element of LIST whose car is KEY.\n\
1114 Elements of LIST that are not conses are ignored.")
1116 register Lisp_Object key
;
1119 register Lisp_Object tail
;
1120 for (tail
= list
; !NILP (tail
); tail
= XCONS (tail
)->cdr
)
1122 register Lisp_Object elt
, tem
;
1124 if (!CONSP (elt
)) continue;
1125 tem
= XCONS (elt
)->car
;
1126 if (EQ (key
, tem
)) return elt
;
1132 /* Like Fassq but never report an error and do not allow quits.
1133 Use only on lists known never to be circular. */
1136 assq_no_quit (key
, list
)
1137 register Lisp_Object key
;
1140 register Lisp_Object tail
;
1141 for (tail
= list
; CONSP (tail
); tail
= XCONS (tail
)->cdr
)
1143 register Lisp_Object elt
, tem
;
1145 if (!CONSP (elt
)) continue;
1146 tem
= XCONS (elt
)->car
;
1147 if (EQ (key
, tem
)) return elt
;
1152 DEFUN ("assoc", Fassoc
, Sassoc
, 2, 2, 0,
1153 "Return non-nil if KEY is `equal' to the car of an element of LIST.\n\
1154 The value is actually the element of LIST whose car equals KEY.")
1156 register Lisp_Object key
;
1159 register Lisp_Object tail
;
1160 for (tail
= list
; !NILP (tail
); tail
= XCONS (tail
)->cdr
)
1162 register Lisp_Object elt
, tem
;
1164 if (!CONSP (elt
)) continue;
1165 tem
= Fequal (XCONS (elt
)->car
, key
);
1166 if (!NILP (tem
)) return elt
;
1172 DEFUN ("rassq", Frassq
, Srassq
, 2, 2, 0,
1173 "Return non-nil if ELT is `eq' to the cdr of an element of LIST.\n\
1174 The value is actually the element of LIST whose cdr is ELT.")
1176 register Lisp_Object key
;
1179 register Lisp_Object tail
;
1180 for (tail
= list
; !NILP (tail
); tail
= XCONS (tail
)->cdr
)
1182 register Lisp_Object elt
, tem
;
1184 if (!CONSP (elt
)) continue;
1185 tem
= XCONS (elt
)->cdr
;
1186 if (EQ (key
, tem
)) return elt
;
1192 DEFUN ("rassoc", Frassoc
, Srassoc
, 2, 2, 0,
1193 "Return non-nil if KEY is `equal' to the cdr of an element of LIST.\n\
1194 The value is actually the element of LIST whose cdr equals KEY.")
1196 register Lisp_Object key
;
1199 register Lisp_Object tail
;
1200 for (tail
= list
; !NILP (tail
); tail
= XCONS (tail
)->cdr
)
1202 register Lisp_Object elt
, tem
;
1204 if (!CONSP (elt
)) continue;
1205 tem
= Fequal (XCONS (elt
)->cdr
, key
);
1206 if (!NILP (tem
)) return elt
;
1212 DEFUN ("delq", Fdelq
, Sdelq
, 2, 2, 0,
1213 "Delete by side effect any occurrences of ELT as a member of LIST.\n\
1214 The modified LIST is returned. Comparison is done with `eq'.\n\
1215 If the first member of LIST is ELT, there is no way to remove it by side effect;\n\
1216 therefore, write `(setq foo (delq element foo))'\n\
1217 to be sure of changing the value of `foo'.")
1219 register Lisp_Object elt
;
1222 register Lisp_Object tail
, prev
;
1223 register Lisp_Object tem
;
1227 while (!NILP (tail
))
1233 list
= XCONS (tail
)->cdr
;
1235 Fsetcdr (prev
, XCONS (tail
)->cdr
);
1239 tail
= XCONS (tail
)->cdr
;
1245 DEFUN ("delete", Fdelete
, Sdelete
, 2, 2, 0,
1246 "Delete by side effect any occurrences of ELT as a member of LIST.\n\
1247 The modified LIST is returned. Comparison is done with `equal'.\n\
1248 If the first member of LIST is ELT, deleting it is not a side effect;\n\
1249 it is simply using a different list.\n\
1250 Therefore, write `(setq foo (delete element foo))'\n\
1251 to be sure of changing the value of `foo'.")
1253 register Lisp_Object elt
;
1256 register Lisp_Object tail
, prev
;
1257 register Lisp_Object tem
;
1261 while (!NILP (tail
))
1264 if (! NILP (Fequal (elt
, tem
)))
1267 list
= XCONS (tail
)->cdr
;
1269 Fsetcdr (prev
, XCONS (tail
)->cdr
);
1273 tail
= XCONS (tail
)->cdr
;
1279 DEFUN ("nreverse", Fnreverse
, Snreverse
, 1, 1, 0,
1280 "Reverse LIST by modifying cdr pointers.\n\
1281 Returns the beginning of the reversed list.")
1285 register Lisp_Object prev
, tail
, next
;
1287 if (NILP (list
)) return list
;
1290 while (!NILP (tail
))
1294 Fsetcdr (tail
, prev
);
1301 DEFUN ("reverse", Freverse
, Sreverse
, 1, 1, 0,
1302 "Reverse LIST, copying. Returns the beginning of the reversed list.\n\
1303 See also the function `nreverse', which is used more often.")
1309 for (new = Qnil
; CONSP (list
); list
= XCONS (list
)->cdr
)
1310 new = Fcons (XCONS (list
)->car
, new);
1312 wrong_type_argument (Qconsp
, list
);
1316 Lisp_Object
merge ();
1318 DEFUN ("sort", Fsort
, Ssort
, 2, 2, 0,
1319 "Sort LIST, stably, comparing elements using PREDICATE.\n\
1320 Returns the sorted list. LIST is modified by side effects.\n\
1321 PREDICATE is called with two elements of LIST, and should return T\n\
1322 if the first element is \"less\" than the second.")
1324 Lisp_Object list
, predicate
;
1326 Lisp_Object front
, back
;
1327 register Lisp_Object len
, tem
;
1328 struct gcpro gcpro1
, gcpro2
;
1329 register int length
;
1332 len
= Flength (list
);
1333 length
= XINT (len
);
1337 XSETINT (len
, (length
/ 2) - 1);
1338 tem
= Fnthcdr (len
, list
);
1340 Fsetcdr (tem
, Qnil
);
1342 GCPRO2 (front
, back
);
1343 front
= Fsort (front
, predicate
);
1344 back
= Fsort (back
, predicate
);
1346 return merge (front
, back
, predicate
);
1350 merge (org_l1
, org_l2
, pred
)
1351 Lisp_Object org_l1
, org_l2
;
1355 register Lisp_Object tail
;
1357 register Lisp_Object l1
, l2
;
1358 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
1365 /* It is sufficient to protect org_l1 and org_l2.
1366 When l1 and l2 are updated, we copy the new values
1367 back into the org_ vars. */
1368 GCPRO4 (org_l1
, org_l2
, pred
, value
);
1388 tem
= call2 (pred
, Fcar (l2
), Fcar (l1
));
1404 Fsetcdr (tail
, tem
);
1410 DEFUN ("plist-get", Fplist_get
, Splist_get
, 2, 2, 0,
1411 "Extract a value from a property list.\n\
1412 PLIST is a property list, which is a list of the form\n\
1413 \(PROP1 VALUE1 PROP2 VALUE2...). This function returns the value\n\
1414 corresponding to the given PROP, or nil if PROP is not\n\
1415 one of the properties on the list.")
1418 register Lisp_Object prop
;
1420 register Lisp_Object tail
;
1421 for (tail
= plist
; !NILP (tail
); tail
= Fcdr (XCONS (tail
)->cdr
))
1423 register Lisp_Object tem
;
1426 return Fcar (XCONS (tail
)->cdr
);
1431 DEFUN ("get", Fget
, Sget
, 2, 2, 0,
1432 "Return the value of SYMBOL's PROPNAME property.\n\
1433 This is the last value stored with `(put SYMBOL PROPNAME VALUE)'.")
1435 Lisp_Object symbol
, propname
;
1437 CHECK_SYMBOL (symbol
, 0);
1438 return Fplist_get (XSYMBOL (symbol
)->plist
, propname
);
1441 DEFUN ("plist-put", Fplist_put
, Splist_put
, 3, 3, 0,
1442 "Change value in PLIST of PROP to VAL.\n\
1443 PLIST is a property list, which is a list of the form\n\
1444 \(PROP1 VALUE1 PROP2 VALUE2 ...). PROP is a symbol and VAL is any object.\n\
1445 If PROP is already a property on the list, its value is set to VAL,\n\
1446 otherwise the new PROP VAL pair is added. The new plist is returned;\n\
1447 use `(setq x (plist-put x prop val))' to be sure to use the new value.\n\
1448 The PLIST is modified by side effects.")
1451 register Lisp_Object prop
;
1454 register Lisp_Object tail
, prev
;
1455 Lisp_Object newcell
;
1457 for (tail
= plist
; CONSP (tail
) && CONSP (XCONS (tail
)->cdr
);
1458 tail
= XCONS (XCONS (tail
)->cdr
)->cdr
)
1460 if (EQ (prop
, XCONS (tail
)->car
))
1462 Fsetcar (XCONS (tail
)->cdr
, val
);
1467 newcell
= Fcons (prop
, Fcons (val
, Qnil
));
1471 Fsetcdr (XCONS (prev
)->cdr
, newcell
);
1475 DEFUN ("put", Fput
, Sput
, 3, 3, 0,
1476 "Store SYMBOL's PROPNAME property with value VALUE.\n\
1477 It can be retrieved with `(get SYMBOL PROPNAME)'.")
1478 (symbol
, propname
, value
)
1479 Lisp_Object symbol
, propname
, value
;
1481 CHECK_SYMBOL (symbol
, 0);
1482 XSYMBOL (symbol
)->plist
1483 = Fplist_put (XSYMBOL (symbol
)->plist
, propname
, value
);
1487 DEFUN ("equal", Fequal
, Sequal
, 2, 2, 0,
1488 "Return t if two Lisp objects have similar structure and contents.\n\
1489 They must have the same data type.\n\
1490 Conses are compared by comparing the cars and the cdrs.\n\
1491 Vectors and strings are compared element by element.\n\
1492 Numbers are compared by value, but integers cannot equal floats.\n\
1493 (Use `=' if you want integers and floats to be able to be equal.)\n\
1494 Symbols must match exactly.")
1496 register Lisp_Object o1
, o2
;
1498 return internal_equal (o1
, o2
, 0) ? Qt
: Qnil
;
1502 internal_equal (o1
, o2
, depth
)
1503 register Lisp_Object o1
, o2
;
1507 error ("Stack overflow in equal");
1513 if (XTYPE (o1
) != XTYPE (o2
))
1518 #ifdef LISP_FLOAT_TYPE
1520 return (extract_float (o1
) == extract_float (o2
));
1524 if (!internal_equal (XCONS (o1
)->car
, XCONS (o2
)->car
, depth
+ 1))
1526 o1
= XCONS (o1
)->cdr
;
1527 o2
= XCONS (o2
)->cdr
;
1531 if (XMISCTYPE (o1
) != XMISCTYPE (o2
))
1535 if (!internal_equal (OVERLAY_START (o1
), OVERLAY_START (o1
),
1537 || !internal_equal (OVERLAY_END (o1
), OVERLAY_END (o1
),
1540 o1
= XOVERLAY (o1
)->plist
;
1541 o2
= XOVERLAY (o2
)->plist
;
1546 return (XMARKER (o1
)->buffer
== XMARKER (o2
)->buffer
1547 && (XMARKER (o1
)->buffer
== 0
1548 || XMARKER (o1
)->bytepos
== XMARKER (o2
)->bytepos
));
1552 case Lisp_Vectorlike
:
1554 register int i
, size
;
1555 size
= XVECTOR (o1
)->size
;
1556 /* Pseudovectors have the type encoded in the size field, so this test
1557 actually checks that the objects have the same type as well as the
1559 if (XVECTOR (o2
)->size
!= size
)
1561 /* Boolvectors are compared much like strings. */
1562 if (BOOL_VECTOR_P (o1
))
1565 = (XBOOL_VECTOR (o1
)->size
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
;
1567 if (XBOOL_VECTOR (o1
)->size
!= XBOOL_VECTOR (o2
)->size
)
1569 if (bcmp (XBOOL_VECTOR (o1
)->data
, XBOOL_VECTOR (o2
)->data
,
1574 if (WINDOW_CONFIGURATIONP (o1
))
1575 return compare_window_configurations (o1
, o2
);
1577 /* Aside from them, only true vectors, char-tables, and compiled
1578 functions are sensible to compare, so eliminate the others now. */
1579 if (size
& PSEUDOVECTOR_FLAG
)
1581 if (!(size
& (PVEC_COMPILED
| PVEC_CHAR_TABLE
)))
1583 size
&= PSEUDOVECTOR_SIZE_MASK
;
1585 for (i
= 0; i
< size
; i
++)
1588 v1
= XVECTOR (o1
)->contents
[i
];
1589 v2
= XVECTOR (o2
)->contents
[i
];
1590 if (!internal_equal (v1
, v2
, depth
+ 1))
1598 if (XSTRING (o1
)->size
!= XSTRING (o2
)->size
)
1600 if (XSTRING (o1
)->size_byte
!= XSTRING (o2
)->size_byte
)
1602 if (bcmp (XSTRING (o1
)->data
, XSTRING (o2
)->data
,
1603 XSTRING (o1
)->size_byte
))
1610 extern Lisp_Object
Fmake_char_internal ();
1612 DEFUN ("fillarray", Ffillarray
, Sfillarray
, 2, 2, 0,
1613 "Store each element of ARRAY with ITEM.\n\
1614 ARRAY is a vector, string, char-table, or bool-vector.")
1616 Lisp_Object array
, item
;
1618 register int size
, index
, charval
;
1620 if (VECTORP (array
))
1622 register Lisp_Object
*p
= XVECTOR (array
)->contents
;
1623 size
= XVECTOR (array
)->size
;
1624 for (index
= 0; index
< size
; index
++)
1627 else if (CHAR_TABLE_P (array
))
1629 register Lisp_Object
*p
= XCHAR_TABLE (array
)->contents
;
1630 size
= CHAR_TABLE_ORDINARY_SLOTS
;
1631 for (index
= 0; index
< size
; index
++)
1633 XCHAR_TABLE (array
)->defalt
= Qnil
;
1635 else if (STRINGP (array
))
1637 register unsigned char *p
= XSTRING (array
)->data
;
1638 CHECK_NUMBER (item
, 1);
1639 charval
= XINT (item
);
1640 size
= XSTRING (array
)->size
;
1641 for (index
= 0; index
< size
; index
++)
1644 else if (BOOL_VECTOR_P (array
))
1646 register unsigned char *p
= XBOOL_VECTOR (array
)->data
;
1648 = (XBOOL_VECTOR (array
)->size
+ BITS_PER_CHAR
- 1) / BITS_PER_CHAR
;
1650 charval
= (! NILP (item
) ? -1 : 0);
1651 for (index
= 0; index
< size_in_chars
; index
++)
1656 array
= wrong_type_argument (Qarrayp
, array
);
1662 DEFUN ("char-table-subtype", Fchar_table_subtype
, Schar_table_subtype
,
1664 "Return the subtype of char-table CHAR-TABLE. The value is a symbol.")
1666 Lisp_Object char_table
;
1668 CHECK_CHAR_TABLE (char_table
, 0);
1670 return XCHAR_TABLE (char_table
)->purpose
;
1673 DEFUN ("char-table-parent", Fchar_table_parent
, Schar_table_parent
,
1675 "Return the parent char-table of CHAR-TABLE.\n\
1676 The value is either nil or another char-table.\n\
1677 If CHAR-TABLE holds nil for a given character,\n\
1678 then the actual applicable value is inherited from the parent char-table\n\
1679 \(or from its parents, if necessary).")
1681 Lisp_Object char_table
;
1683 CHECK_CHAR_TABLE (char_table
, 0);
1685 return XCHAR_TABLE (char_table
)->parent
;
1688 DEFUN ("set-char-table-parent", Fset_char_table_parent
, Sset_char_table_parent
,
1690 "Set the parent char-table of CHAR-TABLE to PARENT.\n\
1691 PARENT must be either nil or another char-table.")
1692 (char_table
, parent
)
1693 Lisp_Object char_table
, parent
;
1697 CHECK_CHAR_TABLE (char_table
, 0);
1701 CHECK_CHAR_TABLE (parent
, 0);
1703 for (temp
= parent
; !NILP (temp
); temp
= XCHAR_TABLE (temp
)->parent
)
1704 if (EQ (temp
, char_table
))
1705 error ("Attempt to make a chartable be its own parent");
1708 XCHAR_TABLE (char_table
)->parent
= parent
;
1713 DEFUN ("char-table-extra-slot", Fchar_table_extra_slot
, Schar_table_extra_slot
,
1715 "Return the value of CHAR-TABLE's extra-slot number N.")
1717 Lisp_Object char_table
, n
;
1719 CHECK_CHAR_TABLE (char_table
, 1);
1720 CHECK_NUMBER (n
, 2);
1722 || XINT (n
) >= CHAR_TABLE_EXTRA_SLOTS (XCHAR_TABLE (char_table
)))
1723 args_out_of_range (char_table
, n
);
1725 return XCHAR_TABLE (char_table
)->extras
[XINT (n
)];
1728 DEFUN ("set-char-table-extra-slot", Fset_char_table_extra_slot
,
1729 Sset_char_table_extra_slot
,
1731 "Set CHAR-TABLE's extra-slot number N to VALUE.")
1732 (char_table
, n
, value
)
1733 Lisp_Object char_table
, n
, value
;
1735 CHECK_CHAR_TABLE (char_table
, 1);
1736 CHECK_NUMBER (n
, 2);
1738 || XINT (n
) >= CHAR_TABLE_EXTRA_SLOTS (XCHAR_TABLE (char_table
)))
1739 args_out_of_range (char_table
, n
);
1741 return XCHAR_TABLE (char_table
)->extras
[XINT (n
)] = value
;
1744 DEFUN ("char-table-range", Fchar_table_range
, Schar_table_range
,
1746 "Return the value in CHAR-TABLE for a range of characters RANGE.\n\
1747 RANGE should be nil (for the default value)\n\
1748 a vector which identifies a character set or a row of a character set,\n\
1749 a character set name, or a character code.")
1751 Lisp_Object char_table
, range
;
1755 CHECK_CHAR_TABLE (char_table
, 0);
1757 if (EQ (range
, Qnil
))
1758 return XCHAR_TABLE (char_table
)->defalt
;
1759 else if (INTEGERP (range
))
1760 return Faref (char_table
, range
);
1761 else if (SYMBOLP (range
))
1763 Lisp_Object charset_info
;
1765 charset_info
= Fget (range
, Qcharset
);
1766 CHECK_VECTOR (charset_info
, 0);
1768 return Faref (char_table
, XVECTOR (charset_info
)->contents
[0] + 128);
1770 else if (VECTORP (range
))
1772 if (XVECTOR (range
)->size
== 1)
1773 return Faref (char_table
, XVECTOR (range
)->contents
[0] + 128);
1776 int size
= XVECTOR (range
)->size
;
1777 Lisp_Object
*val
= XVECTOR (range
)->contents
;
1778 Lisp_Object ch
= Fmake_char_internal (size
<= 0 ? Qnil
: val
[0],
1779 size
<= 1 ? Qnil
: val
[1],
1780 size
<= 2 ? Qnil
: val
[2]);
1781 return Faref (char_table
, ch
);
1785 error ("Invalid RANGE argument to `char-table-range'");
1788 DEFUN ("set-char-table-range", Fset_char_table_range
, Sset_char_table_range
,
1790 "Set the value in CHAR-TABLE for a range of characters RANGE to VALUE.\n\
1791 RANGE should be t (for all characters), nil (for the default value)\n\
1792 a vector which identifies a character set or a row of a character set,\n\
1793 a coding system, or a character code.")
1794 (char_table
, range
, value
)
1795 Lisp_Object char_table
, range
, value
;
1799 CHECK_CHAR_TABLE (char_table
, 0);
1802 for (i
= 0; i
< CHAR_TABLE_ORDINARY_SLOTS
; i
++)
1803 XCHAR_TABLE (char_table
)->contents
[i
] = value
;
1804 else if (EQ (range
, Qnil
))
1805 XCHAR_TABLE (char_table
)->defalt
= value
;
1806 else if (SYMBOLP (range
))
1808 Lisp_Object charset_info
;
1810 charset_info
= Fget (range
, Qcharset
);
1811 CHECK_VECTOR (charset_info
, 0);
1813 return Faset (char_table
, XVECTOR (charset_info
)->contents
[0] + 128,
1816 else if (INTEGERP (range
))
1817 Faset (char_table
, range
, value
);
1818 else if (VECTORP (range
))
1820 if (XVECTOR (range
)->size
== 1)
1821 return Faset (char_table
, XVECTOR (range
)->contents
[0] + 128, value
);
1824 int size
= XVECTOR (range
)->size
;
1825 Lisp_Object
*val
= XVECTOR (range
)->contents
;
1826 Lisp_Object ch
= Fmake_char_internal (size
<= 0 ? Qnil
: val
[0],
1827 size
<= 1 ? Qnil
: val
[1],
1828 size
<= 2 ? Qnil
: val
[2]);
1829 return Faset (char_table
, ch
, value
);
1833 error ("Invalid RANGE argument to `set-char-table-range'");
1838 DEFUN ("set-char-table-default", Fset_char_table_default
,
1839 Sset_char_table_default
, 3, 3, 0,
1840 "Set the default value in CHAR-TABLE for a generic character CHAR to VALUE.\n\
1841 The generic character specifies the group of characters.\n\
1842 See also the documentation of make-char.")
1843 (char_table
, ch
, value
)
1844 Lisp_Object char_table
, ch
, value
;
1846 int c
, i
, charset
, code1
, code2
;
1849 CHECK_CHAR_TABLE (char_table
, 0);
1850 CHECK_NUMBER (ch
, 1);
1853 SPLIT_NON_ASCII_CHAR (c
, charset
, code1
, code2
);
1854 if (! CHARSET_DEFINED_P (charset
))
1855 error ("Invalid character: %d", c
);
1857 if (charset
== CHARSET_ASCII
)
1858 return (XCHAR_TABLE (char_table
)->defalt
= value
);
1860 /* Even if C is not a generic char, we had better behave as if a
1861 generic char is specified. */
1862 if (CHARSET_DIMENSION (charset
) == 1)
1864 temp
= XCHAR_TABLE (char_table
)->contents
[charset
+ 128];
1867 if (SUB_CHAR_TABLE_P (temp
))
1868 XCHAR_TABLE (temp
)->defalt
= value
;
1870 XCHAR_TABLE (char_table
)->contents
[charset
+ 128] = value
;
1874 if (! SUB_CHAR_TABLE_P (char_table
))
1875 char_table
= (XCHAR_TABLE (char_table
)->contents
[charset
+ 128]
1876 = make_sub_char_table (temp
));
1877 temp
= XCHAR_TABLE (char_table
)->contents
[code1
];
1878 if (SUB_CHAR_TABLE_P (temp
))
1879 XCHAR_TABLE (temp
)->defalt
= value
;
1881 XCHAR_TABLE (char_table
)->contents
[code1
] = value
;
1885 /* Map C_FUNCTION or FUNCTION over SUBTABLE, calling it for each
1886 character or group of characters that share a value.
1887 DEPTH is the current depth in the originally specified
1888 chartable, and INDICES contains the vector indices
1889 for the levels our callers have descended.
1891 ARG is passed to C_FUNCTION when that is called. */
1894 map_char_table (c_function
, function
, subtable
, arg
, depth
, indices
)
1895 void (*c_function
) P_ ((Lisp_Object
, Lisp_Object
, Lisp_Object
));
1896 Lisp_Object function
, subtable
, arg
, *indices
;
1903 /* At first, handle ASCII and 8-bit European characters. */
1904 for (i
= 0; i
< CHAR_TABLE_SINGLE_BYTE_SLOTS
; i
++)
1906 Lisp_Object elt
= XCHAR_TABLE (subtable
)->contents
[i
];
1908 (*c_function
) (arg
, make_number (i
), elt
);
1910 call2 (function
, make_number (i
), elt
);
1912 #if 0 /* If the char table has entries for higher characters,
1913 we should report them. */
1914 if (NILP (current_buffer
->enable_multibyte_characters
))
1917 to
= CHAR_TABLE_ORDINARY_SLOTS
;
1922 to
= SUB_CHAR_TABLE_ORDINARY_SLOTS
;
1927 Lisp_Object elt
= XCHAR_TABLE (subtable
)->contents
[i
];
1929 XSETFASTINT (indices
[depth
], i
);
1931 if (SUB_CHAR_TABLE_P (elt
))
1934 error ("Too deep char table");
1935 map_char_table (c_function
, function
, elt
, arg
, depth
+ 1, indices
);
1939 int charset
= XFASTINT (indices
[0]) - 128, c1
, c2
, c
;
1941 if (CHARSET_DEFINED_P (charset
))
1943 c1
= depth
>= 1 ? XFASTINT (indices
[1]) : 0;
1944 c2
= depth
>= 2 ? XFASTINT (indices
[2]) : 0;
1945 c
= MAKE_NON_ASCII_CHAR (charset
, c1
, c2
);
1947 (*c_function
) (arg
, make_number (c
), elt
);
1949 call2 (function
, make_number (c
), elt
);
1955 DEFUN ("map-char-table", Fmap_char_table
, Smap_char_table
,
1957 "Call FUNCTION for each (normal and generic) characters in CHAR-TABLE.\n\
1958 FUNCTION is called with two arguments--a key and a value.\n\
1959 The key is always a possible IDX argument to `aref'.")
1960 (function
, char_table
)
1961 Lisp_Object function
, char_table
;
1963 /* The depth of char table is at most 3. */
1964 Lisp_Object indices
[3];
1966 CHECK_CHAR_TABLE (char_table
, 1);
1968 map_char_table (NULL
, function
, char_table
, char_table
, 0, indices
);
1978 Lisp_Object args
[2];
1981 return Fnconc (2, args
);
1983 return Fnconc (2, &s1
);
1984 #endif /* NO_ARG_ARRAY */
1987 DEFUN ("nconc", Fnconc
, Snconc
, 0, MANY
, 0,
1988 "Concatenate any number of lists by altering them.\n\
1989 Only the last argument is not altered, and need not be a list.")
1994 register int argnum
;
1995 register Lisp_Object tail
, tem
, val
;
1999 for (argnum
= 0; argnum
< nargs
; argnum
++)
2002 if (NILP (tem
)) continue;
2007 if (argnum
+ 1 == nargs
) break;
2010 tem
= wrong_type_argument (Qlistp
, tem
);
2019 tem
= args
[argnum
+ 1];
2020 Fsetcdr (tail
, tem
);
2022 args
[argnum
+ 1] = tail
;
2028 /* This is the guts of all mapping functions.
2029 Apply FN to each element of SEQ, one by one,
2030 storing the results into elements of VALS, a C vector of Lisp_Objects.
2031 LENI is the length of VALS, which should also be the length of SEQ. */
2034 mapcar1 (leni
, vals
, fn
, seq
)
2037 Lisp_Object fn
, seq
;
2039 register Lisp_Object tail
;
2042 struct gcpro gcpro1
, gcpro2
, gcpro3
;
2044 /* Don't let vals contain any garbage when GC happens. */
2045 for (i
= 0; i
< leni
; i
++)
2048 GCPRO3 (dummy
, fn
, seq
);
2050 gcpro1
.nvars
= leni
;
2051 /* We need not explicitly protect `tail' because it is used only on lists, and
2052 1) lists are not relocated and 2) the list is marked via `seq' so will not be freed */
2056 for (i
= 0; i
< leni
; i
++)
2058 dummy
= XVECTOR (seq
)->contents
[i
];
2059 vals
[i
] = call1 (fn
, dummy
);
2062 else if (STRINGP (seq
) && ! STRING_MULTIBYTE (seq
))
2064 /* Single-byte string. */
2065 for (i
= 0; i
< leni
; i
++)
2067 XSETFASTINT (dummy
, XSTRING (seq
)->data
[i
]);
2068 vals
[i
] = call1 (fn
, dummy
);
2071 else if (STRINGP (seq
))
2073 /* Multi-byte string. */
2074 int len_byte
= XSTRING (seq
)->size_byte
;
2077 for (i
= 0, i_byte
= 0; i
< leni
;)
2082 FETCH_STRING_CHAR_ADVANCE (c
, seq
, i
, i_byte
);
2083 XSETFASTINT (dummy
, c
);
2084 vals
[i_before
] = call1 (fn
, dummy
);
2087 else /* Must be a list, since Flength did not get an error */
2090 for (i
= 0; i
< leni
; i
++)
2092 vals
[i
] = call1 (fn
, Fcar (tail
));
2093 tail
= XCONS (tail
)->cdr
;
2100 DEFUN ("mapconcat", Fmapconcat
, Smapconcat
, 3, 3, 0,
2101 "Apply FUNCTION to each element of SEQUENCE, and concat the results as strings.\n\
2102 In between each pair of results, stick in SEPARATOR. Thus, \" \" as\n\
2103 SEPARATOR results in spaces between the values returned by FUNCTION.")
2104 (function
, sequence
, separator
)
2105 Lisp_Object function
, sequence
, separator
;
2110 register Lisp_Object
*args
;
2112 struct gcpro gcpro1
;
2114 len
= Flength (sequence
);
2116 nargs
= leni
+ leni
- 1;
2117 if (nargs
< 0) return build_string ("");
2119 args
= (Lisp_Object
*) alloca (nargs
* sizeof (Lisp_Object
));
2122 mapcar1 (leni
, args
, function
, sequence
);
2125 for (i
= leni
- 1; i
>= 0; i
--)
2126 args
[i
+ i
] = args
[i
];
2128 for (i
= 1; i
< nargs
; i
+= 2)
2129 args
[i
] = separator
;
2131 return Fconcat (nargs
, args
);
2134 DEFUN ("mapcar", Fmapcar
, Smapcar
, 2, 2, 0,
2135 "Apply FUNCTION to each element of SEQUENCE, and make a list of the results.\n\
2136 The result is a list just as long as SEQUENCE.\n\
2137 SEQUENCE may be a list, a vector or a string.")
2138 (function
, sequence
)
2139 Lisp_Object function
, sequence
;
2141 register Lisp_Object len
;
2143 register Lisp_Object
*args
;
2145 len
= Flength (sequence
);
2146 leni
= XFASTINT (len
);
2147 args
= (Lisp_Object
*) alloca (leni
* sizeof (Lisp_Object
));
2149 mapcar1 (leni
, args
, function
, sequence
);
2151 return Flist (leni
, args
);
2154 /* Anything that calls this function must protect from GC! */
2156 DEFUN ("y-or-n-p", Fy_or_n_p
, Sy_or_n_p
, 1, 1, 0,
2157 "Ask user a \"y or n\" question. Return t if answer is \"y\".\n\
2158 Takes one argument, which is the string to display to ask the question.\n\
2159 It should end in a space; `y-or-n-p' adds `(y or n) ' to it.\n\
2160 No confirmation of the answer is requested; a single character is enough.\n\
2161 Also accepts Space to mean yes, or Delete to mean no.")
2165 register Lisp_Object obj
, key
, def
, answer_string
, map
;
2166 register int answer
;
2167 Lisp_Object xprompt
;
2168 Lisp_Object args
[2];
2169 struct gcpro gcpro1
, gcpro2
;
2170 int count
= specpdl_ptr
- specpdl
;
2172 specbind (Qcursor_in_echo_area
, Qt
);
2174 map
= Fsymbol_value (intern ("query-replace-map"));
2176 CHECK_STRING (prompt
, 0);
2178 GCPRO2 (prompt
, xprompt
);
2184 if ((NILP (last_nonmenu_event
) || CONSP (last_nonmenu_event
))
2188 Lisp_Object pane
, menu
;
2189 redisplay_preserve_echo_area ();
2190 pane
= Fcons (Fcons (build_string ("Yes"), Qt
),
2191 Fcons (Fcons (build_string ("No"), Qnil
),
2193 menu
= Fcons (prompt
, pane
);
2194 obj
= Fx_popup_dialog (Qt
, menu
);
2195 answer
= !NILP (obj
);
2198 #endif /* HAVE_MENUS */
2199 cursor_in_echo_area
= 1;
2200 choose_minibuf_frame ();
2201 message_with_string ("%s(y or n) ", xprompt
, 0);
2203 if (minibuffer_auto_raise
)
2205 Lisp_Object mini_frame
;
2207 mini_frame
= WINDOW_FRAME (XWINDOW (minibuf_window
));
2209 Fraise_frame (mini_frame
);
2212 obj
= read_filtered_event (1, 0, 0);
2213 cursor_in_echo_area
= 0;
2214 /* If we need to quit, quit with cursor_in_echo_area = 0. */
2217 key
= Fmake_vector (make_number (1), obj
);
2218 def
= Flookup_key (map
, key
, Qt
);
2219 answer_string
= Fsingle_key_description (obj
);
2221 if (EQ (def
, intern ("skip")))
2226 else if (EQ (def
, intern ("act")))
2231 else if (EQ (def
, intern ("recenter")))
2237 else if (EQ (def
, intern ("quit")))
2239 /* We want to exit this command for exit-prefix,
2240 and this is the only way to do it. */
2241 else if (EQ (def
, intern ("exit-prefix")))
2246 /* If we don't clear this, then the next call to read_char will
2247 return quit_char again, and we'll enter an infinite loop. */
2252 if (EQ (xprompt
, prompt
))
2254 args
[0] = build_string ("Please answer y or n. ");
2256 xprompt
= Fconcat (2, args
);
2261 if (! noninteractive
)
2263 cursor_in_echo_area
= -1;
2264 message_with_string (answer
? "%s(y or n) y" : "%s(y or n) n",
2268 unbind_to (count
, Qnil
);
2269 return answer
? Qt
: Qnil
;
2272 /* This is how C code calls `yes-or-no-p' and allows the user
2275 Anything that calls this function must protect from GC! */
2278 do_yes_or_no_p (prompt
)
2281 return call1 (intern ("yes-or-no-p"), prompt
);
2284 /* Anything that calls this function must protect from GC! */
2286 DEFUN ("yes-or-no-p", Fyes_or_no_p
, Syes_or_no_p
, 1, 1, 0,
2287 "Ask user a yes-or-no question. Return t if answer is yes.\n\
2288 Takes one argument, which is the string to display to ask the question.\n\
2289 It should end in a space; `yes-or-no-p' adds `(yes or no) ' to it.\n\
2290 The user must confirm the answer with RET,\n\
2291 and can edit it until it has been confirmed.")
2295 register Lisp_Object ans
;
2296 Lisp_Object args
[2];
2297 struct gcpro gcpro1
;
2300 CHECK_STRING (prompt
, 0);
2303 if ((NILP (last_nonmenu_event
) || CONSP (last_nonmenu_event
))
2307 Lisp_Object pane
, menu
, obj
;
2308 redisplay_preserve_echo_area ();
2309 pane
= Fcons (Fcons (build_string ("Yes"), Qt
),
2310 Fcons (Fcons (build_string ("No"), Qnil
),
2313 menu
= Fcons (prompt
, pane
);
2314 obj
= Fx_popup_dialog (Qt
, menu
);
2318 #endif /* HAVE_MENUS */
2321 args
[1] = build_string ("(yes or no) ");
2322 prompt
= Fconcat (2, args
);
2328 ans
= Fdowncase (Fread_from_minibuffer (prompt
, Qnil
, Qnil
, Qnil
,
2329 Qyes_or_no_p_history
, Qnil
,
2331 if (XSTRING (ans
)->size
== 3 && !strcmp (XSTRING (ans
)->data
, "yes"))
2336 if (XSTRING (ans
)->size
== 2 && !strcmp (XSTRING (ans
)->data
, "no"))
2344 message ("Please answer yes or no.");
2345 Fsleep_for (make_number (2), Qnil
);
2349 DEFUN ("load-average", Fload_average
, Sload_average
, 0, 0, 0,
2350 "Return list of 1 minute, 5 minute and 15 minute load averages.\n\
2351 Each of the three load averages is multiplied by 100,\n\
2352 then converted to integer.\n\
2353 If the 5-minute or 15-minute load averages are not available, return a\n\
2354 shortened list, containing only those averages which are available.")
2358 int loads
= getloadavg (load_ave
, 3);
2362 error ("load-average not implemented for this operating system");
2366 ret
= Fcons (make_number ((int) (load_ave
[--loads
] * 100.0)), ret
);
2371 Lisp_Object Vfeatures
;
2373 DEFUN ("featurep", Ffeaturep
, Sfeaturep
, 1, 1, 0,
2374 "Returns t if FEATURE is present in this Emacs.\n\
2375 Use this to conditionalize execution of lisp code based on the presence or\n\
2376 absence of emacs or environment extensions.\n\
2377 Use `provide' to declare that a feature is available.\n\
2378 This function looks at the value of the variable `features'.")
2380 Lisp_Object feature
;
2382 register Lisp_Object tem
;
2383 CHECK_SYMBOL (feature
, 0);
2384 tem
= Fmemq (feature
, Vfeatures
);
2385 return (NILP (tem
)) ? Qnil
: Qt
;
2388 DEFUN ("provide", Fprovide
, Sprovide
, 1, 1, 0,
2389 "Announce that FEATURE is a feature of the current Emacs.")
2391 Lisp_Object feature
;
2393 register Lisp_Object tem
;
2394 CHECK_SYMBOL (feature
, 0);
2395 if (!NILP (Vautoload_queue
))
2396 Vautoload_queue
= Fcons (Fcons (Vfeatures
, Qnil
), Vautoload_queue
);
2397 tem
= Fmemq (feature
, Vfeatures
);
2399 Vfeatures
= Fcons (feature
, Vfeatures
);
2400 LOADHIST_ATTACH (Fcons (Qprovide
, feature
));
2404 DEFUN ("require", Frequire
, Srequire
, 1, 2, 0,
2405 "If feature FEATURE is not loaded, load it from FILENAME.\n\
2406 If FEATURE is not a member of the list `features', then the feature\n\
2407 is not loaded; so load the file FILENAME.\n\
2408 If FILENAME is omitted, the printname of FEATURE is used as the file name.")
2409 (feature
, file_name
)
2410 Lisp_Object feature
, file_name
;
2412 register Lisp_Object tem
;
2413 CHECK_SYMBOL (feature
, 0);
2414 tem
= Fmemq (feature
, Vfeatures
);
2415 LOADHIST_ATTACH (Fcons (Qrequire
, feature
));
2418 int count
= specpdl_ptr
- specpdl
;
2420 /* Value saved here is to be restored into Vautoload_queue */
2421 record_unwind_protect (un_autoload
, Vautoload_queue
);
2422 Vautoload_queue
= Qt
;
2424 Fload (NILP (file_name
) ? Fsymbol_name (feature
) : file_name
,
2425 Qnil
, Qt
, Qnil
, (NILP (file_name
) ? Qt
: Qnil
));
2427 tem
= Fmemq (feature
, Vfeatures
);
2429 error ("Required feature %s was not provided",
2430 XSYMBOL (feature
)->name
->data
);
2432 /* Once loading finishes, don't undo it. */
2433 Vautoload_queue
= Qt
;
2434 feature
= unbind_to (count
, feature
);
2439 /* Primitives for work of the "widget" library.
2440 In an ideal world, this section would not have been necessary.
2441 However, lisp function calls being as slow as they are, it turns
2442 out that some functions in the widget library (wid-edit.el) are the
2443 bottleneck of Widget operation. Here is their translation to C,
2444 for the sole reason of efficiency. */
2446 DEFUN ("widget-plist-member", Fwidget_plist_member
, Swidget_plist_member
, 2, 2, 0,
2447 "Return non-nil if PLIST has the property PROP.\n\
2448 PLIST is a property list, which is a list of the form\n\
2449 \(PROP1 VALUE1 PROP2 VALUE2 ...\). PROP is a symbol.\n\
2450 Unlike `plist-get', this allows you to distinguish between a missing\n\
2451 property and a property with the value nil.\n\
2452 The value is actually the tail of PLIST whose car is PROP.")
2454 Lisp_Object plist
, prop
;
2456 while (CONSP (plist
) && !EQ (XCAR (plist
), prop
))
2459 plist
= XCDR (plist
);
2460 plist
= CDR (plist
);
2465 DEFUN ("widget-put", Fwidget_put
, Swidget_put
, 3, 3, 0,
2466 "In WIDGET, set PROPERTY to VALUE.\n\
2467 The value can later be retrieved with `widget-get'.")
2468 (widget
, property
, value
)
2469 Lisp_Object widget
, property
, value
;
2471 CHECK_CONS (widget
, 1);
2472 XCDR (widget
) = Fplist_put (XCDR (widget
), property
, value
);
2475 DEFUN ("widget-get", Fwidget_get
, Swidget_get
, 2, 2, 0,
2476 "In WIDGET, get the value of PROPERTY.\n\
2477 The value could either be specified when the widget was created, or\n\
2478 later with `widget-put'.")
2480 Lisp_Object widget
, property
;
2488 CHECK_CONS (widget
, 1);
2489 tmp
= Fwidget_plist_member (XCDR (widget
), property
);
2495 tmp
= XCAR (widget
);
2498 widget
= Fget (tmp
, Qwidget_type
);
2502 DEFUN ("widget-apply", Fwidget_apply
, Swidget_apply
, 2, MANY
, 0,
2503 "Apply the value of WIDGET's PROPERTY to the widget itself.\n\
2504 ARGS are passed as extra arguments to the function.")
2509 /* This function can GC. */
2510 Lisp_Object newargs
[3];
2511 struct gcpro gcpro1
, gcpro2
;
2514 newargs
[0] = Fwidget_get (args
[0], args
[1]);
2515 newargs
[1] = args
[0];
2516 newargs
[2] = Flist (nargs
- 2, args
+ 2);
2517 GCPRO2 (newargs
[0], newargs
[2]);
2518 result
= Fapply (3, newargs
);
2525 Qstring_lessp
= intern ("string-lessp");
2526 staticpro (&Qstring_lessp
);
2527 Qprovide
= intern ("provide");
2528 staticpro (&Qprovide
);
2529 Qrequire
= intern ("require");
2530 staticpro (&Qrequire
);
2531 Qyes_or_no_p_history
= intern ("yes-or-no-p-history");
2532 staticpro (&Qyes_or_no_p_history
);
2533 Qcursor_in_echo_area
= intern ("cursor-in-echo-area");
2534 staticpro (&Qcursor_in_echo_area
);
2535 Qwidget_type
= intern ("widget-type");
2536 staticpro (&Qwidget_type
);
2538 staticpro (&string_char_byte_cache_string
);
2539 string_char_byte_cache_string
= Qnil
;
2541 Fset (Qyes_or_no_p_history
, Qnil
);
2543 DEFVAR_LISP ("features", &Vfeatures
,
2544 "A list of symbols which are the features of the executing emacs.\n\
2545 Used by `featurep' and `require', and altered by `provide'.");
2548 DEFVAR_BOOL ("use-dialog-box", &use_dialog_box
,
2549 "*Non-nil means mouse commands use dialog boxes to ask questions.\n\
2550 This applies to y-or-n and yes-or-no questions asked by commands\n\
2551 invoked by mouse clicks and mouse menu items.");
2554 defsubr (&Sidentity
);
2557 defsubr (&Ssafe_length
);
2558 defsubr (&Sstring_bytes
);
2559 defsubr (&Sstring_equal
);
2560 defsubr (&Sstring_lessp
);
2563 defsubr (&Svconcat
);
2564 defsubr (&Scopy_sequence
);
2565 defsubr (&Sstring_make_multibyte
);
2566 defsubr (&Sstring_make_unibyte
);
2567 defsubr (&Sstring_as_multibyte
);
2568 defsubr (&Sstring_as_unibyte
);
2569 defsubr (&Scopy_alist
);
2570 defsubr (&Ssubstring
);
2582 defsubr (&Snreverse
);
2583 defsubr (&Sreverse
);
2585 defsubr (&Splist_get
);
2587 defsubr (&Splist_put
);
2590 defsubr (&Sfillarray
);
2591 defsubr (&Schar_table_subtype
);
2592 defsubr (&Schar_table_parent
);
2593 defsubr (&Sset_char_table_parent
);
2594 defsubr (&Schar_table_extra_slot
);
2595 defsubr (&Sset_char_table_extra_slot
);
2596 defsubr (&Schar_table_range
);
2597 defsubr (&Sset_char_table_range
);
2598 defsubr (&Sset_char_table_default
);
2599 defsubr (&Smap_char_table
);
2602 defsubr (&Smapconcat
);
2603 defsubr (&Sy_or_n_p
);
2604 defsubr (&Syes_or_no_p
);
2605 defsubr (&Sload_average
);
2606 defsubr (&Sfeaturep
);
2607 defsubr (&Srequire
);
2608 defsubr (&Sprovide
);
2609 defsubr (&Swidget_plist_member
);
2610 defsubr (&Swidget_put
);
2611 defsubr (&Swidget_get
);
2612 defsubr (&Swidget_apply
);