1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19
20
21 #include <config.h>
22
23 #ifdef HAVE_UNISTD_H
24 #include <unistd.h>
25 #endif
26 #include <time.h>
27 #include <setjmp.h>
28
29 30
31 #undef vector
32 #define vector *****
33
34 #include "lisp.h"
35 #include "commands.h"
36 #include "character.h"
37 #include "coding.h"
38 #include "buffer.h"
39 #include "keyboard.h"
40 #include "keymap.h"
41 #include "intervals.h"
42 #include "frame.h"
43 #include "window.h"
44 #include "blockinput.h"
45 #ifdef HAVE_MENUS
46 #if defined (HAVE_X_WINDOWS)
47 #include "xterm.h"
48 #endif
49 #endif
50
51 #ifndef NULL
52 #define NULL ((POINTER_TYPE *)0)
53 #endif
54
55 56
57 int use_dialog_box;
58
59 60
61 int use_file_dialog;
62
63 extern int minibuffer_auto_raise;
64 extern Lisp_Object minibuf_window;
65 extern Lisp_Object Vlocale_coding_system;
66 extern int load_in_progress;
67
68 Lisp_Object Qstring_lessp, Qprovide, Qrequire;
69 Lisp_Object Qyes_or_no_p_history;
70 Lisp_Object Qcursor_in_echo_area;
71 Lisp_Object Qwidget_type;
72 Lisp_Object Qcodeset, Qdays, Qmonths, Qpaper;
73
74 extern Lisp_Object Qinput_method_function;
75
76 static int internal_equal P_ ((Lisp_Object , Lisp_Object, int, int));
77
78 extern long get_random ();
79 extern void seed_random P_ ((long));
80
81 #ifndef HAVE_UNISTD_H
82 extern long time ();
83 #endif
84
85 DEFUN ("identity", Fidentity, Sidentity, 1, 1, 0,
86 doc: )
87 (arg)
88 Lisp_Object arg;
89 {
90 return arg;
91 }
92
93 DEFUN ("random", Frandom, Srandom, 0, 1, 0,
94 doc: 95 96 97 98 99 )
100 (limit)
101 Lisp_Object limit;
102 {
103 EMACS_INT val;
104 Lisp_Object lispy_val;
105 unsigned long denominator;
106
107 if (EQ (limit, Qt))
108 seed_random (getpid () + time (NULL));
109 if (NATNUMP (limit) && XFASTINT (limit) != 0)
110 {
111 112 113 114 115 116 117
118 denominator = ((unsigned long)1 << VALBITS) / XFASTINT (limit);
119 do
120 val = get_random () / denominator;
121 while (val >= XFASTINT (limit));
122 }
123 else
124 val = get_random ();
125 XSETINT (lispy_val, val);
126 return lispy_val;
127 }
128
129
130
131 DEFUN ("length", Flength, Slength, 1, 1, 0,
132 doc: 133 134 135 136 )
137 (sequence)
138 register Lisp_Object sequence;
139 {
140 register Lisp_Object val;
141 register int i;
142
143 if (STRINGP (sequence))
144 XSETFASTINT (val, SCHARS (sequence));
145 else if (VECTORP (sequence))
146 XSETFASTINT (val, ASIZE (sequence));
147 else if (CHAR_TABLE_P (sequence))
148 XSETFASTINT (val, MAX_CHAR);
149 else if (BOOL_VECTOR_P (sequence))
150 XSETFASTINT (val, XBOOL_VECTOR (sequence)->size);
151 else if (COMPILEDP (sequence))
152 XSETFASTINT (val, ASIZE (sequence) & PSEUDOVECTOR_SIZE_MASK);
153 else if (CONSP (sequence))
154 {
155 i = 0;
156 while (CONSP (sequence))
157 {
158 sequence = XCDR (sequence);
159 ++i;
160
161 if (!CONSP (sequence))
162 break;
163
164 sequence = XCDR (sequence);
165 ++i;
166 QUIT;
167 }
168
169 CHECK_LIST_END (sequence, sequence);
170
171 val = make_number (i);
172 }
173 else if (NILP (sequence))
174 XSETFASTINT (val, 0);
175 else
176 wrong_type_argument (Qsequencep, sequence);
177
178 return val;
179 }
180
181
182
183 DEFUN ("safe-length", Fsafe_length, Ssafe_length, 1, 1, 0,
184 doc: 185 186 187 )
188 (list)
189 Lisp_Object list;
190 {
191 Lisp_Object tail, halftail, length;
192 int len = 0;
193
194
195 halftail = list;
196 for (tail = list; CONSP (tail); tail = XCDR (tail))
197 {
198 if (EQ (tail, halftail) && len != 0)
199 break;
200 len++;
201 if ((len & 1) == 0)
202 halftail = XCDR (halftail);
203 }
204
205 XSETINT (length, len);
206 return length;
207 }
208
209 DEFUN ("string-bytes", Fstring_bytes, Sstring_bytes, 1, 1, 0,
210 doc: 211 )
212 (string)
213 Lisp_Object string;
214 {
215 CHECK_STRING (string);
216 return make_number (SBYTES (string));
217 }
218
219 DEFUN ("string-equal", Fstring_equal, Sstring_equal, 2, 2, 0,
220 doc: 221 222 )
223 (s1, s2)
224 register Lisp_Object s1, s2;
225 {
226 if (SYMBOLP (s1))
227 s1 = SYMBOL_NAME (s1);
228 if (SYMBOLP (s2))
229 s2 = SYMBOL_NAME (s2);
230 CHECK_STRING (s1);
231 CHECK_STRING (s2);
232
233 if (SCHARS (s1) != SCHARS (s2)
234 || SBYTES (s1) != SBYTES (s2)
235 || bcmp (SDATA (s1), SDATA (s2), SBYTES (s1)))
236 return Qnil;
237 return Qt;
238 }
239
240 DEFUN ("compare-strings", Fcompare_strings,
241 Scompare_strings, 6, 7, 0,
242 doc: 243 244 245 246 247 248 249 250 251 252 253 254 )
255 (str1, start1, end1, str2, start2, end2, ignore_case)
256 Lisp_Object str1, start1, end1, start2, str2, end2, ignore_case;
257 {
258 register int end1_char, end2_char;
259 register int i1, i1_byte, i2, i2_byte;
260
261 CHECK_STRING (str1);
262 CHECK_STRING (str2);
263 if (NILP (start1))
264 start1 = make_number (0);
265 if (NILP (start2))
266 start2 = make_number (0);
267 CHECK_NATNUM (start1);
268 CHECK_NATNUM (start2);
269 if (! NILP (end1))
270 CHECK_NATNUM (end1);
271 if (! NILP (end2))
272 CHECK_NATNUM (end2);
273
274 i1 = XINT (start1);
275 i2 = XINT (start2);
276
277 i1_byte = string_char_to_byte (str1, i1);
278 i2_byte = string_char_to_byte (str2, i2);
279
280 end1_char = SCHARS (str1);
281 if (! NILP (end1) && end1_char > XINT (end1))
282 end1_char = XINT (end1);
283
284 end2_char = SCHARS (str2);
285 if (! NILP (end2) && end2_char > XINT (end2))
286 end2_char = XINT (end2);
287
288 while (i1 < end1_char && i2 < end2_char)
289 {
290 291
292 int c1, c2;
293
294 if (STRING_MULTIBYTE (str1))
295 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c1, str1, i1, i1_byte);
296 else
297 {
298 c1 = SREF (str1, i1++);
299 MAKE_CHAR_MULTIBYTE (c1);
300 }
301
302 if (STRING_MULTIBYTE (str2))
303 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c2, str2, i2, i2_byte);
304 else
305 {
306 c2 = SREF (str2, i2++);
307 MAKE_CHAR_MULTIBYTE (c2);
308 }
309
310 if (c1 == c2)
311 continue;
312
313 if (! NILP (ignore_case))
314 {
315 Lisp_Object tem;
316
317 tem = Fupcase (make_number (c1));
318 c1 = XINT (tem);
319 tem = Fupcase (make_number (c2));
320 c2 = XINT (tem);
321 }
322
323 if (c1 == c2)
324 continue;
325
326 327 328
329 if (c1 < c2)
330 return make_number (- i1 + XINT (start1));
331 else
332 return make_number (i1 - XINT (start1));
333 }
334
335 if (i1 < end1_char)
336 return make_number (i1 - XINT (start1) + 1);
337 if (i2 < end2_char)
338 return make_number (- i1 + XINT (start1) - 1);
339
340 return Qt;
341 }
342
343 DEFUN ("string-lessp", Fstring_lessp, Sstring_lessp, 2, 2, 0,
344 doc: 345 346 )
347 (s1, s2)
348 register Lisp_Object s1, s2;
349 {
350 register int end;
351 register int i1, i1_byte, i2, i2_byte;
352
353 if (SYMBOLP (s1))
354 s1 = SYMBOL_NAME (s1);
355 if (SYMBOLP (s2))
356 s2 = SYMBOL_NAME (s2);
357 CHECK_STRING (s1);
358 CHECK_STRING (s2);
359
360 i1 = i1_byte = i2 = i2_byte = 0;
361
362 end = SCHARS (s1);
363 if (end > SCHARS (s2))
364 end = SCHARS (s2);
365
366 while (i1 < end)
367 {
368 369
370 int c1, c2;
371
372 FETCH_STRING_CHAR_ADVANCE (c1, s1, i1, i1_byte);
373 FETCH_STRING_CHAR_ADVANCE (c2, s2, i2, i2_byte);
374
375 if (c1 != c2)
376 return c1 < c2 ? Qt : Qnil;
377 }
378 return i1 < SCHARS (s2) ? Qt : Qnil;
379 }
380
381 #if __GNUC__
382 383 384
385 static Lisp_Object concat P_ ((int nargs, Lisp_Object *args, enum Lisp_Type target_type, int last_special)) __attribute__((noinline));
386 #else
387 static Lisp_Object concat P_ ((int nargs, Lisp_Object *args, enum Lisp_Type target_type, int last_special));
388 #endif
389
390
391 Lisp_Object
392 concat2 (s1, s2)
393 Lisp_Object s1, s2;
394 {
395 Lisp_Object args[2];
396 args[0] = s1;
397 args[1] = s2;
398 return concat (2, args, Lisp_String, 0);
399 }
400
401
402 Lisp_Object
403 concat3 (s1, s2, s3)
404 Lisp_Object s1, s2, s3;
405 {
406 Lisp_Object args[3];
407 args[0] = s1;
408 args[1] = s2;
409 args[2] = s3;
410 return concat (3, args, Lisp_String, 0);
411 }
412
413 DEFUN ("append", Fappend, Sappend, 0, MANY, 0,
414 doc: 415 416 417 418 )
419 (nargs, args)
420 int nargs;
421 Lisp_Object *args;
422 {
423 return concat (nargs, args, Lisp_Cons, 1);
424 }
425
426 DEFUN ("concat", Fconcat, Sconcat, 0, MANY, 0,
427 doc: 428 429 430 )
431 (nargs, args)
432 int nargs;
433 Lisp_Object *args;
434 {
435 return concat (nargs, args, Lisp_String, 0);
436 }
437
438 DEFUN ("vconcat", Fvconcat, Svconcat, 0, MANY, 0,
439 doc: 440 441 442 )
443 (nargs, args)
444 int nargs;
445 Lisp_Object *args;
446 {
447 return concat (nargs, args, Lisp_Vectorlike, 0);
448 }
449
450
451 DEFUN ("copy-sequence", Fcopy_sequence, Scopy_sequence, 1, 1, 0,
452 doc: 453 454 )
455 (arg)
456 Lisp_Object arg;
457 {
458 if (NILP (arg)) return arg;
459
460 if (CHAR_TABLE_P (arg))
461 {
462 return copy_char_table (arg);
463 }
464
465 if (BOOL_VECTOR_P (arg))
466 {
467 Lisp_Object val;
468 int size_in_chars
469 = ((XBOOL_VECTOR (arg)->size + BOOL_VECTOR_BITS_PER_CHAR - 1)
470 / BOOL_VECTOR_BITS_PER_CHAR);
471
472 val = Fmake_bool_vector (Flength (arg), Qnil);
473 bcopy (XBOOL_VECTOR (arg)->data, XBOOL_VECTOR (val)->data,
474 size_in_chars);
475 return val;
476 }
477
478 if (!CONSP (arg) && !VECTORP (arg) && !STRINGP (arg))
479 wrong_type_argument (Qsequencep, arg);
480
481 return concat (1, &arg, CONSP (arg) ? Lisp_Cons : XTYPE (arg), 0);
482 }
483
484 485
486 struct textprop_rec
487 {
488 int argnum;
489 int from;
490 int to;
491 };
492
493 static Lisp_Object
494 concat (nargs, args, target_type, last_special)
495 int nargs;
496 Lisp_Object *args;
497 enum Lisp_Type target_type;
498 int last_special;
499 {
500 Lisp_Object val;
501 register Lisp_Object tail;
502 register Lisp_Object this;
503 int toindex;
504 int toindex_byte = 0;
505 register int result_len;
506 register int result_len_byte;
507 register int argnum;
508 Lisp_Object last_tail;
509 Lisp_Object prev;
510 int some_multibyte;
511 512 513 514 515
516 struct textprop_rec *textprops = NULL;
517
518 int num_textprops = 0;
519 USE_SAFE_ALLOCA;
520
521 tail = Qnil;
522
523
524 if (last_special && nargs > 0)
525 {
526 nargs--;
527 last_tail = args[nargs];
528 }
529 else
530 last_tail = Qnil;
531
532
533 for (argnum = 0; argnum < nargs; argnum++)
534 {
535 this = args[argnum];
536 if (!(CONSP (this) || NILP (this) || VECTORP (this) || STRINGP (this)
537 || COMPILEDP (this) || BOOL_VECTOR_P (this)))
538 wrong_type_argument (Qsequencep, this);
539 }
540
541 542 543 544
545 result_len_byte = 0;
546 result_len = 0;
547 some_multibyte = 0;
548 for (argnum = 0; argnum < nargs; argnum++)
549 {
550 int len;
551 this = args[argnum];
552 len = XFASTINT (Flength (this));
553 if (target_type == Lisp_String)
554 {
555 556
557 int i;
558 Lisp_Object ch;
559 int this_len_byte;
560
561 if (VECTORP (this))
562 for (i = 0; i < len; i++)
563 {
564 ch = AREF (this, i);
565 CHECK_CHARACTER (ch);
566 this_len_byte = CHAR_BYTES (XINT (ch));
567 result_len_byte += this_len_byte;
568 if (! ASCII_CHAR_P (XINT (ch)) && ! CHAR_BYTE8_P (XINT (ch)))
569 some_multibyte = 1;
570 }
571 else if (BOOL_VECTOR_P (this) && XBOOL_VECTOR (this)->size > 0)
572 wrong_type_argument (Qintegerp, Faref (this, make_number (0)));
573 else if (CONSP (this))
574 for (; CONSP (this); this = XCDR (this))
575 {
576 ch = XCAR (this);
577 CHECK_CHARACTER (ch);
578 this_len_byte = CHAR_BYTES (XINT (ch));
579 result_len_byte += this_len_byte;
580 if (! ASCII_CHAR_P (XINT (ch)) && ! CHAR_BYTE8_P (XINT (ch)))
581 some_multibyte = 1;
582 }
583 else if (STRINGP (this))
584 {
585 if (STRING_MULTIBYTE (this))
586 {
587 some_multibyte = 1;
588 result_len_byte += SBYTES (this);
589 }
590 else
591 result_len_byte += count_size_as_multibyte (SDATA (this),
592 SCHARS (this));
593 }
594 }
595
596 result_len += len;
597 if (result_len < 0)
598 error ("String overflow");
599 }
600
601 if (! some_multibyte)
602 result_len_byte = result_len;
603
604
605 if (target_type == Lisp_Cons)
606 val = Fmake_list (make_number (result_len), Qnil);
607 else if (target_type == Lisp_Vectorlike)
608 val = Fmake_vector (make_number (result_len), Qnil);
609 else if (some_multibyte)
610 val = make_uninit_multibyte_string (result_len, result_len_byte);
611 else
612 val = make_uninit_string (result_len);
613
614
615 if (target_type == Lisp_Cons && EQ (val, Qnil))
616 return last_tail;
617
618
619 if (CONSP (val))
620 tail = val, toindex = -1;
621 else
622 toindex = 0, toindex_byte = 0;
623
624 prev = Qnil;
625 if (STRINGP (val))
626 SAFE_ALLOCA (textprops, struct textprop_rec *, sizeof (struct textprop_rec) * nargs);
627
628 for (argnum = 0; argnum < nargs; argnum++)
629 {
630 Lisp_Object thislen;
631 int thisleni = 0;
632 register unsigned int thisindex = 0;
633 register unsigned int thisindex_byte = 0;
634
635 this = args[argnum];
636 if (!CONSP (this))
637 thislen = Flength (this), thisleni = XINT (thislen);
638
639
640 if (STRINGP (this) && STRINGP (val)
641 && STRING_MULTIBYTE (this) == some_multibyte)
642 {
643 int thislen_byte = SBYTES (this);
644
645 bcopy (SDATA (this), SDATA (val) + toindex_byte,
646 SBYTES (this));
647 if (! NULL_INTERVAL_P (STRING_INTERVALS (this)))
648 {
649 textprops[num_textprops].argnum = argnum;
650 textprops[num_textprops].from = 0;
651 textprops[num_textprops++].to = toindex;
652 }
653 toindex_byte += thislen_byte;
654 toindex += thisleni;
655 }
656
657 else if (STRINGP (this) && STRINGP (val))
658 {
659 if (! NULL_INTERVAL_P (STRING_INTERVALS (this)))
660 {
661 textprops[num_textprops].argnum = argnum;
662 textprops[num_textprops].from = 0;
663 textprops[num_textprops++].to = toindex;
664 }
665 toindex_byte += copy_text (SDATA (this),
666 SDATA (val) + toindex_byte,
667 SCHARS (this), 0, 1);
668 toindex += thisleni;
669 }
670 else
671
672 while (1)
673 {
674 register Lisp_Object elt;
675
676 677
678 if (NILP (this)) break;
679 if (CONSP (this))
680 elt = XCAR (this), this = XCDR (this);
681 else if (thisindex >= thisleni)
682 break;
683 else if (STRINGP (this))
684 {
685 int c;
686 if (STRING_MULTIBYTE (this))
687 {
688 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c, this,
689 thisindex,
690 thisindex_byte);
691 XSETFASTINT (elt, c);
692 }
693 else
694 {
695 XSETFASTINT (elt, SREF (this, thisindex)); thisindex++;
696 if (some_multibyte
697 && !ASCII_CHAR_P (XINT (elt))
698 && XINT (elt) < 0400)
699 {
700 c = BYTE8_TO_CHAR (XINT (elt));
701 XSETINT (elt, c);
702 }
703 }
704 }
705 else if (BOOL_VECTOR_P (this))
706 {
707 int byte;
708 byte = XBOOL_VECTOR (this)->data[thisindex / BOOL_VECTOR_BITS_PER_CHAR];
709 if (byte & (1 << (thisindex % BOOL_VECTOR_BITS_PER_CHAR)))
710 elt = Qt;
711 else
712 elt = Qnil;
713 thisindex++;
714 }
715 else
716 {
717 elt = AREF (this, thisindex);
718 thisindex++;
719 }
720
721
722 if (toindex < 0)
723 {
724 XSETCAR (tail, elt);
725 prev = tail;
726 tail = XCDR (tail);
727 }
728 else if (VECTORP (val))
729 {
730 ASET (val, toindex, elt);
731 toindex++;
732 }
733 else
734 {
735 CHECK_NUMBER (elt);
736 if (some_multibyte)
737 toindex_byte += CHAR_STRING (XINT (elt),
738 SDATA (val) + toindex_byte);
739 else
740 SSET (val, toindex_byte++, XINT (elt));
741 toindex++;
742 }
743 }
744 }
745 if (!NILP (prev))
746 XSETCDR (prev, last_tail);
747
748 if (num_textprops > 0)
749 {
750 Lisp_Object props;
751 int last_to_end = -1;
752
753 for (argnum = 0; argnum < num_textprops; argnum++)
754 {
755 this = args[textprops[argnum].argnum];
756 props = text_property_list (this,
757 make_number (0),
758 make_number (SCHARS (this)),
759 Qnil);
760 761
762 if (last_to_end == textprops[argnum].to)
763 make_composition_value_copy (props);
764 add_text_properties_from_list (val, props,
765 make_number (textprops[argnum].to));
766 last_to_end = textprops[argnum].to + SCHARS (this);
767 }
768 }
769
770 SAFE_FREE ();
771 return val;
772 }
773
774 static Lisp_Object string_char_byte_cache_string;
775 static EMACS_INT string_char_byte_cache_charpos;
776 static EMACS_INT string_char_byte_cache_bytepos;
777
778 void
779 clear_string_char_byte_cache ()
780 {
781 string_char_byte_cache_string = Qnil;
782 }
783
784
785
786 EMACS_INT
787 string_char_to_byte (string, char_index)
788 Lisp_Object string;
789 EMACS_INT char_index;
790 {
791 EMACS_INT i_byte;
792 EMACS_INT best_below, best_below_byte;
793 EMACS_INT best_above, best_above_byte;
794
795 best_below = best_below_byte = 0;
796 best_above = SCHARS (string);
797 best_above_byte = SBYTES (string);
798 if (best_above == best_above_byte)
799 return char_index;
800
801 if (EQ (string, string_char_byte_cache_string))
802 {
803 if (string_char_byte_cache_charpos < char_index)
804 {
805 best_below = string_char_byte_cache_charpos;
806 best_below_byte = string_char_byte_cache_bytepos;
807 }
808 else
809 {
810 best_above = string_char_byte_cache_charpos;
811 best_above_byte = string_char_byte_cache_bytepos;
812 }
813 }
814
815 if (char_index - best_below < best_above - char_index)
816 {
817 unsigned char *p = SDATA (string) + best_below_byte;
818
819 while (best_below < char_index)
820 {
821 p += BYTES_BY_CHAR_HEAD (*p);
822 best_below++;
823 }
824 i_byte = p - SDATA (string);
825 }
826 else
827 {
828 unsigned char *p = SDATA (string) + best_above_byte;
829
830 while (best_above > char_index)
831 {
832 p--;
833 while (!CHAR_HEAD_P (*p)) p--;
834 best_above--;
835 }
836 i_byte = p - SDATA (string);
837 }
838
839 string_char_byte_cache_bytepos = i_byte;
840 string_char_byte_cache_charpos = char_index;
841 string_char_byte_cache_string = string;
842
843 return i_byte;
844 }
845
846
847
848 EMACS_INT
849 string_byte_to_char (string, byte_index)
850 Lisp_Object string;
851 EMACS_INT byte_index;
852 {
853 EMACS_INT i, i_byte;
854 EMACS_INT best_below, best_below_byte;
855 EMACS_INT best_above, best_above_byte;
856
857 best_below = best_below_byte = 0;
858 best_above = SCHARS (string);
859 best_above_byte = SBYTES (string);
860 if (best_above == best_above_byte)
861 return byte_index;
862
863 if (EQ (string, string_char_byte_cache_string))
864 {
865 if (string_char_byte_cache_bytepos < byte_index)
866 {
867 best_below = string_char_byte_cache_charpos;
868 best_below_byte = string_char_byte_cache_bytepos;
869 }
870 else
871 {
872 best_above = string_char_byte_cache_charpos;
873 best_above_byte = string_char_byte_cache_bytepos;
874 }
875 }
876
877 if (byte_index - best_below_byte < best_above_byte - byte_index)
878 {
879 unsigned char *p = SDATA (string) + best_below_byte;
880 unsigned char *pend = SDATA (string) + byte_index;
881
882 while (p < pend)
883 {
884 p += BYTES_BY_CHAR_HEAD (*p);
885 best_below++;
886 }
887 i = best_below;
888 i_byte = p - SDATA (string);
889 }
890 else
891 {
892 unsigned char *p = SDATA (string) + best_above_byte;
893 unsigned char *pbeg = SDATA (string) + byte_index;
894
895 while (p > pbeg)
896 {
897 p--;
898 while (!CHAR_HEAD_P (*p)) p--;
899 best_above--;
900 }
901 i = best_above;
902 i_byte = p - SDATA (string);
903 }
904
905 string_char_byte_cache_bytepos = i_byte;
906 string_char_byte_cache_charpos = i;
907 string_char_byte_cache_string = string;
908
909 return i;
910 }
911
912
913
914 Lisp_Object
915 string_make_multibyte (string)
916 Lisp_Object string;
917 {
918 unsigned char *buf;
919 EMACS_INT nbytes;
920 Lisp_Object ret;
921 USE_SAFE_ALLOCA;
922
923 if (STRING_MULTIBYTE (string))
924 return string;
925
926 nbytes = count_size_as_multibyte (SDATA (string),
927 SCHARS (string));
928 929
930 if (nbytes == SBYTES (string))
931 return string;
932
933 SAFE_ALLOCA (buf, unsigned char *, nbytes);
934 copy_text (SDATA (string), buf, SBYTES (string),
935 0, 1);
936
937 ret = make_multibyte_string (buf, SCHARS (string), nbytes);
938 SAFE_FREE ();
939
940 return ret;
941 }
942
943
944 945 946
947
948 Lisp_Object
949 string_to_multibyte (string)
950 Lisp_Object string;
951 {
952 unsigned char *buf;
953 EMACS_INT nbytes;
954 Lisp_Object ret;
955 USE_SAFE_ALLOCA;
956
957 if (STRING_MULTIBYTE (string))
958 return string;
959
960 nbytes = parse_str_to_multibyte (SDATA (string), SBYTES (string));
961 962
963 if (nbytes == SBYTES (string))
964 return make_multibyte_string (SDATA (string), nbytes, nbytes);
965
966 SAFE_ALLOCA (buf, unsigned char *, nbytes);
967 bcopy (SDATA (string), buf, SBYTES (string));
968 str_to_multibyte (buf, nbytes, SBYTES (string));
969
970 ret = make_multibyte_string (buf, SCHARS (string), nbytes);
971 SAFE_FREE ();
972
973 return ret;
974 }
975
976
977
978
979 Lisp_Object
980 string_make_unibyte (string)
981 Lisp_Object string;
982 {
983 int nchars;
984 unsigned char *buf;
985 Lisp_Object ret;
986 USE_SAFE_ALLOCA;
987
988 if (! STRING_MULTIBYTE (string))
989 return string;
990
991 nchars = SCHARS (string);
992
993 SAFE_ALLOCA (buf, unsigned char *, nchars);
994 copy_text (SDATA (string), buf, SBYTES (string),
995 1, 0);
996
997 ret = make_unibyte_string (buf, nchars);
998 SAFE_FREE ();
999
1000 return ret;
1001 }
1002
1003 DEFUN ("string-make-multibyte", Fstring_make_multibyte, Sstring_make_multibyte,
1004 1, 1, 0,
1005 doc: 1006 1007 1008 1009 1010 1011 1012 1013 )
1014 (string)
1015 Lisp_Object string;
1016 {
1017 CHECK_STRING (string);
1018
1019 return string_make_multibyte (string);
1020 }
1021
1022 DEFUN ("string-make-unibyte", Fstring_make_unibyte, Sstring_make_unibyte,
1023 1, 1, 0,
1024 doc: 1025 1026 1027 1028 )
1029 (string)
1030 Lisp_Object string;
1031 {
1032 CHECK_STRING (string);
1033
1034 return string_make_unibyte (string);
1035 }
1036
1037 DEFUN ("string-as-unibyte", Fstring_as_unibyte, Sstring_as_unibyte,
1038 1, 1, 0,
1039 doc: 1040 1041 1042 1043 )
1044 (string)
1045 Lisp_Object string;
1046 {
1047 CHECK_STRING (string);
1048
1049 if (STRING_MULTIBYTE (string))
1050 {
1051 int bytes = SBYTES (string);
1052 unsigned char *str = (unsigned char *) xmalloc (bytes);
1053
1054 bcopy (SDATA (string), str, bytes);
1055 bytes = str_as_unibyte (str, bytes);
1056 string = make_unibyte_string (str, bytes);
1057 xfree (str);
1058 }
1059 return string;
1060 }
1061
1062 DEFUN ("string-as-multibyte", Fstring_as_multibyte, Sstring_as_multibyte,
1063 1, 1, 0,
1064 doc: 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 )
1077 (string)
1078 Lisp_Object string;
1079 {
1080 CHECK_STRING (string);
1081
1082 if (! STRING_MULTIBYTE (string))
1083 {
1084 Lisp_Object new_string;
1085 int nchars, nbytes;
1086
1087 parse_str_as_multibyte (SDATA (string),
1088 SBYTES (string),
1089 &nchars, &nbytes);
1090 new_string = make_uninit_multibyte_string (nchars, nbytes);
1091 bcopy (SDATA (string), SDATA (new_string),
1092 SBYTES (string));
1093 if (nbytes != SBYTES (string))
1094 str_as_multibyte (SDATA (new_string), nbytes,
1095 SBYTES (string), NULL);
1096 string = new_string;
1097 STRING_SET_INTERVALS (string, NULL_INTERVAL);
1098 }
1099 return string;
1100 }
1101
1102 DEFUN ("string-to-multibyte", Fstring_to_multibyte, Sstring_to_multibyte,
1103 1, 1, 0,
1104 doc: 1105 1106 1107 1108 1109 1110 1111 1112 1113 )
1114 (string)
1115 Lisp_Object string;
1116 {
1117 CHECK_STRING (string);
1118
1119 return string_to_multibyte (string);
1120 }
1121
1122 DEFUN ("string-to-unibyte", Fstring_to_unibyte, Sstring_to_unibyte,
1123 1, 1, 0,
1124 doc: 1125 1126 1127 1128 1129 )
1130 (string)
1131 Lisp_Object string;
1132 {
1133 CHECK_STRING (string);
1134
1135 if (STRING_MULTIBYTE (string))
1136 {
1137 EMACS_INT chars = SCHARS (string);
1138 unsigned char *str = (unsigned char *) xmalloc (chars);
1139 EMACS_INT converted = str_to_unibyte (SDATA (string), str, chars, 0);
1140
1141 if (converted < chars)
1142 error ("Can't convert the %dth character to unibyte", converted);
1143 string = make_unibyte_string (str, chars);
1144 xfree (str);
1145 }
1146 return string;
1147 }
1148
1149
1150 DEFUN ("copy-alist", Fcopy_alist, Scopy_alist, 1, 1, 0,
1151 doc: 1152 1153 1154 1155 1156 )
1157 (alist)
1158 Lisp_Object alist;
1159 {
1160 register Lisp_Object tem;
1161
1162 CHECK_LIST (alist);
1163 if (NILP (alist))
1164 return alist;
1165 alist = concat (1, &alist, Lisp_Cons, 0);
1166 for (tem = alist; CONSP (tem); tem = XCDR (tem))
1167 {
1168 register Lisp_Object car;
1169 car = XCAR (tem);
1170
1171 if (CONSP (car))
1172 XSETCAR (tem, Fcons (XCAR (car), XCDR (car)));
1173 }
1174 return alist;
1175 }
1176
1177 DEFUN ("substring", Fsubstring, Ssubstring, 2, 3, 0,
1178 doc: 1179 1180 1181 1182 1183 1184 1185 1186 1187 )
1188 (string, from, to)
1189 Lisp_Object string;
1190 register Lisp_Object from, to;
1191 {
1192 Lisp_Object res;
1193 int size;
1194 int size_byte = 0;
1195 int from_char, to_char;
1196 int from_byte = 0, to_byte = 0;
1197
1198 CHECK_VECTOR_OR_STRING (string);
1199 CHECK_NUMBER (from);
1200
1201 if (STRINGP (string))
1202 {
1203 size = SCHARS (string);
1204 size_byte = SBYTES (string);
1205 }
1206 else
1207 size = ASIZE (string);
1208
1209 if (NILP (to))
1210 {
1211 to_char = size;
1212 to_byte = size_byte;
1213 }
1214 else
1215 {
1216 CHECK_NUMBER (to);
1217
1218 to_char = XINT (to);
1219 if (to_char < 0)
1220 to_char += size;
1221
1222 if (STRINGP (string))
1223 to_byte = string_char_to_byte (string, to_char);
1224 }
1225
1226 from_char = XINT (from);
1227 if (from_char < 0)
1228 from_char += size;
1229 if (STRINGP (string))
1230 from_byte = string_char_to_byte (string, from_char);
1231
1232 if (!(0 <= from_char && from_char <= to_char && to_char <= size))
1233 args_out_of_range_3 (string, make_number (from_char),
1234 make_number (to_char));
1235
1236 if (STRINGP (string))
1237 {
1238 res = make_specified_string (SDATA (string) + from_byte,
1239 to_char - from_char, to_byte - from_byte,
1240 STRING_MULTIBYTE (string));
1241 copy_text_properties (make_number (from_char), make_number (to_char),
1242 string, make_number (0), res, Qnil);
1243 }
1244 else
1245 res = Fvector (to_char - from_char, &AREF (string, from_char));
1246
1247 return res;
1248 }
1249
1250
1251 DEFUN ("substring-no-properties", Fsubstring_no_properties, Ssubstring_no_properties, 1, 3, 0,
1252 doc: 1253 1254 1255 1256 1257 1258 )
1259 (string, from, to)
1260 Lisp_Object string;
1261 register Lisp_Object from, to;
1262 {
1263 int size, size_byte;
1264 int from_char, to_char;
1265 int from_byte, to_byte;
1266
1267 CHECK_STRING (string);
1268
1269 size = SCHARS (string);
1270 size_byte = SBYTES (string);
1271
1272 if (NILP (from))
1273 from_char = from_byte = 0;
1274 else
1275 {
1276 CHECK_NUMBER (from);
1277 from_char = XINT (from);
1278 if (from_char < 0)
1279 from_char += size;
1280
1281 from_byte = string_char_to_byte (string, from_char);
1282 }
1283
1284 if (NILP (to))
1285 {
1286 to_char = size;
1287 to_byte = size_byte;
1288 }
1289 else
1290 {
1291 CHECK_NUMBER (to);
1292
1293 to_char = XINT (to);
1294 if (to_char < 0)
1295 to_char += size;
1296
1297 to_byte = string_char_to_byte (string, to_char);
1298 }
1299
1300 if (!(0 <= from_char && from_char <= to_char && to_char <= size))
1301 args_out_of_range_3 (string, make_number (from_char),
1302 make_number (to_char));
1303
1304 return make_specified_string (SDATA (string) + from_byte,
1305 to_char - from_char, to_byte - from_byte,
1306 STRING_MULTIBYTE (string));
1307 }
1308
1309 1310
1311
1312 Lisp_Object
1313 substring_both (string, from, from_byte, to, to_byte)
1314 Lisp_Object string;
1315 int from, from_byte, to, to_byte;
1316 {
1317 Lisp_Object res;
1318 int size;
1319 int size_byte;
1320
1321 CHECK_VECTOR_OR_STRING (string);
1322
1323 if (STRINGP (string))
1324 {
1325 size = SCHARS (string);
1326 size_byte = SBYTES (string);
1327 }
1328 else
1329 size = ASIZE (string);
1330
1331 if (!(0 <= from && from <= to && to <= size))
1332 args_out_of_range_3 (string, make_number (from), make_number (to));
1333
1334 if (STRINGP (string))
1335 {
1336 res = make_specified_string (SDATA (string) + from_byte,
1337 to - from, to_byte - from_byte,
1338 STRING_MULTIBYTE (string));
1339 copy_text_properties (make_number (from), make_number (to),
1340 string, make_number (0), res, Qnil);
1341 }
1342 else
1343 res = Fvector (to - from, &AREF (string, from));
1344
1345 return res;
1346 }
1347
1348 DEFUN ("nthcdr", Fnthcdr, Snthcdr, 2, 2, 0,
1349 doc: )
1350 (n, list)
1351 Lisp_Object n;
1352 register Lisp_Object list;
1353 {
1354 register int i, num;
1355 CHECK_NUMBER (n);
1356 num = XINT (n);
1357 for (i = 0; i < num && !NILP (list); i++)
1358 {
1359 QUIT;
1360 CHECK_LIST_CONS (list, list);
1361 list = XCDR (list);
1362 }
1363 return list;
1364 }
1365
1366 DEFUN ("nth", Fnth, Snth, 2, 2, 0,
1367 doc: 1368 )
1369 (n, list)
1370 Lisp_Object n, list;
1371 {
1372 return Fcar (Fnthcdr (n, list));
1373 }
1374
1375 DEFUN ("elt", Felt, Selt, 2, 2, 0,
1376 doc: )
1377 (sequence, n)
1378 register Lisp_Object sequence, n;
1379 {
1380 CHECK_NUMBER (n);
1381 if (CONSP (sequence) || NILP (sequence))
1382 return Fcar (Fnthcdr (n, sequence));
1383
1384
1385 CHECK_ARRAY (sequence, Qsequencep);
1386 return Faref (sequence, n);
1387 }
1388
1389 DEFUN ("member", Fmember, Smember, 2, 2, 0,
1390 doc: 1391 )
1392 (elt, list)
1393 register Lisp_Object elt;
1394 Lisp_Object list;
1395 {
1396 register Lisp_Object tail;
1397 for (tail = list; CONSP (tail); tail = XCDR (tail))
1398 {
1399 register Lisp_Object tem;
1400 CHECK_LIST_CONS (tail, list);
1401 tem = XCAR (tail);
1402 if (! NILP (Fequal (elt, tem)))
1403 return tail;
1404 QUIT;
1405 }
1406 return Qnil;
1407 }
1408
1409 DEFUN ("memq", Fmemq, Smemq, 2, 2, 0,
1410 doc: 1411 )
1412 (elt, list)
1413 register Lisp_Object elt, list;
1414 {
1415 while (1)
1416 {
1417 if (!CONSP (list) || EQ (XCAR (list), elt))
1418 break;
1419
1420 list = XCDR (list);
1421 if (!CONSP (list) || EQ (XCAR (list), elt))
1422 break;
1423
1424 list = XCDR (list);
1425 if (!CONSP (list) || EQ (XCAR (list), elt))
1426 break;
1427
1428 list = XCDR (list);
1429 QUIT;
1430 }
1431
1432 CHECK_LIST (list);
1433 return list;
1434 }
1435
1436 DEFUN ("memql", Fmemql, Smemql, 2, 2, 0,
1437 doc: 1438 )
1439 (elt, list)
1440 register Lisp_Object elt;
1441 Lisp_Object list;
1442 {
1443 register Lisp_Object tail;
1444
1445 if (!FLOATP (elt))
1446 return Fmemq (elt, list);
1447
1448 for (tail = list; CONSP (tail); tail = XCDR (tail))
1449 {
1450 register Lisp_Object tem;
1451 CHECK_LIST_CONS (tail, list);
1452 tem = XCAR (tail);
1453 if (FLOATP (tem) && internal_equal (elt, tem, 0, 0))
1454 return tail;
1455 QUIT;
1456 }
1457 return Qnil;
1458 }
1459
1460 DEFUN ("assq", Fassq, Sassq, 2, 2, 0,
1461 doc: 1462 1463 )
1464 (key, list)
1465 Lisp_Object key, list;
1466 {
1467 while (1)
1468 {
1469 if (!CONSP (list)
1470 || (CONSP (XCAR (list))
1471 && EQ (XCAR (XCAR (list)), key)))
1472 break;
1473
1474 list = XCDR (list);
1475 if (!CONSP (list)
1476 || (CONSP (XCAR (list))
1477 && EQ (XCAR (XCAR (list)), key)))
1478 break;
1479
1480 list = XCDR (list);
1481 if (!CONSP (list)
1482 || (CONSP (XCAR (list))
1483 && EQ (XCAR (XCAR (list)), key)))
1484 break;
1485
1486 list = XCDR (list);
1487 QUIT;
1488 }
1489
1490 return CAR (list);
1491 }
1492
1493 1494
1495
1496 Lisp_Object
1497 assq_no_quit (key, list)
1498 Lisp_Object key, list;
1499 {
1500 while (CONSP (list)
1501 && (!CONSP (XCAR (list))
1502 || !EQ (XCAR (XCAR (list)), key)))
1503 list = XCDR (list);
1504
1505 return CAR_SAFE (list);
1506 }
1507
1508 DEFUN ("assoc", Fassoc, Sassoc, 2, 2, 0,
1509 doc: 1510 )
1511 (key, list)
1512 Lisp_Object key, list;
1513 {
1514 Lisp_Object car;
1515
1516 while (1)
1517 {
1518 if (!CONSP (list)
1519 || (CONSP (XCAR (list))
1520 && (car = XCAR (XCAR (list)),
1521 EQ (car, key) || !NILP (Fequal (car, key)))))
1522 break;
1523
1524 list = XCDR (list);
1525 if (!CONSP (list)
1526 || (CONSP (XCAR (list))
1527 && (car = XCAR (XCAR (list)),
1528 EQ (car, key) || !NILP (Fequal (car, key)))))
1529 break;
1530
1531 list = XCDR (list);
1532 if (!CONSP (list)
1533 || (CONSP (XCAR (list))
1534 && (car = XCAR (XCAR (list)),
1535 EQ (car, key) || !NILP (Fequal (car, key)))))
1536 break;
1537
1538 list = XCDR (list);
1539 QUIT;
1540 }
1541
1542 return CAR (list);
1543 }
1544
1545 1546
1547
1548 Lisp_Object
1549 assoc_no_quit (key, list)
1550 Lisp_Object key, list;
1551 {
1552 while (CONSP (list)
1553 && (!CONSP (XCAR (list))
1554 || (!EQ (XCAR (XCAR (list)), key)
1555 && NILP (Fequal (XCAR (XCAR (list)), key)))))
1556 list = XCDR (list);
1557
1558 return CONSP (list) ? XCAR (list) : Qnil;
1559 }
1560
1561 DEFUN ("rassq", Frassq, Srassq, 2, 2, 0,
1562 doc: 1563 )
1564 (key, list)
1565 register Lisp_Object key;
1566 Lisp_Object list;
1567 {
1568 while (1)
1569 {
1570 if (!CONSP (list)
1571 || (CONSP (XCAR (list))
1572 && EQ (XCDR (XCAR (list)), key)))
1573 break;
1574
1575 list = XCDR (list);
1576 if (!CONSP (list)
1577 || (CONSP (XCAR (list))
1578 && EQ (XCDR (XCAR (list)), key)))
1579 break;
1580
1581 list = XCDR (list);
1582 if (!CONSP (list)
1583 || (CONSP (XCAR (list))
1584 && EQ (XCDR (XCAR (list)), key)))
1585 break;
1586
1587 list = XCDR (list);
1588 QUIT;
1589 }
1590
1591 return CAR (list);
1592 }
1593
1594 DEFUN ("rassoc", Frassoc, Srassoc, 2, 2, 0,
1595 doc: 1596 )
1597 (key, list)
1598 Lisp_Object key, list;
1599 {
1600 Lisp_Object cdr;
1601
1602 while (1)
1603 {
1604 if (!CONSP (list)
1605 || (CONSP (XCAR (list))
1606 && (cdr = XCDR (XCAR (list)),
1607 EQ (cdr, key) || !NILP (Fequal (cdr, key)))))
1608 break;
1609
1610 list = XCDR (list);
1611 if (!CONSP (list)
1612 || (CONSP (XCAR (list))
1613 && (cdr = XCDR (XCAR (list)),
1614 EQ (cdr, key) || !NILP (Fequal (cdr, key)))))
1615 break;
1616
1617 list = XCDR (list);
1618 if (!CONSP (list)
1619 || (CONSP (XCAR (list))
1620 && (cdr = XCDR (XCAR (list)),
1621 EQ (cdr, key) || !NILP (Fequal (cdr, key)))))
1622 break;
1623
1624 list = XCDR (list);
1625 QUIT;
1626 }
1627
1628 return CAR (list);
1629 }
1630
1631 DEFUN ("delq", Fdelq, Sdelq, 2, 2, 0,
1632 doc: 1633 1634 1635 1636 )
1637 (elt, list)
1638 register Lisp_Object elt;
1639 Lisp_Object list;
1640 {
1641 register Lisp_Object tail, prev;
1642 register Lisp_Object tem;
1643
1644 tail = list;
1645 prev = Qnil;
1646 while (!NILP (tail))
1647 {
1648 CHECK_LIST_CONS (tail, list);
1649 tem = XCAR (tail);
1650 if (EQ (elt, tem))
1651 {
1652 if (NILP (prev))
1653 list = XCDR (tail);
1654 else
1655 Fsetcdr (prev, XCDR (tail));
1656 }
1657 else
1658 prev = tail;
1659 tail = XCDR (tail);
1660 QUIT;
1661 }
1662 return list;
1663 }
1664
1665 DEFUN ("delete", Fdelete, Sdelete, 2, 2, 0,
1666 doc: 1667 1668 1669 1670 1671 1672 )
1673 (elt, seq)
1674 Lisp_Object elt, seq;
1675 {
1676 if (VECTORP (seq))
1677 {
1678 EMACS_INT i, n;
1679
1680 for (i = n = 0; i < ASIZE (seq); ++i)
1681 if (NILP (Fequal (AREF (seq, i), elt)))
1682 ++n;
1683
1684 if (n != ASIZE (seq))
1685 {
1686 struct Lisp_Vector *p = allocate_vector (n);
1687
1688 for (i = n = 0; i < ASIZE (seq); ++i)
1689 if (NILP (Fequal (AREF (seq, i), elt)))
1690 p->contents[n++] = AREF (seq, i);
1691
1692 XSETVECTOR (seq, p);
1693 }
1694 }
1695 else if (STRINGP (seq))
1696 {
1697 EMACS_INT i, ibyte, nchars, nbytes, cbytes;
1698 int c;
1699
1700 for (i = nchars = nbytes = ibyte = 0;
1701 i < SCHARS (seq);
1702 ++i, ibyte += cbytes)
1703 {
1704 if (STRING_MULTIBYTE (seq))
1705 {
1706 c = STRING_CHAR (SDATA (seq) + ibyte);
1707 cbytes = CHAR_BYTES (c);
1708 }
1709 else
1710 {
1711 c = SREF (seq, i);
1712 cbytes = 1;
1713 }
1714
1715 if (!INTEGERP (elt) || c != XINT (elt))
1716 {
1717 ++nchars;
1718 nbytes += cbytes;
1719 }
1720 }
1721
1722 if (nchars != SCHARS (seq))
1723 {
1724 Lisp_Object tem;
1725
1726 tem = make_uninit_multibyte_string (nchars, nbytes);
1727 if (!STRING_MULTIBYTE (seq))
1728 STRING_SET_UNIBYTE (tem);
1729
1730 for (i = nchars = nbytes = ibyte = 0;
1731 i < SCHARS (seq);
1732 ++i, ibyte += cbytes)
1733 {
1734 if (STRING_MULTIBYTE (seq))
1735 {
1736 c = STRING_CHAR (SDATA (seq) + ibyte);
1737 cbytes = CHAR_BYTES (c);
1738 }
1739 else
1740 {
1741 c = SREF (seq, i);
1742 cbytes = 1;
1743 }
1744
1745 if (!INTEGERP (elt) || c != XINT (elt))
1746 {
1747 unsigned char *from = SDATA (seq) + ibyte;
1748 unsigned char *to = SDATA (tem) + nbytes;
1749 EMACS_INT n;
1750
1751 ++nchars;
1752 nbytes += cbytes;
1753
1754 for (n = cbytes; n--; )
1755 *to++ = *from++;
1756 }
1757 }
1758
1759 seq = tem;
1760 }
1761 }
1762 else
1763 {
1764 Lisp_Object tail, prev;
1765
1766 for (tail = seq, prev = Qnil; CONSP (tail); tail = XCDR (tail))
1767 {
1768 CHECK_LIST_CONS (tail, seq);
1769
1770 if (!NILP (Fequal (elt, XCAR (tail))))
1771 {
1772 if (NILP (prev))
1773 seq = XCDR (tail);
1774 else
1775 Fsetcdr (prev, XCDR (tail));
1776 }
1777 else
1778 prev = tail;
1779 QUIT;
1780 }
1781 }
1782
1783 return seq;
1784 }
1785
1786 DEFUN ("nreverse", Fnreverse, Snreverse, 1, 1, 0,
1787 doc: 1788 )
1789 (list)
1790 Lisp_Object list;
1791 {
1792 register Lisp_Object prev, tail, next;
1793
1794 if (NILP (list)) return list;
1795 prev = Qnil;
1796 tail = list;
1797 while (!NILP (tail))
1798 {
1799 QUIT;
1800 CHECK_LIST_CONS (tail, list);
1801 next = XCDR (tail);
1802 Fsetcdr (tail, prev);
1803 prev = tail;
1804 tail = next;
1805 }
1806 return prev;
1807 }
1808
1809 DEFUN ("reverse", Freverse, Sreverse, 1, 1, 0,
1810 doc: 1811 )
1812 (list)
1813 Lisp_Object list;
1814 {
1815 Lisp_Object new;
1816
1817 for (new = Qnil; CONSP (list); list = XCDR (list))
1818 {
1819 QUIT;
1820 new = Fcons (XCAR (list), new);
1821 }
1822 CHECK_LIST_END (list, list);
1823 return new;
1824 }
1825
1826 Lisp_Object merge ();
1827
1828 DEFUN ("sort", Fsort, Ssort, 2, 2, 0,
1829 doc: 1830 1831 1832 )
1833 (list, predicate)
1834 Lisp_Object list, predicate;
1835 {
1836 Lisp_Object front, back;
1837 register Lisp_Object len, tem;
1838 struct gcpro gcpro1, gcpro2;
1839 register int length;
1840
1841 front = list;
1842 len = Flength (list);
1843 length = XINT (len);
1844 if (length < 2)
1845 return list;
1846
1847 XSETINT (len, (length / 2) - 1);
1848 tem = Fnthcdr (len, list);
1849 back = Fcdr (tem);
1850 Fsetcdr (tem, Qnil);
1851
1852 GCPRO2 (front, back);
1853 front = Fsort (front, predicate);
1854 back = Fsort (back, predicate);
1855 UNGCPRO;
1856 return merge (front, back, predicate);
1857 }
1858
1859 Lisp_Object
1860 merge (org_l1, org_l2, pred)
1861 Lisp_Object org_l1, org_l2;
1862 Lisp_Object pred;
1863 {
1864 Lisp_Object value;
1865 register Lisp_Object tail;
1866 Lisp_Object tem;
1867 register Lisp_Object l1, l2;
1868 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
1869
1870 l1 = org_l1;
1871 l2 = org_l2;
1872 tail = Qnil;
1873 value = Qnil;
1874
1875 1876 1877
1878 GCPRO4 (org_l1, org_l2, pred, value);
1879
1880 while (1)
1881 {
1882 if (NILP (l1))
1883 {
1884 UNGCPRO;
1885 if (NILP (tail))
1886 return l2;
1887 Fsetcdr (tail, l2);
1888 return value;
1889 }
1890 if (NILP (l2))
1891 {
1892 UNGCPRO;
1893 if (NILP (tail))
1894 return l1;
1895 Fsetcdr (tail, l1);
1896 return value;
1897 }
1898 tem = call2 (pred, Fcar (l2), Fcar (l1));
1899 if (NILP (tem))
1900 {
1901 tem = l1;
1902 l1 = Fcdr (l1);
1903 org_l1 = l1;
1904 }
1905 else
1906 {
1907 tem = l2;
1908 l2 = Fcdr (l2);
1909 org_l2 = l2;
1910 }
1911 if (NILP (tail))
1912 value = tem;
1913 else
1914 Fsetcdr (tail, tem);
1915 tail = tem;
1916 }
1917 }
1918
1919
1920
1921
1922 DEFUN ("plist-get", Fplist_get, Splist_get, 2, 2, 0,
1923 doc: 1924 1925 1926 1927 )
1928 (plist, prop)
1929 Lisp_Object plist;
1930 Lisp_Object prop;
1931 {
1932 Lisp_Object tail, halftail;
1933
1934
1935 tail = halftail = plist;
1936 while (CONSP (tail) && CONSP (XCDR (tail)))
1937 {
1938 if (EQ (prop, XCAR (tail)))
1939 return XCAR (XCDR (tail));
1940
1941 tail = XCDR (XCDR (tail));
1942 halftail = XCDR (halftail);
1943 if (EQ (tail, halftail))
1944 break;
1945
1946 #if 0
1947 1948
1949 if (!interrupt_input_blocked)
1950 QUIT;
1951 #endif
1952 }
1953
1954 return Qnil;
1955 }
1956
1957 DEFUN ("get", Fget, Sget, 2, 2, 0,
1958 doc: 1959 )
1960 (symbol, propname)
1961 Lisp_Object symbol, propname;
1962 {
1963 CHECK_SYMBOL (symbol);
1964 return Fplist_get (XSYMBOL (symbol)->plist, propname);
1965 }
1966
1967 DEFUN ("plist-put", Fplist_put, Splist_put, 3, 3, 0,
1968 doc: 1969 1970 1971 1972 1973 1974 )
1975 (plist, prop, val)
1976 Lisp_Object plist;
1977 register Lisp_Object prop;
1978 Lisp_Object val;
1979 {
1980 register Lisp_Object tail, prev;
1981 Lisp_Object newcell;
1982 prev = Qnil;
1983 for (tail = plist; CONSP (tail) && CONSP (XCDR (tail));
1984 tail = XCDR (XCDR (tail)))
1985 {
1986 if (EQ (prop, XCAR (tail)))
1987 {
1988 Fsetcar (XCDR (tail), val);
1989 return plist;
1990 }
1991
1992 prev = tail;
1993 QUIT;
1994 }
1995 newcell = Fcons (prop, Fcons (val, NILP (prev) ? plist : XCDR (XCDR (prev))));
1996 if (NILP (prev))
1997 return newcell;
1998 else
1999 Fsetcdr (XCDR (prev), newcell);
2000 return plist;
2001 }
2002
2003 DEFUN ("put", Fput, Sput, 3, 3, 0,
2004 doc: 2005 )
2006 (symbol, propname, value)
2007 Lisp_Object symbol, propname, value;
2008 {
2009 CHECK_SYMBOL (symbol);
2010 XSYMBOL (symbol)->plist
2011 = Fplist_put (XSYMBOL (symbol)->plist, propname, value);
2012 return value;
2013 }
2014
2015 DEFUN ("lax-plist-get", Flax_plist_get, Slax_plist_get, 2, 2, 0,
2016 doc: 2017 2018 2019 2020 )
2021 (plist, prop)
2022 Lisp_Object plist;
2023 Lisp_Object prop;
2024 {
2025 Lisp_Object tail;
2026
2027 for (tail = plist;
2028 CONSP (tail) && CONSP (XCDR (tail));
2029 tail = XCDR (XCDR (tail)))
2030 {
2031 if (! NILP (Fequal (prop, XCAR (tail))))
2032 return XCAR (XCDR (tail));
2033
2034 QUIT;
2035 }
2036
2037 CHECK_LIST_END (tail, prop);
2038
2039 return Qnil;
2040 }
2041
2042 DEFUN ("lax-plist-put", Flax_plist_put, Slax_plist_put, 3, 3, 0,
2043 doc: 2044 2045 2046 2047 2048 2049 )
2050 (plist, prop, val)
2051 Lisp_Object plist;
2052 register Lisp_Object prop;
2053 Lisp_Object val;
2054 {
2055 register Lisp_Object tail, prev;
2056 Lisp_Object newcell;
2057 prev = Qnil;
2058 for (tail = plist; CONSP (tail) && CONSP (XCDR (tail));
2059 tail = XCDR (XCDR (tail)))
2060 {
2061 if (! NILP (Fequal (prop, XCAR (tail))))
2062 {
2063 Fsetcar (XCDR (tail), val);
2064 return plist;
2065 }
2066
2067 prev = tail;
2068 QUIT;
2069 }
2070 newcell = Fcons (prop, Fcons (val, Qnil));
2071 if (NILP (prev))
2072 return newcell;
2073 else
2074 Fsetcdr (XCDR (prev), newcell);
2075 return plist;
2076 }
2077
2078 DEFUN ("eql", Feql, Seql, 2, 2, 0,
2079 doc: 2080 )
2081 (obj1, obj2)
2082 Lisp_Object obj1, obj2;
2083 {
2084 if (FLOATP (obj1))
2085 return internal_equal (obj1, obj2, 0, 0) ? Qt : Qnil;
2086 else
2087 return EQ (obj1, obj2) ? Qt : Qnil;
2088 }
2089
2090 DEFUN ("equal", Fequal, Sequal, 2, 2, 0,
2091 doc: 2092 2093 2094 2095 2096 2097 )
2098 (o1, o2)
2099 register Lisp_Object o1, o2;
2100 {
2101 return internal_equal (o1, o2, 0, 0) ? Qt : Qnil;
2102 }
2103
2104 DEFUN ("equal-including-properties", Fequal_including_properties, Sequal_including_properties, 2, 2, 0,
2105 doc: 2106 2107 )
2108 (o1, o2)
2109 register Lisp_Object o1, o2;
2110 {
2111 return internal_equal (o1, o2, 0, 1) ? Qt : Qnil;
2112 }
2113
2114 2115 2116
2117
2118 static int
2119 internal_equal (o1, o2, depth, props)
2120 register Lisp_Object o1, o2;
2121 int depth, props;
2122 {
2123 if (depth > 200)
2124 error ("Stack overflow in equal");
2125
2126 tail_recurse:
2127 QUIT;
2128 if (EQ (o1, o2))
2129 return 1;
2130 if (XTYPE (o1) != XTYPE (o2))
2131 return 0;
2132
2133 switch (XTYPE (o1))
2134 {
2135 case Lisp_Float:
2136 {
2137 double d1, d2;
2138
2139 d1 = extract_float (o1);
2140 d2 = extract_float (o2);
2141 2142
2143 return d1 == d2 || (d1 != d1 && d2 != d2);
2144 }
2145
2146 case Lisp_Cons:
2147 if (!internal_equal (XCAR (o1), XCAR (o2), depth + 1, props))
2148 return 0;
2149 o1 = XCDR (o1);
2150 o2 = XCDR (o2);
2151 goto tail_recurse;
2152
2153 case Lisp_Misc:
2154 if (XMISCTYPE (o1) != XMISCTYPE (o2))
2155 return 0;
2156 if (OVERLAYP (o1))
2157 {
2158 if (!internal_equal (OVERLAY_START (o1), OVERLAY_START (o2),
2159 depth + 1, props)
2160 || !internal_equal (OVERLAY_END (o1), OVERLAY_END (o2),
2161 depth + 1, props))
2162 return 0;
2163 o1 = XOVERLAY (o1)->plist;
2164 o2 = XOVERLAY (o2)->plist;
2165 goto tail_recurse;
2166 }
2167 if (MARKERP (o1))
2168 {
2169 return (XMARKER (o1)->buffer == XMARKER (o2)->buffer
2170 && (XMARKER (o1)->buffer == 0
2171 || XMARKER (o1)->bytepos == XMARKER (o2)->bytepos));
2172 }
2173 break;
2174
2175 case Lisp_Vectorlike:
2176 {
2177 register int i;
2178 EMACS_INT size = ASIZE (o1);
2179 2180 2181
2182 if (ASIZE (o2) != size)
2183 return 0;
2184
2185 if (BOOL_VECTOR_P (o1))
2186 {
2187 int size_in_chars
2188 = ((XBOOL_VECTOR (o1)->size + BOOL_VECTOR_BITS_PER_CHAR - 1)
2189 / BOOL_VECTOR_BITS_PER_CHAR);
2190
2191 if (XBOOL_VECTOR (o1)->size != XBOOL_VECTOR (o2)->size)
2192 return 0;
2193 if (bcmp (XBOOL_VECTOR (o1)->data, XBOOL_VECTOR (o2)->data,
2194 size_in_chars))
2195 return 0;
2196 return 1;
2197 }
2198 if (WINDOW_CONFIGURATIONP (o1))
2199 return compare_window_configurations (o1, o2, 0);
2200
2201 2202 2203
2204 if (size & PSEUDOVECTOR_FLAG)
2205 {
2206 if (!(size & (PVEC_COMPILED
2207 | PVEC_CHAR_TABLE | PVEC_SUB_CHAR_TABLE | PVEC_FONT)))
2208 return 0;
2209 size &= PSEUDOVECTOR_SIZE_MASK;
2210 }
2211 for (i = 0; i < size; i++)
2212 {
2213 Lisp_Object v1, v2;
2214 v1 = AREF (o1, i);
2215 v2 = AREF (o2, i);
2216 if (!internal_equal (v1, v2, depth + 1, props))
2217 return 0;
2218 }
2219 return 1;
2220 }
2221 break;
2222
2223 case Lisp_String:
2224 if (SCHARS (o1) != SCHARS (o2))
2225 return 0;
2226 if (SBYTES (o1) != SBYTES (o2))
2227 return 0;
2228 if (bcmp (SDATA (o1), SDATA (o2),
2229 SBYTES (o1)))
2230 return 0;
2231 if (props && !compare_string_intervals (o1, o2))
2232 return 0;
2233 return 1;
2234
2235 default:
2236 break;
2237 }
2238
2239 return 0;
2240 }
2241
2242 extern Lisp_Object Fmake_char_internal ();
2243
2244 DEFUN ("fillarray", Ffillarray, Sfillarray, 2, 2, 0,
2245 doc: 2246 )
2247 (array, item)
2248 Lisp_Object array, item;
2249 {
2250 register int size, index, charval;
2251 if (VECTORP (array))
2252 {
2253 register Lisp_Object *p = XVECTOR (array)->contents;
2254 size = ASIZE (array);
2255 for (index = 0; index < size; index++)
2256 p[index] = item;
2257 }
2258 else if (CHAR_TABLE_P (array))
2259 {
2260 int i;
2261
2262 for (i = 0; i < (1 << CHARTAB_SIZE_BITS_0); i++)
2263 XCHAR_TABLE (array)->contents[i] = item;
2264 XCHAR_TABLE (array)->defalt = item;
2265 }
2266 else if (STRINGP (array))
2267 {
2268 register unsigned char *p = SDATA (array);
2269 CHECK_NUMBER (item);
2270 charval = XINT (item);
2271 size = SCHARS (array);
2272 if (STRING_MULTIBYTE (array))
2273 {
2274 unsigned char str[MAX_MULTIBYTE_LENGTH];
2275 int len = CHAR_STRING (charval, str);
2276 int size_byte = SBYTES (array);
2277 unsigned char *p1 = p, *endp = p + size_byte;
2278 int i;
2279
2280 if (size != size_byte)
2281 while (p1 < endp)
2282 {
2283 int this_len = MULTIBYTE_FORM_LENGTH (p1, endp - p1);
2284 if (len != this_len)
2285 error ("Attempt to change byte length of a string");
2286 p1 += this_len;
2287 }
2288 for (i = 0; i < size_byte; i++)
2289 *p++ = str[i % len];
2290 }
2291 else
2292 for (index = 0; index < size; index++)
2293 p[index] = charval;
2294 }
2295 else if (BOOL_VECTOR_P (array))
2296 {
2297 register unsigned char *p = XBOOL_VECTOR (array)->data;
2298 int size_in_chars
2299 = ((XBOOL_VECTOR (array)->size + BOOL_VECTOR_BITS_PER_CHAR - 1)
2300 / BOOL_VECTOR_BITS_PER_CHAR);
2301
2302 charval = (! NILP (item) ? -1 : 0);
2303 for (index = 0; index < size_in_chars - 1; index++)
2304 p[index] = charval;
2305 if (index < size_in_chars)
2306 {
2307
2308 if (XBOOL_VECTOR (array)->size % BOOL_VECTOR_BITS_PER_CHAR)
2309 charval &= (1 << (XBOOL_VECTOR (array)->size % BOOL_VECTOR_BITS_PER_CHAR)) - 1;
2310 p[index] = charval;
2311 }
2312 }
2313 else
2314 wrong_type_argument (Qarrayp, array);
2315 return array;
2316 }
2317
2318 DEFUN ("clear-string", Fclear_string, Sclear_string,
2319 1, 1, 0,
2320 doc: 2321 )
2322 (string)
2323 Lisp_Object string;
2324 {
2325 int len;
2326 CHECK_STRING (string);
2327 len = SBYTES (string);
2328 bzero (SDATA (string), len);
2329 STRING_SET_CHARS (string, len);
2330 STRING_SET_UNIBYTE (string);
2331 return Qnil;
2332 }
2333
2334
2335 Lisp_Object
2336 nconc2 (s1, s2)
2337 Lisp_Object s1, s2;
2338 {
2339 Lisp_Object args[2];
2340 args[0] = s1;
2341 args[1] = s2;
2342 return Fnconc (2, args);
2343 }
2344
2345 DEFUN ("nconc", Fnconc, Snconc, 0, MANY, 0,
2346 doc: 2347 2348 )
2349 (nargs, args)
2350 int nargs;
2351 Lisp_Object *args;
2352 {
2353 register int argnum;
2354 register Lisp_Object tail, tem, val;
2355
2356 val = tail = Qnil;
2357
2358 for (argnum = 0; argnum < nargs; argnum++)
2359 {
2360 tem = args[argnum];
2361 if (NILP (tem)) continue;
2362
2363 if (NILP (val))
2364 val = tem;
2365
2366 if (argnum + 1 == nargs) break;
2367
2368 CHECK_LIST_CONS (tem, tem);
2369
2370 while (CONSP (tem))
2371 {
2372 tail = tem;
2373 tem = XCDR (tail);
2374 QUIT;
2375 }
2376
2377 tem = args[argnum + 1];
2378 Fsetcdr (tail, tem);
2379 if (NILP (tem))
2380 args[argnum + 1] = tail;
2381 }
2382
2383 return val;
2384 }
2385
2386 2387 2388 2389
2390
2391 static void
2392 mapcar1 (leni, vals, fn, seq)
2393 int leni;
2394 Lisp_Object *vals;
2395 Lisp_Object fn, seq;
2396 {
2397 register Lisp_Object tail;
2398 Lisp_Object dummy;
2399 register int i;
2400 struct gcpro gcpro1, gcpro2, gcpro3;
2401
2402 if (vals)
2403 {
2404
2405 for (i = 0; i < leni; i++)
2406 vals[i] = Qnil;
2407
2408 GCPRO3 (dummy, fn, seq);
2409 gcpro1.var = vals;
2410 gcpro1.nvars = leni;
2411 }
2412 else
2413 GCPRO2 (fn, seq);
2414 2415 2416
2417
2418 if (VECTORP (seq))
2419 {
2420 for (i = 0; i < leni; i++)
2421 {
2422 dummy = call1 (fn, AREF (seq, i));
2423 if (vals)
2424 vals[i] = dummy;
2425 }
2426 }
2427 else if (BOOL_VECTOR_P (seq))
2428 {
2429 for (i = 0; i < leni; i++)
2430 {
2431 int byte;
2432 byte = XBOOL_VECTOR (seq)->data[i / BOOL_VECTOR_BITS_PER_CHAR];
2433 dummy = (byte & (1 << (i % BOOL_VECTOR_BITS_PER_CHAR))) ? Qt : Qnil;
2434 dummy = call1 (fn, dummy);
2435 if (vals)
2436 vals[i] = dummy;
2437 }
2438 }
2439 else if (STRINGP (seq))
2440 {
2441 int i_byte;
2442
2443 for (i = 0, i_byte = 0; i < leni;)
2444 {
2445 int c;
2446 int i_before = i;
2447
2448 FETCH_STRING_CHAR_ADVANCE (c, seq, i, i_byte);
2449 XSETFASTINT (dummy, c);
2450 dummy = call1 (fn, dummy);
2451 if (vals)
2452 vals[i_before] = dummy;
2453 }
2454 }
2455 else
2456 {
2457 tail = seq;
2458 for (i = 0; i < leni && CONSP (tail); i++)
2459 {
2460 dummy = call1 (fn, XCAR (tail));
2461 if (vals)
2462 vals[i] = dummy;
2463 tail = XCDR (tail);
2464 }
2465 }
2466
2467 UNGCPRO;
2468 }
2469
2470 DEFUN ("mapconcat", Fmapconcat, Smapconcat, 3, 3, 0,
2471 doc: 2472 2473 2474 )
2475 (function, sequence, separator)
2476 Lisp_Object function, sequence, separator;
2477 {
2478 Lisp_Object len;
2479 register int leni;
2480 int nargs;
2481 register Lisp_Object *args;
2482 register int i;
2483 struct gcpro gcpro1;
2484 Lisp_Object ret;
2485 USE_SAFE_ALLOCA;
2486
2487 len = Flength (sequence);
2488 if (CHAR_TABLE_P (sequence))
2489 wrong_type_argument (Qlistp, sequence);
2490 leni = XINT (len);
2491 nargs = leni + leni - 1;
2492 if (nargs < 0) return empty_unibyte_string;
2493
2494 SAFE_ALLOCA_LISP (args, nargs);
2495
2496 GCPRO1 (separator);
2497 mapcar1 (leni, args, function, sequence);
2498 UNGCPRO;
2499
2500 for (i = leni - 1; i > 0; i--)
2501 args[i + i] = args[i];
2502
2503 for (i = 1; i < nargs; i += 2)
2504 args[i] = separator;
2505
2506 ret = Fconcat (nargs, args);
2507 SAFE_FREE ();
2508
2509 return ret;
2510 }
2511
2512 DEFUN ("mapcar", Fmapcar, Smapcar, 2, 2, 0,
2513 doc: 2514 2515 )
2516 (function, sequence)
2517 Lisp_Object function, sequence;
2518 {
2519 register Lisp_Object len;
2520 register int leni;
2521 register Lisp_Object *args;
2522 Lisp_Object ret;
2523 USE_SAFE_ALLOCA;
2524
2525 len = Flength (sequence);
2526 if (CHAR_TABLE_P (sequence))
2527 wrong_type_argument (Qlistp, sequence);
2528 leni = XFASTINT (len);
2529
2530 SAFE_ALLOCA_LISP (args, leni);
2531
2532 mapcar1 (leni, args, function, sequence);
2533
2534 ret = Flist (leni, args);
2535 SAFE_FREE ();
2536
2537 return ret;
2538 }
2539
2540 DEFUN ("mapc", Fmapc, Smapc, 2, 2, 0,
2541 doc: 2542 2543 )
2544 (function, sequence)
2545 Lisp_Object function, sequence;
2546 {
2547 register int leni;
2548
2549 leni = XFASTINT (Flength (sequence));
2550 if (CHAR_TABLE_P (sequence))
2551 wrong_type_argument (Qlistp, sequence);
2552 mapcar1 (leni, 0, function, sequence);
2553
2554 return sequence;
2555 }
2556
2557
2558
2559 DEFUN ("y-or-n-p", Fy_or_n_p, Sy_or_n_p, 1, 1, 0,
2560 doc: 2561 2562 2563 2564 2565 2566 2567 2568 2569 2570 )
2571 (prompt)
2572 Lisp_Object prompt;
2573 {
2574 register Lisp_Object obj, key, def, map;
2575 register int answer;
2576 Lisp_Object xprompt;
2577 Lisp_Object args[2];
2578 struct gcpro gcpro1, gcpro2;
2579 int count = SPECPDL_INDEX ();
2580
2581 specbind (Qcursor_in_echo_area, Qt);
2582
2583 map = Fsymbol_value (intern ("query-replace-map"));
2584
2585 CHECK_STRING (prompt);
2586 xprompt = prompt;
2587 GCPRO2 (prompt, xprompt);
2588
2589 #ifdef HAVE_WINDOW_SYSTEM
2590 if (display_hourglass_p)
2591 cancel_hourglass ();
2592 #endif
2593
2594 while (1)
2595 {
2596
2597 #ifdef HAVE_MENUS
2598 if (FRAME_WINDOW_P (SELECTED_FRAME ())
2599 && (NILP (last_nonmenu_event) || CONSP (last_nonmenu_event))
2600 && use_dialog_box
2601 && have_menus_p ())
2602 {
2603 Lisp_Object pane, menu;
2604 redisplay_preserve_echo_area (3);
2605 pane = Fcons (Fcons (build_string ("Yes"), Qt),
2606 Fcons (Fcons (build_string ("No"), Qnil),
2607 Qnil));
2608 menu = Fcons (prompt, pane);
2609 obj = Fx_popup_dialog (Qt, menu, Qnil);
2610 answer = !NILP (obj);
2611 break;
2612 }
2613 #endif
2614 cursor_in_echo_area = 1;
2615 choose_minibuf_frame ();
2616
2617 {
2618 Lisp_Object pargs[3];
2619
2620
2621 pargs[0] = build_string ("%s(y or n) ");
2622 pargs[1] = intern ("face");
2623 pargs[2] = intern ("minibuffer-prompt");
2624 args[0] = Fpropertize (3, pargs);
2625 args[1] = xprompt;
2626 Fmessage (2, args);
2627 }
2628
2629 if (minibuffer_auto_raise)
2630 {
2631 Lisp_Object mini_frame;
2632
2633 mini_frame = WINDOW_FRAME (XWINDOW (minibuf_window));
2634
2635 Fraise_frame (mini_frame);
2636 }
2637
2638 temporarily_switch_to_single_kboard (SELECTED_FRAME ());
2639 obj = read_filtered_event (1, 0, 0, 0, Qnil);
2640 cursor_in_echo_area = 0;
2641
2642 QUIT;
2643
2644 key = Fmake_vector (make_number (1), obj);
2645 def = Flookup_key (map, key, Qt);
2646
2647 if (EQ (def, intern ("skip")))
2648 {
2649 answer = 0;
2650 break;
2651 }
2652 else if (EQ (def, intern ("act")))
2653 {
2654 answer = 1;
2655 break;
2656 }
2657 else if (EQ (def, intern ("recenter")))
2658 {
2659 Frecenter (Qnil);
2660 xprompt = prompt;
2661 continue;
2662 }
2663 else if (EQ (def, intern ("quit")))
2664 Vquit_flag = Qt;
2665 2666
2667 else if (EQ (def, intern ("exit-prefix")))
2668 Vquit_flag = Qt;
2669
2670 QUIT;
2671
2672 2673
2674 Vquit_flag = Qnil;
2675
2676 Fding (Qnil);
2677 Fdiscard_input ();
2678 if (EQ (xprompt, prompt))
2679 {
2680 args[0] = build_string ("Please answer y or n. ");
2681 args[1] = prompt;
2682 xprompt = Fconcat (2, args);
2683 }
2684 }
2685 UNGCPRO;
2686
2687 if (! noninteractive)
2688 {
2689 cursor_in_echo_area = -1;
2690 message_with_string (answer ? "%s(y or n) y" : "%s(y or n) n",
2691 xprompt, 0);
2692 }
2693
2694 unbind_to (count, Qnil);
2695 return answer ? Qt : Qnil;
2696 }
2697
2698 2699 2700 2701
2702
2703 Lisp_Object
2704 do_yes_or_no_p (prompt)
2705 Lisp_Object prompt;
2706 {
2707 return call1 (intern ("yes-or-no-p"), prompt);
2708 }
2709
2710
2711
2712 DEFUN ("yes-or-no-p", Fyes_or_no_p, Syes_or_no_p, 1, 1, 0,
2713 doc: 2714 2715 2716 2717 2718 2719 2720 )
2721 (prompt)
2722 Lisp_Object prompt;
2723 {
2724 register Lisp_Object ans;
2725 Lisp_Object args[2];
2726 struct gcpro gcpro1;
2727
2728 CHECK_STRING (prompt);
2729
2730 #ifdef HAVE_MENUS
2731 if (FRAME_WINDOW_P (SELECTED_FRAME ())
2732 && (NILP (last_nonmenu_event) || CONSP (last_nonmenu_event))
2733 && use_dialog_box
2734 && have_menus_p ())
2735 {
2736 Lisp_Object pane, menu, obj;
2737 redisplay_preserve_echo_area (4);
2738 pane = Fcons (Fcons (build_string ("Yes"), Qt),
2739 Fcons (Fcons (build_string ("No"), Qnil),
2740 Qnil));
2741 GCPRO1 (pane);
2742 menu = Fcons (prompt, pane);
2743 obj = Fx_popup_dialog (Qt, menu, Qnil);
2744 UNGCPRO;
2745 return obj;
2746 }
2747 #endif
2748
2749 args[0] = prompt;
2750 args[1] = build_string ("(yes or no) ");
2751 prompt = Fconcat (2, args);
2752
2753 GCPRO1 (prompt);
2754
2755 while (1)
2756 {
2757 ans = Fdowncase (Fread_from_minibuffer (prompt, Qnil, Qnil, Qnil,
2758 Qyes_or_no_p_history, Qnil,
2759 Qnil));
2760 if (SCHARS (ans) == 3 && !strcmp (SDATA (ans), "yes"))
2761 {
2762 UNGCPRO;
2763 return Qt;
2764 }
2765 if (SCHARS (ans) == 2 && !strcmp (SDATA (ans), "no"))
2766 {
2767 UNGCPRO;
2768 return Qnil;
2769 }
2770
2771 Fding (Qnil);
2772 Fdiscard_input ();
2773 message ("Please answer yes or no.");
2774 Fsleep_for (make_number (2), Qnil);
2775 }
2776 }
2777
2778 DEFUN ("load-average", Fload_average, Sload_average, 0, 1, 0,
2779 doc: 2780 2781 2782 2783 2784 2785 2786 2787 2788 2789 2790 2791 2792 2793 )
2794 (use_floats)
2795 Lisp_Object use_floats;
2796 {
2797 double load_ave[3];
2798 int loads = getloadavg (load_ave, 3);
2799 Lisp_Object ret = Qnil;
2800
2801 if (loads < 0)
2802 error ("load-average not implemented for this operating system");
2803
2804 while (loads-- > 0)
2805 {
2806 Lisp_Object load = (NILP (use_floats) ?
2807 make_number ((int) (100.0 * load_ave[loads]))
2808 : make_float (load_ave[loads]));
2809 ret = Fcons (load, ret);
2810 }
2811
2812 return ret;
2813 }
2814
2815 Lisp_Object Vfeatures, Qsubfeatures;
2816 extern Lisp_Object Vafter_load_alist;
2817
2818 DEFUN ("featurep", Ffeaturep, Sfeaturep, 1, 2, 0,
2819 doc: 2820 2821 2822 2823 2824 2825 )
2826 (feature, subfeature)
2827 Lisp_Object feature, subfeature;
2828 {
2829 register Lisp_Object tem;
2830 CHECK_SYMBOL (feature);
2831 tem = Fmemq (feature, Vfeatures);
2832 if (!NILP (tem) && !NILP (subfeature))
2833 tem = Fmember (subfeature, Fget (feature, Qsubfeatures));
2834 return (NILP (tem)) ? Qnil : Qt;
2835 }
2836
2837 DEFUN ("provide", Fprovide, Sprovide, 1, 2, 0,
2838 doc: 2839 2840 )
2841 (feature, subfeatures)
2842 Lisp_Object feature, subfeatures;
2843 {
2844 register Lisp_Object tem;
2845 CHECK_SYMBOL (feature);
2846 CHECK_LIST (subfeatures);
2847 if (!NILP (Vautoload_queue))
2848 Vautoload_queue = Fcons (Fcons (make_number (0), Vfeatures),
2849 Vautoload_queue);
2850 tem = Fmemq (feature, Vfeatures);
2851 if (NILP (tem))
2852 Vfeatures = Fcons (feature, Vfeatures);
2853 if (!NILP (subfeatures))
2854 Fput (feature, Qsubfeatures, subfeatures);
2855 LOADHIST_ATTACH (Fcons (Qprovide, feature));
2856
2857
2858 tem = Fassq (feature, Vafter_load_alist);
2859 if (CONSP (tem))
2860 Fprogn (XCDR (tem));
2861
2862 return feature;
2863 }
2864
2865
2866
2867
2868
2869 Lisp_Object require_nesting_list;
2870
2871 Lisp_Object
2872 require_unwind (old_value)
2873 Lisp_Object old_value;
2874 {
2875 return require_nesting_list = old_value;
2876 }
2877
2878 DEFUN ("require", Frequire, Srequire, 1, 3, 0,
2879 doc: 2880 2881 2882 2883 2884 2885 2886 2887 2888 )
2889 (feature, filename, noerror)
2890 Lisp_Object feature, filename, noerror;
2891 {
2892 register Lisp_Object tem;
2893 struct gcpro gcpro1, gcpro2;
2894 int from_file = load_in_progress;
2895
2896 CHECK_SYMBOL (feature);
2897
2898 2899 2900 2901
2902 if (!from_file)
2903 for (tem = Vcurrent_load_list; CONSP (tem); tem = XCDR (tem))
2904 if (NILP (XCDR (tem)) && STRINGP (XCAR (tem)))
2905 from_file = 1;
2906
2907 if (from_file)
2908 {
2909 tem = Fcons (Qrequire, feature);
2910 if (NILP (Fmember (tem, Vcurrent_load_list)))
2911 LOADHIST_ATTACH (tem);
2912 }
2913 tem = Fmemq (feature, Vfeatures);
2914
2915 if (NILP (tem))
2916 {
2917 int count = SPECPDL_INDEX ();
2918 int nesting = 0;
2919
2920 2921
2922 if (! NILP (Vpurify_flag))
2923 error ("(require %s) while preparing to dump",
2924 SDATA (SYMBOL_NAME (feature)));
2925
2926 2927 2928
2929 tem = require_nesting_list;
2930 while (! NILP (tem))
2931 {
2932 if (! NILP (Fequal (feature, XCAR (tem))))
2933 nesting++;
2934 tem = XCDR (tem);
2935 }
2936 if (nesting > 3)
2937 error ("Recursive `require' for feature `%s'",
2938 SDATA (SYMBOL_NAME (feature)));
2939
2940
2941 record_unwind_protect (require_unwind, require_nesting_list);
2942 require_nesting_list = Fcons (feature, require_nesting_list);
2943
2944
2945 record_unwind_protect (un_autoload, Vautoload_queue);
2946 Vautoload_queue = Qt;
2947
2948
2949 GCPRO2 (feature, filename);
2950 tem = Fload (NILP (filename) ? Fsymbol_name (feature) : filename,
2951 noerror, Qt, Qnil, (NILP (filename) ? Qt : Qnil));
2952 UNGCPRO;
2953
2954
2955 if (NILP (tem))
2956 return unbind_to (count, Qnil);
2957
2958 tem = Fmemq (feature, Vfeatures);
2959 if (NILP (tem))
2960 error ("Required feature `%s' was not provided",
2961 SDATA (SYMBOL_NAME (feature)));
2962
2963
2964 Vautoload_queue = Qt;
2965 feature = unbind_to (count, feature);
2966 }
2967
2968 return feature;
2969 }
2970
2971 2972 2973 2974 2975 2976
2977
2978 DEFUN ("plist-member", Fplist_member, Splist_member, 2, 2, 0,
2979 doc: 2980 2981 2982 2983 2984 )
2985 (plist, prop)
2986 Lisp_Object plist, prop;
2987 {
2988 while (CONSP (plist) && !EQ (XCAR (plist), prop))
2989 {
2990 QUIT;
2991 plist = XCDR (plist);
2992 plist = CDR (plist);
2993 }
2994 return plist;
2995 }
2996
2997 DEFUN ("widget-put", Fwidget_put, Swidget_put, 3, 3, 0,
2998 doc: 2999 )
3000 (widget, property, value)
3001 Lisp_Object widget, property, value;
3002 {
3003 CHECK_CONS (widget);
3004 XSETCDR (widget, Fplist_put (XCDR (widget), property, value));
3005 return value;
3006 }
3007
3008 DEFUN ("widget-get", Fwidget_get, Swidget_get, 2, 2, 0,
3009 doc: 3010 3011 )
3012 (widget, property)
3013 Lisp_Object widget, property;
3014 {
3015 Lisp_Object tmp;
3016
3017 while (1)
3018 {
3019 if (NILP (widget))
3020 return Qnil;
3021 CHECK_CONS (widget);
3022 tmp = Fplist_member (XCDR (widget), property);
3023 if (CONSP (tmp))
3024 {
3025 tmp = XCDR (tmp);
3026 return CAR (tmp);
3027 }
3028 tmp = XCAR (widget);
3029 if (NILP (tmp))
3030 return Qnil;
3031 widget = Fget (tmp, Qwidget_type);
3032 }
3033 }
3034
3035 DEFUN ("widget-apply", Fwidget_apply, Swidget_apply, 2, MANY, 0,
3036 doc: 3037 3038 )
3039 (nargs, args)
3040 int nargs;
3041 Lisp_Object *args;
3042 {
3043
3044 Lisp_Object newargs[3];
3045 struct gcpro gcpro1, gcpro2;
3046 Lisp_Object result;
3047
3048 newargs[0] = Fwidget_get (args[0], args[1]);
3049 newargs[1] = args[0];
3050 newargs[2] = Flist (nargs - 2, args + 2);
3051 GCPRO2 (newargs[0], newargs[2]);
3052 result = Fapply (3, newargs);
3053 UNGCPRO;
3054 return result;
3055 }
3056
3057 #ifdef HAVE_LANGINFO_CODESET
3058 #include <langinfo.h>
3059 #endif
3060
3061 DEFUN ("locale-info", Flocale_info, Slocale_info, 1, 1, 0,
3062 doc: 3063 3064 3065 3066 3067 3068 3069 3070 3071 3072 3073 3074 3075 3076 3077 3078 3079 )
3080 (item)
3081 Lisp_Object item;
3082 {
3083 char *str = NULL;
3084 #ifdef HAVE_LANGINFO_CODESET
3085 Lisp_Object val;
3086 if (EQ (item, Qcodeset))
3087 {
3088 str = nl_langinfo (CODESET);
3089 return build_string (str);
3090 }
3091 #ifdef DAY_1
3092 else if (EQ (item, Qdays))
3093 {
3094 Lisp_Object v = Fmake_vector (make_number (7), Qnil);
3095 const int days[7] = {DAY_1, DAY_2, DAY_3, DAY_4, DAY_5, DAY_6, DAY_7};
3096 int i;
3097 struct gcpro gcpro1;
3098 GCPRO1 (v);
3099 synchronize_system_time_locale ();
3100 for (i = 0; i < 7; i++)
3101 {
3102 str = nl_langinfo (days[i]);
3103 val = make_unibyte_string (str, strlen (str));
3104 3105
3106 Faset (v, make_number (i),
3107 code_convert_string_norecord (val, Vlocale_coding_system,
3108 0));
3109 }
3110 UNGCPRO;
3111 return v;
3112 }
3113 #endif
3114 #ifdef MON_1
3115 else if (EQ (item, Qmonths))
3116 {
3117 Lisp_Object v = Fmake_vector (make_number (12), Qnil);
3118 const int months[12] = {MON_1, MON_2, MON_3, MON_4, MON_5, MON_6, MON_7,
3119 MON_8, MON_9, MON_10, MON_11, MON_12};
3120 int i;
3121 struct gcpro gcpro1;
3122 GCPRO1 (v);
3123 synchronize_system_time_locale ();
3124 for (i = 0; i < 12; i++)
3125 {
3126 str = nl_langinfo (months[i]);
3127 val = make_unibyte_string (str, strlen (str));
3128 Faset (v, make_number (i),
3129 code_convert_string_norecord (val, Vlocale_coding_system, 0));
3130 }
3131 UNGCPRO;
3132 return v;
3133 }
3134 #endif
3135 3136
3137 #ifdef PAPER_WIDTH
3138 else if (EQ (item, Qpaper))
3139 {
3140 return list2 (make_number (nl_langinfo (PAPER_WIDTH)),
3141 make_number (nl_langinfo (PAPER_HEIGHT)));
3142 }
3143 #endif
3144 #endif
3145 return Qnil;
3146 }
3147
3148 3149
3150
3151 #define MIME_LINE_LENGTH 76
3152
3153 #define IS_ASCII(Character) \
3154 ((Character) < 128)
3155 #define IS_BASE64(Character) \
3156 (IS_ASCII (Character) && base64_char_to_value[Character] >= 0)
3157 #define IS_BASE64_IGNORABLE(Character) \
3158 ((Character) == ' ' || (Character) == '\t' || (Character) == '\n' \
3159 || (Character) == '\f' || (Character) == '\r')
3160
3161 3162 3163
3164 #define READ_QUADRUPLET_BYTE(retval) \
3165 do \
3166 { \
3167 if (i == length) \
3168 { \
3169 if (nchars_return) \
3170 *nchars_return = nchars; \
3171 return (retval); \
3172 } \
3173 c = from[i++]; \
3174 } \
3175 while (IS_BASE64_IGNORABLE (c))
3176
3177
3178 static const char base64_value_to_char[64] =
3179 {
3180 'A', 'B', 'C', 'D', 'E', 'F', 'G', 'H', 'I', 'J',
3181 'K', 'L', 'M', 'N', 'O', 'P', 'Q', 'R', 'S', 'T',
3182 'U', 'V', 'W', 'X', 'Y', 'Z', 'a', 'b', 'c', 'd',
3183 'e', 'f', 'g', 'h', 'i', 'j', 'k', 'l', 'm', 'n',
3184 'o', 'p', 'q', 'r', 's', 't', 'u', 'v', 'w', 'x',
3185 'y', 'z', '0', '1', '2', '3', '4', '5', '6', '7',
3186 '8', '9', '+', '/'
3187 };
3188
3189
3190 static const short base64_char_to_value[128] =
3191 {
3192 -1, -1, -1, -1, -1, -1, -1, -1, -1, -1,
3193 -1, -1, -1, -1, -1, -1, -1, -1, -1, -1,
3194 -1, -1, -1, -1, -1, -1, -1, -1, -1, -1,
3195 -1, -1, -1, -1, -1, -1, -1, -1, -1, -1,
3196 -1, -1, -1, 62, -1, -1, -1, 63, 52, 53,
3197 54, 55, 56, 57, 58, 59, 60, 61, -1, -1,
3198 -1, -1, -1, -1, -1, 0, 1, 2, 3, 4,
3199 5, 6, 7, 8, 9, 10, 11, 12, 13, 14,
3200 15, 16, 17, 18, 19, 20, 21, 22, 23, 24,
3201 25, -1, -1, -1, -1, -1, -1, 26, 27, 28,
3202 29, 30, 31, 32, 33, 34, 35, 36, 37, 38,
3203 39, 40, 41, 42, 43, 44, 45, 46, 47, 48,
3204 49, 50, 51, -1, -1, -1, -1, -1
3205 };
3206
3207 3208 3209 3210 3211 3212 3213 3214 3215 3216 3217 3218 3219 3220 3221 3222 3223
3224
3225
3226 static int base64_encode_1 P_ ((const char *, char *, int, int, int));
3227 static int base64_decode_1 P_ ((const char *, char *, int, int, int *));
3228
3229 DEFUN ("base64-encode-region", Fbase64_encode_region, Sbase64_encode_region,
3230 2, 3, "r",
3231 doc: 3232 3233 3234 )
3235 (beg, end, no_line_break)
3236 Lisp_Object beg, end, no_line_break;
3237 {
3238 char *encoded;
3239 int allength, length;
3240 int ibeg, iend, encoded_length;
3241 int old_pos = PT;
3242 USE_SAFE_ALLOCA;
3243
3244 validate_region (&beg, &end);
3245
3246 ibeg = CHAR_TO_BYTE (XFASTINT (beg));
3247 iend = CHAR_TO_BYTE (XFASTINT (end));
3248 move_gap_both (XFASTINT (beg), ibeg);
3249
3250 3251 3252
3253 length = iend - ibeg;
3254 allength = length + length/3 + 1;
3255 allength += allength / MIME_LINE_LENGTH + 1 + 6;
3256
3257 SAFE_ALLOCA (encoded, char *, allength);
3258 encoded_length = base64_encode_1 (BYTE_POS_ADDR (ibeg), encoded, length,
3259 NILP (no_line_break),
3260 !NILP (current_buffer->enable_multibyte_characters));
3261 if (encoded_length > allength)
3262 abort ();
3263
3264 if (encoded_length < 0)
3265 {
3266
3267 SAFE_FREE ();
3268 error ("Multibyte character in data for base64 encoding");
3269 }
3270
3271 3272
3273 SET_PT_BOTH (XFASTINT (beg), ibeg);
3274 insert (encoded, encoded_length);
3275 SAFE_FREE ();
3276 del_range_byte (ibeg + encoded_length, iend + encoded_length, 1);
3277
3278 3279
3280 if (old_pos >= XFASTINT (end))
3281 old_pos += encoded_length - (XFASTINT (end) - XFASTINT (beg));
3282 else if (old_pos > XFASTINT (beg))
3283 old_pos = XFASTINT (beg);
3284 SET_PT (old_pos);
3285
3286
3287 return make_number (encoded_length);
3288 }
3289
3290 DEFUN ("base64-encode-string", Fbase64_encode_string, Sbase64_encode_string,
3291 1, 2, 0,
3292 doc: 3293 3294 )
3295 (string, no_line_break)
3296 Lisp_Object string, no_line_break;
3297 {
3298 int allength, length, encoded_length;
3299 char *encoded;
3300 Lisp_Object encoded_string;
3301 USE_SAFE_ALLOCA;
3302
3303 CHECK_STRING (string);
3304
3305 3306 3307
3308 length = SBYTES (string);
3309 allength = length + length/3 + 1;
3310 allength += allength / MIME_LINE_LENGTH + 1 + 6;
3311
3312
3313 SAFE_ALLOCA (encoded, char *, allength);
3314
3315 encoded_length = base64_encode_1 (SDATA (string),
3316 encoded, length, NILP (no_line_break),
3317 STRING_MULTIBYTE (string));
3318 if (encoded_length > allength)
3319 abort ();
3320
3321 if (encoded_length < 0)
3322 {
3323
3324 SAFE_FREE ();
3325 error ("Multibyte character in data for base64 encoding");
3326 }
3327
3328 encoded_string = make_unibyte_string (encoded, encoded_length);
3329 SAFE_FREE ();
3330
3331 return encoded_string;
3332 }
3333
3334 static int
3335 base64_encode_1 (from, to, length, line_break, multibyte)
3336 const char *from;
3337 char *to;
3338 int length;
3339 int line_break;
3340 int multibyte;
3341 {
3342 int counter = 0, i = 0;
3343 char *e = to;
3344 int c;
3345 unsigned int value;
3346 int bytes;
3347
3348 while (i < length)
3349 {
3350 if (multibyte)
3351 {
3352 c = STRING_CHAR_AND_LENGTH (from + i, bytes);
3353 if (CHAR_BYTE8_P (c))
3354 c = CHAR_TO_BYTE8 (c);
3355 else if (c >= 256)
3356 return -1;
3357 i += bytes;
3358 }
3359 else
3360 c = from[i++];
3361
3362
3363
3364 if (line_break)
3365 {
3366 if (counter < MIME_LINE_LENGTH / 4)
3367 counter++;
3368 else
3369 {
3370 *e++ = '\n';
3371 counter = 1;
3372 }
3373 }
3374
3375
3376
3377 *e++ = base64_value_to_char[0x3f & c >> 2];
3378 value = (0x03 & c) << 4;
3379
3380
3381
3382 if (i == length)
3383 {
3384 *e++ = base64_value_to_char[value];
3385 *e++ = '=';
3386 *e++ = '=';
3387 break;
3388 }
3389
3390 if (multibyte)
3391 {
3392 c = STRING_CHAR_AND_LENGTH (from + i, bytes);
3393 if (CHAR_BYTE8_P (c))
3394 c = CHAR_TO_BYTE8 (c);
3395 else if (c >= 256)
3396 return -1;
3397 i += bytes;
3398 }
3399 else
3400 c = from[i++];
3401
3402 *e++ = base64_value_to_char[value | (0x0f & c >> 4)];
3403 value = (0x0f & c) << 2;
3404
3405
3406
3407 if (i == length)
3408 {
3409 *e++ = base64_value_to_char[value];
3410 *e++ = '=';
3411 break;
3412 }
3413
3414 if (multibyte)
3415 {
3416 c = STRING_CHAR_AND_LENGTH (from + i, bytes);
3417 if (CHAR_BYTE8_P (c))
3418 c = CHAR_TO_BYTE8 (c);
3419 else if (c >= 256)
3420 return -1;
3421 i += bytes;
3422 }
3423 else
3424 c = from[i++];
3425
3426 *e++ = base64_value_to_char[value | (0x03 & c >> 6)];
3427 *e++ = base64_value_to_char[0x3f & c];
3428 }
3429
3430 return e - to;
3431 }
3432
3433
3434 DEFUN ("base64-decode-region", Fbase64_decode_region, Sbase64_decode_region,
3435 2, 2, "r",
3436 doc: 3437 3438 )
3439 (beg, end)
3440 Lisp_Object beg, end;
3441 {
3442 int ibeg, iend, length, allength;
3443 char *decoded;
3444 int old_pos = PT;
3445 int decoded_length;
3446 int inserted_chars;
3447 int multibyte = !NILP (current_buffer->enable_multibyte_characters);
3448 USE_SAFE_ALLOCA;
3449
3450 validate_region (&beg, &end);
3451
3452 ibeg = CHAR_TO_BYTE (XFASTINT (beg));
3453 iend = CHAR_TO_BYTE (XFASTINT (end));
3454
3455 length = iend - ibeg;
3456
3457 3458 3459
3460 allength = multibyte ? length * 2 : length;
3461 SAFE_ALLOCA (decoded, char *, allength);
3462
3463 move_gap_both (XFASTINT (beg), ibeg);
3464 decoded_length = base64_decode_1 (BYTE_POS_ADDR (ibeg), decoded, length,
3465 multibyte, &inserted_chars);
3466 if (decoded_length > allength)
3467 abort ();
3468
3469 if (decoded_length < 0)
3470 {
3471
3472 SAFE_FREE ();
3473 error ("Invalid base64 data");
3474 }
3475
3476 3477
3478 TEMP_SET_PT_BOTH (XFASTINT (beg), ibeg);
3479 insert_1_both (decoded, inserted_chars, decoded_length, 0, 1, 0);
3480 SAFE_FREE ();
3481
3482
3483 del_range_both (PT, PT_BYTE, XFASTINT (end) + inserted_chars,
3484 iend + decoded_length, 1);
3485
3486 3487
3488 if (old_pos >= XFASTINT (end))
3489 old_pos += inserted_chars - (XFASTINT (end) - XFASTINT (beg));
3490 else if (old_pos > XFASTINT (beg))
3491 old_pos = XFASTINT (beg);
3492 SET_PT (old_pos > ZV ? ZV : old_pos);
3493
3494 return make_number (inserted_chars);
3495 }
3496
3497 DEFUN ("base64-decode-string", Fbase64_decode_string, Sbase64_decode_string,
3498 1, 1, 0,
3499 doc: )
3500 (string)
3501 Lisp_Object string;
3502 {
3503 char *decoded;
3504 int length, decoded_length;
3505 Lisp_Object decoded_string;
3506 USE_SAFE_ALLOCA;
3507
3508 CHECK_STRING (string);
3509
3510 length = SBYTES (string);
3511
3512 SAFE_ALLOCA (decoded, char *, length);
3513
3514
3515 decoded_length = base64_decode_1 (SDATA (string), decoded, length,
3516 0, NULL);
3517 if (decoded_length > length)
3518 abort ();
3519 else if (decoded_length >= 0)
3520 decoded_string = make_unibyte_string (decoded, decoded_length);
3521 else
3522 decoded_string = Qnil;
3523
3524 SAFE_FREE ();
3525 if (!STRINGP (decoded_string))
3526 error ("Invalid base64 data");
3527
3528 return decoded_string;
3529 }
3530
3531 3532 3533 3534
3535
3536 static int
3537 base64_decode_1 (from, to, length, multibyte, nchars_return)
3538 const char *from;
3539 char *to;
3540 int length;
3541 int multibyte;
3542 int *nchars_return;
3543 {
3544 int i = 0;
3545 char *e = to;
3546 unsigned char c;
3547 unsigned long value;
3548 int nchars = 0;
3549
3550 while (1)
3551 {
3552
3553
3554 READ_QUADRUPLET_BYTE (e-to);
3555
3556 if (!IS_BASE64 (c))
3557 return -1;
3558 value = base64_char_to_value[c] << 18;
3559
3560
3561
3562 READ_QUADRUPLET_BYTE (-1);
3563
3564 if (!IS_BASE64 (c))
3565 return -1;
3566 value |= base64_char_to_value[c] << 12;
3567
3568 c = (unsigned char) (value >> 16);
3569 if (multibyte && c >= 128)
3570 e += BYTE8_STRING (c, e);
3571 else
3572 *e++ = c;
3573 nchars++;
3574
3575
3576
3577 READ_QUADRUPLET_BYTE (-1);
3578
3579 if (c == '=')
3580 {
3581 READ_QUADRUPLET_BYTE (-1);
3582
3583 if (c != '=')
3584 return -1;
3585 continue;
3586 }
3587
3588 if (!IS_BASE64 (c))
3589 return -1;
3590 value |= base64_char_to_value[c] << 6;
3591
3592 c = (unsigned char) (0xff & value >> 8);
3593 if (multibyte && c >= 128)
3594 e += BYTE8_STRING (c, e);
3595 else
3596 *e++ = c;
3597 nchars++;
3598
3599
3600
3601 READ_QUADRUPLET_BYTE (-1);
3602
3603 if (c == '=')
3604 continue;
3605
3606 if (!IS_BASE64 (c))
3607 return -1;
3608 value |= base64_char_to_value[c];
3609
3610 c = (unsigned char) (0xff & value);
3611 if (multibyte && c >= 128)
3612 e += BYTE8_STRING (c, e);
3613 else
3614 *e++ = c;
3615 nchars++;
3616 }
3617 }
3618
3619
3620
3621 3622 3623 3624 3625
3626
3627 3628
3629
3630 3631 3632 3633 3634 3635 3636 3637 3638 3639
3640
3641
3642
3643
3644 struct Lisp_Hash_Table *weak_hash_tables;
3645
3646
3647
3648 Lisp_Object Qhash_table_p, Qeq, Qeql, Qequal, Qkey, Qvalue;
3649 Lisp_Object QCtest, QCsize, QCrehash_size, QCrehash_threshold, QCweakness;
3650 Lisp_Object Qhash_table_test, Qkey_or_value, Qkey_and_value;
3651
3652
3653
3654 static struct Lisp_Hash_Table *check_hash_table P_ ((Lisp_Object));
3655 static int get_key_arg P_ ((Lisp_Object, int, Lisp_Object *, char *));
3656 static void maybe_resize_hash_table P_ ((struct Lisp_Hash_Table *));
3657 static int cmpfn_eql P_ ((struct Lisp_Hash_Table *, Lisp_Object, unsigned,
3658 Lisp_Object, unsigned));
3659 static int cmpfn_equal P_ ((struct Lisp_Hash_Table *, Lisp_Object, unsigned,
3660 Lisp_Object, unsigned));
3661 static int cmpfn_user_defined P_ ((struct Lisp_Hash_Table *, Lisp_Object,
3662 unsigned, Lisp_Object, unsigned));
3663 static unsigned hashfn_eq P_ ((struct Lisp_Hash_Table *, Lisp_Object));
3664 static unsigned hashfn_eql P_ ((struct Lisp_Hash_Table *, Lisp_Object));
3665 static unsigned hashfn_equal P_ ((struct Lisp_Hash_Table *, Lisp_Object));
3666 static unsigned hashfn_user_defined P_ ((struct Lisp_Hash_Table *,
3667 Lisp_Object));
3668 static unsigned sxhash_string P_ ((unsigned char *, int));
3669 static unsigned sxhash_list P_ ((Lisp_Object, int));
3670 static unsigned sxhash_vector P_ ((Lisp_Object, int));
3671 static unsigned sxhash_bool_vector P_ ((Lisp_Object));
3672 static int sweep_weak_table P_ ((struct Lisp_Hash_Table *, int));
3673
3674
3675
3676 3677 3678
3679
3680 3681
3682
3683 static struct Lisp_Hash_Table *
3684 check_hash_table (obj)
3685 Lisp_Object obj;
3686 {
3687 CHECK_HASH_TABLE (obj);
3688 return XHASH_TABLE (obj);
3689 }
3690
3691
3692 3693
3694
3695 int
3696 next_almost_prime (n)
3697 int n;
3698 {
3699 if (n % 2 == 0)
3700 n += 1;
3701 if (n % 3 == 0)
3702 n += 2;
3703 if (n % 7 == 0)
3704 n += 4;
3705 return n;
3706 }
3707
3708
3709 3710 3711 3712 3713
3714
3715 static int
3716 get_key_arg (key, nargs, args, used)
3717 Lisp_Object key;
3718 int nargs;
3719 Lisp_Object *args;
3720 char *used;
3721 {
3722 int i;
3723
3724 for (i = 0; i < nargs - 1; ++i)
3725 if (!used[i] && EQ (args[i], key))
3726 break;
3727
3728 if (i >= nargs - 1)
3729 i = -1;
3730 else
3731 {
3732 used[i++] = 1;
3733 used[i] = 1;
3734 }
3735
3736 return i;
3737 }
3738
3739
3740 3741 3742
3743
3744 Lisp_Object
3745 larger_vector (vec, new_size, init)
3746 Lisp_Object vec;
3747 int new_size;
3748 Lisp_Object init;
3749 {
3750 struct Lisp_Vector *v;
3751 int i, old_size;
3752
3753 xassert (VECTORP (vec));
3754 old_size = ASIZE (vec);
3755 xassert (new_size >= old_size);
3756
3757 v = allocate_vector (new_size);
3758 bcopy (XVECTOR (vec)->contents, v->contents,
3759 old_size * sizeof *v->contents);
3760 for (i = old_size; i < new_size; ++i)
3761 v->contents[i] = init;
3762 XSETVECTOR (vec, v);
3763 return vec;
3764 }
3765
3766
3767 3768 3769
3770
3771 3772 3773
3774
3775 static int
3776 cmpfn_eql (h, key1, hash1, key2, hash2)
3777 struct Lisp_Hash_Table *h;
3778 Lisp_Object key1, key2;
3779 unsigned hash1, hash2;
3780 {
3781 return (FLOATP (key1)
3782 && FLOATP (key2)
3783 && XFLOAT_DATA (key1) == XFLOAT_DATA (key2));
3784 }
3785
3786
3787 3788 3789
3790
3791 static int
3792 cmpfn_equal (h, key1, hash1, key2, hash2)
3793 struct Lisp_Hash_Table *h;
3794 Lisp_Object key1, key2;
3795 unsigned hash1, hash2;
3796 {
3797 return hash1 == hash2 && !NILP (Fequal (key1, key2));
3798 }
3799
3800
3801 3802 3803
3804
3805 static int
3806 cmpfn_user_defined (h, key1, hash1, key2, hash2)
3807 struct Lisp_Hash_Table *h;
3808 Lisp_Object key1, key2;
3809 unsigned hash1, hash2;
3810 {
3811 if (hash1 == hash2)
3812 {
3813 Lisp_Object args[3];
3814
3815 args[0] = h->user_cmp_function;
3816 args[1] = key1;
3817 args[2] = key2;
3818 return !NILP (Ffuncall (3, args));
3819 }
3820 else
3821 return 0;
3822 }
3823
3824
3825 3826 3827
3828
3829 static unsigned
3830 hashfn_eq (h, key)
3831 struct Lisp_Hash_Table *h;
3832 Lisp_Object key;
3833 {
3834 unsigned hash = XUINT (key) ^ XTYPE (key);
3835 xassert ((hash & ~INTMASK) == 0);
3836 return hash;
3837 }
3838
3839
3840 3841 3842
3843
3844 static unsigned
3845 hashfn_eql (h, key)
3846 struct Lisp_Hash_Table *h;
3847 Lisp_Object key;
3848 {
3849 unsigned hash;
3850 if (FLOATP (key))
3851 hash = sxhash (key, 0);
3852 else
3853 hash = XUINT (key) ^ XTYPE (key);
3854 xassert ((hash & ~INTMASK) == 0);
3855 return hash;
3856 }
3857
3858
3859 3860 3861
3862
3863 static unsigned
3864 hashfn_equal (h, key)
3865 struct Lisp_Hash_Table *h;
3866 Lisp_Object key;
3867 {
3868 unsigned hash = sxhash (key, 0);
3869 xassert ((hash & ~INTMASK) == 0);
3870 return hash;
3871 }
3872
3873
3874 3875 3876
3877
3878 static unsigned
3879 hashfn_user_defined (h, key)
3880 struct Lisp_Hash_Table *h;
3881 Lisp_Object key;
3882 {
3883 Lisp_Object args[2], hash;
3884
3885 args[0] = h->user_hash_function;
3886 args[1] = key;
3887 hash = Ffuncall (2, args);
3888 if (!INTEGERP (hash))
3889 signal_error ("Invalid hash code returned from user-supplied hash function", hash);
3890 return XUINT (hash);
3891 }
3892
3893
3894 3895 3896 3897 3898 3899 3900 3901 3902 3903 3904 3905 3906 3907 3908 3909 3910 3911 3912 3913 3914
3915
3916 Lisp_Object
3917 make_hash_table (test, size, rehash_size, rehash_threshold, weak,
3918 user_test, user_hash)
3919 Lisp_Object test, size, rehash_size, rehash_threshold, weak;
3920 Lisp_Object user_test, user_hash;
3921 {
3922 struct Lisp_Hash_Table *h;
3923 Lisp_Object table;
3924 int index_size, i, sz;
3925
3926
3927 xassert (SYMBOLP (test));
3928 xassert (INTEGERP (size) && XINT (size) >= 0);
3929 xassert ((INTEGERP (rehash_size) && XINT (rehash_size) > 0)
3930 || (FLOATP (rehash_size) && XFLOATINT (rehash_size) > 1.0));
3931 xassert (FLOATP (rehash_threshold)
3932 && XFLOATINT (rehash_threshold) > 0
3933 && XFLOATINT (rehash_threshold) <= 1.0);
3934
3935 if (XFASTINT (size) == 0)
3936 size = make_number (1);
3937
3938
3939 h = allocate_hash_table ();
3940
3941
3942 sz = XFASTINT (size);
3943
3944 h->test = test;
3945 if (EQ (test, Qeql))
3946 {
3947 h->cmpfn = cmpfn_eql;
3948 h->hashfn = hashfn_eql;
3949 }
3950 else if (EQ (test, Qeq))
3951 {
3952 h->cmpfn = NULL;
3953 h->hashfn = hashfn_eq;
3954 }
3955 else if (EQ (test, Qequal))
3956 {
3957 h->cmpfn = cmpfn_equal;
3958 h->hashfn = hashfn_equal;
3959 }
3960 else
3961 {
3962 h->user_cmp_function = user_test;
3963 h->user_hash_function = user_hash;
3964 h->cmpfn = cmpfn_user_defined;
3965 h->hashfn = hashfn_user_defined;
3966 }
3967
3968 h->weak = weak;
3969 h->rehash_threshold = rehash_threshold;
3970 h->rehash_size = rehash_size;
3971 h->count = 0;
3972 h->key_and_value = Fmake_vector (make_number (2 * sz), Qnil);
3973 h->hash = Fmake_vector (size, Qnil);
3974 h->next = Fmake_vector (size, Qnil);
3975
3976 index_size = next_almost_prime ((int) (sz / XFLOATINT (rehash_threshold)));
3977 h->index = Fmake_vector (make_number (index_size), Qnil);
3978
3979
3980 for (i = 0; i < sz - 1; ++i)
3981 HASH_NEXT (h, i) = make_number (i + 1);
3982 h->next_free = make_number (0);
3983
3984 XSET_HASH_TABLE (table, h);
3985 xassert (HASH_TABLE_P (table));
3986 xassert (XHASH_TABLE (table) == h);
3987
3988
3989 if (NILP (h->weak))
3990 h->next_weak = NULL;
3991 else
3992 {
3993 h->next_weak = weak_hash_tables;
3994 weak_hash_tables = h;
3995 }
3996
3997 return table;
3998 }
3999
4000
4001 4002
4003
4004 Lisp_Object
4005 copy_hash_table (h1)
4006 struct Lisp_Hash_Table *h1;
4007 {
4008 Lisp_Object table;
4009 struct Lisp_Hash_Table *h2;
4010 struct Lisp_Vector *next;
4011
4012 h2 = allocate_hash_table ();
4013 next = h2->vec_next;
4014 bcopy (h1, h2, sizeof *h2);
4015 h2->vec_next = next;
4016 h2->key_and_value = Fcopy_sequence (h1->key_and_value);
4017 h2->hash = Fcopy_sequence (h1->hash);
4018 h2->next = Fcopy_sequence (h1->next);
4019 h2->index = Fcopy_sequence (h1->index);
4020 XSET_HASH_TABLE (table, h2);
4021
4022
4023 if (!NILP (h2->weak))
4024 {
4025 h2->next_weak = weak_hash_tables;
4026 weak_hash_tables = h2;
4027 }
4028
4029 return table;
4030 }
4031
4032
4033 4034
4035
4036 static INLINE void
4037 maybe_resize_hash_table (h)
4038 struct Lisp_Hash_Table *h;
4039 {
4040 if (NILP (h->next_free))
4041 {
4042 int old_size = HASH_TABLE_SIZE (h);
4043 int i, new_size, index_size;
4044 EMACS_INT nsize;
4045
4046 if (INTEGERP (h->rehash_size))
4047 new_size = old_size + XFASTINT (h->rehash_size);
4048 else
4049 new_size = old_size * XFLOATINT (h->rehash_size);
4050 new_size = max (old_size + 1, new_size);
4051 index_size = next_almost_prime ((int)
4052 (new_size
4053 / XFLOATINT (h->rehash_threshold)));
4054 4055
4056 nsize = max (index_size, 2 * new_size);
4057 if (nsize > MOST_POSITIVE_FIXNUM)
4058 error ("Hash table too large to resize");
4059
4060 h->key_and_value = larger_vector (h->key_and_value, 2 * new_size, Qnil);
4061 h->next = larger_vector (h->next, new_size, Qnil);
4062 h->hash = larger_vector (h->hash, new_size, Qnil);
4063 h->index = Fmake_vector (make_number (index_size), Qnil);
4064
4065 4066 4067
4068 for (i = old_size; i < new_size - 1; ++i)
4069 HASH_NEXT (h, i) = make_number (i + 1);
4070
4071 if (!NILP (h->next_free))
4072 {
4073 Lisp_Object last, next;
4074
4075 last = h->next_free;
4076 while (next = HASH_NEXT (h, XFASTINT (last)),
4077 !NILP (next))
4078 last = next;
4079
4080 HASH_NEXT (h, XFASTINT (last)) = make_number (old_size);
4081 }
4082 else
4083 XSETFASTINT (h->next_free, old_size);
4084
4085
4086 for (i = 0; i < old_size; ++i)
4087 if (!NILP (HASH_HASH (h, i)))
4088 {
4089 unsigned hash_code = XUINT (HASH_HASH (h, i));
4090 int start_of_bucket = hash_code % ASIZE (h->index);
4091 HASH_NEXT (h, i) = HASH_INDEX (h, start_of_bucket);
4092 HASH_INDEX (h, start_of_bucket) = make_number (i);
4093 }
4094 }
4095 }
4096
4097
4098 4099 4100
4101
4102 int
4103 hash_lookup (h, key, hash)
4104 struct Lisp_Hash_Table *h;
4105 Lisp_Object key;
4106 unsigned *hash;
4107 {
4108 unsigned hash_code;
4109 int start_of_bucket;
4110 Lisp_Object idx;
4111
4112 hash_code = h->hashfn (h, key);
4113 if (hash)
4114 *hash = hash_code;
4115
4116 start_of_bucket = hash_code % ASIZE (h->index);
4117 idx = HASH_INDEX (h, start_of_bucket);
4118
4119
4120 while (!NILP (idx))
4121 {
4122 int i = XFASTINT (idx);
4123 if (EQ (key, HASH_KEY (h, i))
4124 || (h->cmpfn
4125 && h->cmpfn (h, key, hash_code,
4126 HASH_KEY (h, i), XUINT (HASH_HASH (h, i)))))
4127 break;
4128 idx = HASH_NEXT (h, i);
4129 }
4130
4131 return NILP (idx) ? -1 : XFASTINT (idx);
4132 }
4133
4134
4135 4136 4137
4138
4139 int
4140 hash_put (h, key, value, hash)
4141 struct Lisp_Hash_Table *h;
4142 Lisp_Object key, value;
4143 unsigned hash;
4144 {
4145 int start_of_bucket, i;
4146
4147 xassert ((hash & ~INTMASK) == 0);
4148
4149
4150 maybe_resize_hash_table (h);
4151 h->count++;
4152
4153
4154 i = XFASTINT (h->next_free);
4155 h->next_free = HASH_NEXT (h, i);
4156 HASH_KEY (h, i) = key;
4157 HASH_VALUE (h, i) = value;
4158
4159
4160 HASH_HASH (h, i) = make_number (hash);
4161
4162
4163 start_of_bucket = hash % ASIZE (h->index);
4164 HASH_NEXT (h, i) = HASH_INDEX (h, start_of_bucket);
4165 HASH_INDEX (h, start_of_bucket) = make_number (i);
4166 return i;
4167 }
4168
4169
4170
4171
4172 static void
4173 hash_remove_from_table (h, key)
4174 struct Lisp_Hash_Table *h;
4175 Lisp_Object key;
4176 {
4177 unsigned hash_code;
4178 int start_of_bucket;
4179 Lisp_Object idx, prev;
4180
4181 hash_code = h->hashfn (h, key);
4182 start_of_bucket = hash_code % ASIZE (h->index);
4183 idx = HASH_INDEX (h, start_of_bucket);
4184 prev = Qnil;
4185
4186
4187 while (!NILP (idx))
4188 {
4189 int i = XFASTINT (idx);
4190
4191 if (EQ (key, HASH_KEY (h, i))
4192 || (h->cmpfn
4193 && h->cmpfn (h, key, hash_code,
4194 HASH_KEY (h, i), XUINT (HASH_HASH (h, i)))))
4195 {
4196
4197 if (NILP (prev))
4198 HASH_INDEX (h, start_of_bucket) = HASH_NEXT (h, i);
4199 else
4200 HASH_NEXT (h, XFASTINT (prev)) = HASH_NEXT (h, i);
4201
4202 4203
4204 HASH_KEY (h, i) = HASH_VALUE (h, i) = HASH_HASH (h, i) = Qnil;
4205 HASH_NEXT (h, i) = h->next_free;
4206 h->next_free = make_number (i);
4207 h->count--;
4208 xassert (h->count >= 0);
4209 break;
4210 }
4211 else
4212 {
4213 prev = idx;
4214 idx = HASH_NEXT (h, i);
4215 }
4216 }
4217 }
4218
4219
4220
4221
4222 void
4223 hash_clear (h)
4224 struct Lisp_Hash_Table *h;
4225 {
4226 if (h->count > 0)
4227 {
4228 int i, size = HASH_TABLE_SIZE (h);
4229
4230 for (i = 0; i < size; ++i)
4231 {
4232 HASH_NEXT (h, i) = i < size - 1 ? make_number (i + 1) : Qnil;
4233 HASH_KEY (h, i) = Qnil;
4234 HASH_VALUE (h, i) = Qnil;
4235 HASH_HASH (h, i) = Qnil;
4236 }
4237
4238 for (i = 0; i < ASIZE (h->index); ++i)
4239 ASET (h->index, i, Qnil);
4240
4241 h->next_free = make_number (0);
4242 h->count = 0;
4243 }
4244 }
4245
4246
4247
4248 4249 4250
4251
4252 void
4253 init_weak_hash_tables ()
4254 {
4255 weak_hash_tables = NULL;
4256 }
4257
4258 4259 4260 4261
4262
4263 static int
4264 sweep_weak_table (h, remove_entries_p)
4265 struct Lisp_Hash_Table *h;
4266 int remove_entries_p;
4267 {
4268 int bucket, n, marked;
4269
4270 n = ASIZE (h->index) & ~ARRAY_MARK_FLAG;
4271 marked = 0;
4272
4273 for (bucket = 0; bucket < n; ++bucket)
4274 {
4275 Lisp_Object idx, next, prev;
4276
4277 4278
4279 prev = Qnil;
4280 for (idx = HASH_INDEX (h, bucket); !NILP (idx); idx = next)
4281 {
4282 int i = XFASTINT (idx);
4283 int key_known_to_survive_p = survives_gc_p (HASH_KEY (h, i));
4284 int value_known_to_survive_p = survives_gc_p (HASH_VALUE (h, i));
4285 int remove_p;
4286
4287 if (EQ (h->weak, Qkey))
4288 remove_p = !key_known_to_survive_p;
4289 else if (EQ (h->weak, Qvalue))
4290 remove_p = !value_known_to_survive_p;
4291 else if (EQ (h->weak, Qkey_or_value))
4292 remove_p = !(key_known_to_survive_p || value_known_to_survive_p);
4293 else if (EQ (h->weak, Qkey_and_value))
4294 remove_p = !(key_known_to_survive_p && value_known_to_survive_p);
4295 else
4296 abort ();
4297
4298 next = HASH_NEXT (h, i);
4299
4300 if (remove_entries_p)
4301 {
4302 if (remove_p)
4303 {
4304
4305 if (NILP (prev))
4306 HASH_INDEX (h, bucket) = next;
4307 else
4308 HASH_NEXT (h, XFASTINT (prev)) = next;
4309
4310
4311 HASH_NEXT (h, i) = h->next_free;
4312 h->next_free = idx;
4313
4314
4315 HASH_KEY (h, i) = HASH_VALUE (h, i) = Qnil;
4316 HASH_HASH (h, i) = Qnil;
4317
4318 h->count--;
4319 }
4320 else
4321 {
4322 prev = idx;
4323 }
4324 }
4325 else
4326 {
4327 if (!remove_p)
4328 {
4329
4330 if (!key_known_to_survive_p)
4331 {
4332 mark_object (HASH_KEY (h, i));
4333 marked = 1;
4334 }
4335
4336 if (!value_known_to_survive_p)
4337 {
4338 mark_object (HASH_VALUE (h, i));
4339 marked = 1;
4340 }
4341 }
4342 }
4343 }
4344 }
4345
4346 return marked;
4347 }
4348
4349 4350 4351
4352
4353 void
4354 sweep_weak_hash_tables ()
4355 {
4356 struct Lisp_Hash_Table *h, *used, *next;
4357 int marked;
4358
4359 4360 4361 4362 4363 4364
4365 do
4366 {
4367 marked = 0;
4368 for (h = weak_hash_tables; h; h = h->next_weak)
4369 {
4370 if (h->size & ARRAY_MARK_FLAG)
4371 marked |= sweep_weak_table (h, 0);
4372 }
4373 }
4374 while (marked);
4375
4376
4377 for (h = weak_hash_tables, used = NULL; h; h = next)
4378 {
4379 next = h->next_weak;
4380
4381 if (h->size & ARRAY_MARK_FLAG)
4382 {
4383
4384 if (h->count > 0)
4385 sweep_weak_table (h, 1);
4386
4387
4388 h->next_weak = used;
4389 used = h;
4390 }
4391 }
4392
4393 weak_hash_tables = used;
4394 }
4395
4396
4397
4398 4399 4400
4401
4402
4403
4404 #define SXHASH_MAX_DEPTH 3
4405
4406 4407
4408
4409 #define SXHASH_MAX_LEN 7
4410
4411
4412
4413 #define SXHASH_COMBINE(X, Y) \
4414 ((((unsigned)(X) << 4) + (((unsigned)(X) >> 24) & 0x0fffffff)) \
4415 + (unsigned)(Y))
4416
4417
4418 4419
4420
4421 static unsigned
4422 sxhash_string (ptr, len)
4423 unsigned char *ptr;
4424 int len;
4425 {
4426 unsigned char *p = ptr;
4427 unsigned char *end = p + len;
4428 unsigned char c;
4429 unsigned hash = 0;
4430
4431 while (p != end)
4432 {
4433 c = *p++;
4434 if (c >= 0140)
4435 c -= 40;
4436 hash = ((hash << 4) + (hash >> 28) + c);
4437 }
4438
4439 return hash & INTMASK;
4440 }
4441
4442
4443 4444
4445
4446 static unsigned
4447 sxhash_list (list, depth)
4448 Lisp_Object list;
4449 int depth;
4450 {
4451 unsigned hash = 0;
4452 int i;
4453
4454 if (depth < SXHASH_MAX_DEPTH)
4455 for (i = 0;
4456 CONSP (list) && i < SXHASH_MAX_LEN;
4457 list = XCDR (list), ++i)
4458 {
4459 unsigned hash2 = sxhash (XCAR (list), depth + 1);
4460 hash = SXHASH_COMBINE (hash, hash2);
4461 }
4462
4463 if (!NILP (list))
4464 {
4465 unsigned hash2 = sxhash (list, depth + 1);
4466 hash = SXHASH_COMBINE (hash, hash2);
4467 }
4468
4469 return hash;
4470 }
4471
4472
4473 4474
4475
4476 static unsigned
4477 sxhash_vector (vec, depth)
4478 Lisp_Object vec;
4479 int depth;
4480 {
4481 unsigned hash = ASIZE (vec);
4482 int i, n;
4483
4484 n = min (SXHASH_MAX_LEN, ASIZE (vec));
4485 for (i = 0; i < n; ++i)
4486 {
4487 unsigned hash2 = sxhash (AREF (vec, i), depth + 1);
4488 hash = SXHASH_COMBINE (hash, hash2);
4489 }
4490
4491 return hash;
4492 }
4493
4494
4495
4496
4497 static unsigned
4498 sxhash_bool_vector (vec)
4499 Lisp_Object vec;
4500 {
4501 unsigned hash = XBOOL_VECTOR (vec)->size;
4502 int i, n;
4503
4504 n = min (SXHASH_MAX_LEN, XBOOL_VECTOR (vec)->vector_size);
4505 for (i = 0; i < n; ++i)
4506 hash = SXHASH_COMBINE (hash, XBOOL_VECTOR (vec)->data[i]);
4507
4508 return hash;
4509 }
4510
4511
4512 4513
4514
4515 unsigned
4516 sxhash (obj, depth)
4517 Lisp_Object obj;
4518 int depth;
4519 {
4520 unsigned hash;
4521
4522 if (depth > SXHASH_MAX_DEPTH)
4523 return 0;
4524
4525 switch (XTYPE (obj))
4526 {
4527 case_Lisp_Int:
4528 hash = XUINT (obj);
4529 break;
4530
4531 case Lisp_Misc:
4532 hash = XUINT (obj);
4533 break;
4534
4535 case Lisp_Symbol:
4536 obj = SYMBOL_NAME (obj);
4537
4538
4539 case Lisp_String:
4540 hash = sxhash_string (SDATA (obj), SCHARS (obj));
4541 break;
4542
4543
4544 case Lisp_Vectorlike:
4545 if (VECTORP (obj))
4546 4547 4548 4549
4550 hash = sxhash_vector (obj, depth);
4551 else if (BOOL_VECTOR_P (obj))
4552 hash = sxhash_bool_vector (obj);
4553 else
4554 4555
4556 hash = XUINT (obj);
4557 break;
4558
4559 case Lisp_Cons:
4560 hash = sxhash_list (obj, depth);
4561 break;
4562
4563 case Lisp_Float:
4564 {
4565 double val = XFLOAT_DATA (obj);
4566 unsigned char *p = (unsigned char *) &val;
4567 unsigned char *e = p + sizeof val;
4568 for (hash = 0; p < e; ++p)
4569 hash = SXHASH_COMBINE (hash, *p);
4570 break;
4571 }
4572
4573 default:
4574 abort ();
4575 }
4576
4577 return hash & INTMASK;
4578 }
4579
4580
4581
4582 4583 4584
4585
4586
4587 DEFUN ("sxhash", Fsxhash, Ssxhash, 1, 1, 0,
4588 doc: )
4589 (obj)
4590 Lisp_Object obj;
4591 {
4592 unsigned hash = sxhash (obj, 0);
4593 return make_number (hash);
4594 }
4595
4596
4597 DEFUN ("make-hash-table", Fmake_hash_table, Smake_hash_table, 0, MANY, 0,
4598 doc: 4599 4600 4601 4602 4603 4604 4605 4606 4607 4608 4609 4610 4611 4612 4613 4614 4615 4616 4617 4618 4619 4620 4621 4622 4623 4624 4625 4626 4627 4628 )
4629 (nargs, args)
4630 int nargs;
4631 Lisp_Object *args;
4632 {
4633 Lisp_Object test, size, rehash_size, rehash_threshold, weak;
4634 Lisp_Object user_test, user_hash;
4635 char *used;
4636 int i;
4637
4638 4639
4640 used = (char *) alloca (nargs * sizeof *used);
4641 bzero (used, nargs * sizeof *used);
4642
4643
4644 i = get_key_arg (QCtest, nargs, args, used);
4645 test = i < 0 ? Qeql : args[i];
4646 if (!EQ (test, Qeq) && !EQ (test, Qeql) && !EQ (test, Qequal))
4647 {
4648
4649 Lisp_Object prop;
4650
4651 prop = Fget (test, Qhash_table_test);
4652 if (!CONSP (prop) || !CONSP (XCDR (prop)))
4653 signal_error ("Invalid hash table test", test);
4654 user_test = XCAR (prop);
4655 user_hash = XCAR (XCDR (prop));
4656 }
4657 else
4658 user_test = user_hash = Qnil;
4659
4660
4661 i = get_key_arg (QCsize, nargs, args, used);
4662 size = i < 0 ? Qnil : args[i];
4663 if (NILP (size))
4664 size = make_number (DEFAULT_HASH_SIZE);
4665 else if (!INTEGERP (size) || XINT (size) < 0)
4666 signal_error ("Invalid hash table size", size);
4667
4668
4669 i = get_key_arg (QCrehash_size, nargs, args, used);
4670 rehash_size = i < 0 ? make_float (DEFAULT_REHASH_SIZE) : args[i];
4671 if (!NUMBERP (rehash_size)
4672 || (INTEGERP (rehash_size) && XINT (rehash_size) <= 0)
4673 || XFLOATINT (rehash_size) <= 1.0)
4674 signal_error ("Invalid hash table rehash size", rehash_size);
4675
4676
4677 i = get_key_arg (QCrehash_threshold, nargs, args, used);
4678 rehash_threshold = i < 0 ? make_float (DEFAULT_REHASH_THRESHOLD) : args[i];
4679 if (!FLOATP (rehash_threshold)
4680 || XFLOATINT (rehash_threshold) <= 0.0
4681 || XFLOATINT (rehash_threshold) > 1.0)
4682 signal_error ("Invalid hash table rehash threshold", rehash_threshold);
4683
4684
4685 i = get_key_arg (QCweakness, nargs, args, used);
4686 weak = i < 0 ? Qnil : args[i];
4687 if (EQ (weak, Qt))
4688 weak = Qkey_and_value;
4689 if (!NILP (weak)
4690 && !EQ (weak, Qkey)
4691 && !EQ (weak, Qvalue)
4692 && !EQ (weak, Qkey_or_value)
4693 && !EQ (weak, Qkey_and_value))
4694 signal_error ("Invalid hash table weakness", weak);
4695
4696
4697 for (i = 0; i < nargs; ++i)
4698 if (!used[i])
4699 signal_error ("Invalid argument list", args[i]);
4700
4701 return make_hash_table (test, size, rehash_size, rehash_threshold, weak,
4702 user_test, user_hash);
4703 }
4704
4705
4706 DEFUN ("copy-hash-table", Fcopy_hash_table, Scopy_hash_table, 1, 1, 0,
4707 doc: )
4708 (table)
4709 Lisp_Object table;
4710 {
4711 return copy_hash_table (check_hash_table (table));
4712 }
4713
4714
4715 DEFUN ("hash-table-count", Fhash_table_count, Shash_table_count, 1, 1, 0,
4716 doc: )
4717 (table)
4718 Lisp_Object table;
4719 {
4720 return make_number (check_hash_table (table)->count);
4721 }
4722
4723
4724 DEFUN ("hash-table-rehash-size", Fhash_table_rehash_size,
4725 Shash_table_rehash_size, 1, 1, 0,
4726 doc: )
4727 (table)
4728 Lisp_Object table;
4729 {
4730 return check_hash_table (table)->rehash_size;
4731 }
4732
4733
4734 DEFUN ("hash-table-rehash-threshold", Fhash_table_rehash_threshold,
4735 Shash_table_rehash_threshold, 1, 1, 0,
4736 doc: )
4737 (table)
4738 Lisp_Object table;
4739 {
4740 return check_hash_table (table)->rehash_threshold;
4741 }
4742
4743
4744 DEFUN ("hash-table-size", Fhash_table_size, Shash_table_size, 1, 1, 0,
4745 doc: 4746 4747 4748 )
4749 (table)
4750 Lisp_Object table;
4751 {
4752 struct Lisp_Hash_Table *h = check_hash_table (table);
4753 return make_number (HASH_TABLE_SIZE (h));
4754 }
4755
4756
4757 DEFUN ("hash-table-test", Fhash_table_test, Shash_table_test, 1, 1, 0,
4758 doc: )
4759 (table)
4760 Lisp_Object table;
4761 {
4762 return check_hash_table (table)->test;
4763 }
4764
4765
4766 DEFUN ("hash-table-weakness", Fhash_table_weakness, Shash_table_weakness,
4767 1, 1, 0,
4768 doc: )
4769 (table)
4770 Lisp_Object table;
4771 {
4772 return check_hash_table (table)->weak;
4773 }
4774
4775
4776 DEFUN ("hash-table-p", Fhash_table_p, Shash_table_p, 1, 1, 0,
4777 doc: )
4778 (obj)
4779 Lisp_Object obj;
4780 {
4781 return HASH_TABLE_P (obj) ? Qt : Qnil;
4782 }
4783
4784
4785 DEFUN ("clrhash", Fclrhash, Sclrhash, 1, 1, 0,
4786 doc: )
4787 (table)
4788 Lisp_Object table;
4789 {
4790 hash_clear (check_hash_table (table));
4791
4792 return table;
4793 }
4794
4795
4796 DEFUN ("gethash", Fgethash, Sgethash, 2, 3, 0,
4797 doc: 4798 )
4799 (key, table, dflt)
4800 Lisp_Object key, table, dflt;
4801 {
4802 struct Lisp_Hash_Table *h = check_hash_table (table);
4803 int i = hash_lookup (h, key, NULL);
4804 return i >= 0 ? HASH_VALUE (h, i) : dflt;
4805 }
4806
4807
4808 DEFUN ("puthash", Fputhash, Sputhash, 3, 3, 0,
4809 doc: 4810 4811 )
4812 (key, value, table)
4813 Lisp_Object key, value, table;
4814 {
4815 struct Lisp_Hash_Table *h = check_hash_table (table);
4816 int i;
4817 unsigned hash;
4818
4819 i = hash_lookup (h, key, &hash);
4820 if (i >= 0)
4821 HASH_VALUE (h, i) = value;
4822 else
4823 hash_put (h, key, value, hash);
4824
4825 return value;
4826 }
4827
4828
4829 DEFUN ("remhash", Fremhash, Sremhash, 2, 2, 0,
4830 doc: )
4831 (key, table)
4832 Lisp_Object key, table;
4833 {
4834 struct Lisp_Hash_Table *h = check_hash_table (table);
4835 hash_remove_from_table (h, key);
4836 return Qnil;
4837 }
4838
4839
4840 DEFUN ("maphash", Fmaphash, Smaphash, 2, 2, 0,
4841 doc: 4842 )
4843 (function, table)
4844 Lisp_Object function, table;
4845 {
4846 struct Lisp_Hash_Table *h = check_hash_table (table);
4847 Lisp_Object args[3];
4848 int i;
4849
4850 for (i = 0; i < HASH_TABLE_SIZE (h); ++i)
4851 if (!NILP (HASH_HASH (h, i)))
4852 {
4853 args[0] = function;
4854 args[1] = HASH_KEY (h, i);
4855 args[2] = HASH_VALUE (h, i);
4856 Ffuncall (3, args);
4857 }
4858
4859 return Qnil;
4860 }
4861
4862
4863 DEFUN ("define-hash-table-test", Fdefine_hash_table_test,
4864 Sdefine_hash_table_test, 3, 3, 0,
4865 doc: 4866 4867 4868 4869 4870 4871 4872 4873 4874 )
4875 (name, test, hash)
4876 Lisp_Object name, test, hash;
4877 {
4878 return Fput (name, Qhash_table_test, list2 (test, hash));
4879 }
4880
4881
4882
4883 4884 4885
4886
4887 #include "md5.h"
4888
4889 DEFUN ("md5", Fmd5, Smd5, 1, 5, 0,
4890 doc: 4891 4892 4893 4894 4895 4896 4897 4898 4899 4900 4901 4902 4903 4904 4905 4906 4907 4908 4909 4910 4911 4912 4913 4914 4915 )
4916 (object, start, end, coding_system, noerror)
4917 Lisp_Object object, start, end, coding_system, noerror;
4918 {
4919 unsigned char digest[16];
4920 unsigned char value[33];
4921 int i;
4922 int size;
4923 int size_byte = 0;
4924 int start_char = 0, end_char = 0;
4925 int start_byte = 0, end_byte = 0;
4926 register int b, e;
4927 register struct buffer *bp;
4928 int temp;
4929
4930 if (STRINGP (object))
4931 {
4932 if (NILP (coding_system))
4933 {
4934
4935
4936 if (STRING_MULTIBYTE (object))
4937
4938 coding_system = preferred_coding_system ();
4939 else
4940 coding_system = Qraw_text;
4941 }
4942
4943 if (NILP (Fcoding_system_p (coding_system)))
4944 {
4945
4946
4947 if (!NILP (noerror))
4948 coding_system = Qraw_text;
4949 else
4950 xsignal1 (Qcoding_system_error, coding_system);
4951 }
4952
4953 if (STRING_MULTIBYTE (object))
4954 object = code_convert_string (object, coding_system, Qnil, 1, 0, 1);
4955
4956 size = SCHARS (object);
4957 size_byte = SBYTES (object);
4958
4959 if (!NILP (start))
4960 {
4961 CHECK_NUMBER (start);
4962
4963 start_char = XINT (start);
4964
4965 if (start_char < 0)
4966 start_char += size;
4967
4968 start_byte = string_char_to_byte (object, start_char);
4969 }
4970
4971 if (NILP (end))
4972 {
4973 end_char = size;
4974 end_byte = size_byte;
4975 }
4976 else
4977 {
4978 CHECK_NUMBER (end);
4979
4980 end_char = XINT (end);
4981
4982 if (end_char < 0)
4983 end_char += size;
4984
4985 end_byte = string_char_to_byte (object, end_char);
4986 }
4987
4988 if (!(0 <= start_char && start_char <= end_char && end_char <= size))
4989 args_out_of_range_3 (object, make_number (start_char),
4990 make_number (end_char));
4991 }
4992 else
4993 {
4994 struct buffer *prev = current_buffer;
4995
4996 record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
4997
4998 CHECK_BUFFER (object);
4999
5000 bp = XBUFFER (object);
5001 if (bp != current_buffer)
5002 set_buffer_internal (bp);
5003
5004 if (NILP (start))
5005 b = BEGV;
5006 else
5007 {
5008 CHECK_NUMBER_COERCE_MARKER (start);
5009 b = XINT (start);
5010 }
5011
5012 if (NILP (end))
5013 e = ZV;
5014 else
5015 {
5016 CHECK_NUMBER_COERCE_MARKER (end);
5017 e = XINT (end);
5018 }
5019
5020 if (b > e)
5021 temp = b, b = e, e = temp;
5022
5023 if (!(BEGV <= b && e <= ZV))
5024 args_out_of_range (start, end);
5025
5026 if (NILP (coding_system))
5027 {
5028 5029
5030
5031 if (!NILP (Vcoding_system_for_write))
5032 coding_system = Vcoding_system_for_write;
5033 else
5034 {
5035 int force_raw_text = 0;
5036
5037 coding_system = XBUFFER (object)->buffer_file_coding_system;
5038 if (NILP (coding_system)
5039 || NILP (Flocal_variable_p (Qbuffer_file_coding_system, Qnil)))
5040 {
5041 coding_system = Qnil;
5042 if (NILP (current_buffer->enable_multibyte_characters))
5043 force_raw_text = 1;
5044 }
5045
5046 if (NILP (coding_system) && !NILP (Fbuffer_file_name(object)))
5047 {
5048
5049 Lisp_Object args[4], val;
5050
5051 args[0] = Qwrite_region; args[1] = start; args[2] = end;
5052 args[3] = Fbuffer_file_name(object);
5053 val = Ffind_operation_coding_system (4, args);
5054 if (CONSP (val) && !NILP (XCDR (val)))
5055 coding_system = XCDR (val);
5056 }
5057
5058 if (NILP (coding_system)
5059 && !NILP (XBUFFER (object)->buffer_file_coding_system))
5060 {
5061 5062
5063 coding_system = XBUFFER (object)->buffer_file_coding_system;
5064 }
5065
5066 if (!force_raw_text
5067 && !NILP (Ffboundp (Vselect_safe_coding_system_function)))
5068
5069 coding_system = call4 (Vselect_safe_coding_system_function,
5070 make_number (b), make_number (e),
5071 coding_system, Qnil);
5072
5073 if (force_raw_text)
5074 coding_system = Qraw_text;
5075 }
5076
5077 if (NILP (Fcoding_system_p (coding_system)))
5078 {
5079
5080
5081 if (!NILP (noerror))
5082 coding_system = Qraw_text;
5083 else
5084 xsignal1 (Qcoding_system_error, coding_system);
5085 }
5086 }
5087
5088 object = make_buffer_string (b, e, 0);
5089 if (prev != current_buffer)
5090 set_buffer_internal (prev);
5091 5092
5093 specpdl_ptr--;
5094
5095 if (STRING_MULTIBYTE (object))
5096 object = code_convert_string (object, coding_system, Qnil, 1, 0, 0);
5097 }
5098
5099 md5_buffer (SDATA (object) + start_byte,
5100 SBYTES (object) - (size_byte - end_byte),
5101 digest);
5102
5103 for (i = 0; i < 16; i++)
5104 sprintf (&value[2 * i], "%02x", digest[i]);
5105 value[32] = '\0';
5106
5107 return make_string (value, 32);
5108 }
5109
5110
5111 void
5112 syms_of_fns ()
5113 {
5114
5115 Qhash_table_p = intern_c_string ("hash-table-p");
5116 staticpro (&Qhash_table_p);
5117 Qeq = intern_c_string ("eq");
5118 staticpro (&Qeq);
5119 Qeql = intern_c_string ("eql");
5120 staticpro (&Qeql);
5121 Qequal = intern_c_string ("equal");
5122 staticpro (&Qequal);
5123 QCtest = intern_c_string (":test");
5124 staticpro (&QCtest);
5125 QCsize = intern_c_string (":size");
5126 staticpro (&QCsize);
5127 QCrehash_size = intern_c_string (":rehash-size");
5128 staticpro (&QCrehash_size);
5129 QCrehash_threshold = intern_c_string (":rehash-threshold");
5130 staticpro (&QCrehash_threshold);
5131 QCweakness = intern_c_string (":weakness");
5132 staticpro (&QCweakness);
5133 Qkey = intern_c_string ("key");
5134 staticpro (&Qkey);
5135 Qvalue = intern_c_string ("value");
5136 staticpro (&Qvalue);
5137 Qhash_table_test = intern_c_string ("hash-table-test");
5138 staticpro (&Qhash_table_test);
5139 Qkey_or_value = intern_c_string ("key-or-value");
5140 staticpro (&Qkey_or_value);
5141 Qkey_and_value = intern_c_string ("key-and-value");
5142 staticpro (&Qkey_and_value);
5143
5144 defsubr (&Ssxhash);
5145 defsubr (&Smake_hash_table);
5146 defsubr (&Scopy_hash_table);
5147 defsubr (&Shash_table_count);
5148 defsubr (&Shash_table_rehash_size);
5149 defsubr (&Shash_table_rehash_threshold);
5150 defsubr (&Shash_table_size);
5151 defsubr (&Shash_table_test);
5152 defsubr (&Shash_table_weakness);
5153 defsubr (&Shash_table_p);
5154 defsubr (&Sclrhash);
5155 defsubr (&Sgethash);
5156 defsubr (&Sputhash);
5157 defsubr (&Sremhash);
5158 defsubr (&Smaphash);
5159 defsubr (&Sdefine_hash_table_test);
5160
5161 Qstring_lessp = intern_c_string ("string-lessp");
5162 staticpro (&Qstring_lessp);
5163 Qprovide = intern_c_string ("provide");
5164 staticpro (&Qprovide);
5165 Qrequire = intern_c_string ("require");
5166 staticpro (&Qrequire);
5167 Qyes_or_no_p_history = intern_c_string ("yes-or-no-p-history");
5168 staticpro (&Qyes_or_no_p_history);
5169 Qcursor_in_echo_area = intern_c_string ("cursor-in-echo-area");
5170 staticpro (&Qcursor_in_echo_area);
5171 Qwidget_type = intern_c_string ("widget-type");
5172 staticpro (&Qwidget_type);
5173
5174 staticpro (&string_char_byte_cache_string);
5175 string_char_byte_cache_string = Qnil;
5176
5177 require_nesting_list = Qnil;
5178 staticpro (&require_nesting_list);
5179
5180 Fset (Qyes_or_no_p_history, Qnil);
5181
5182 DEFVAR_LISP ("features", &Vfeatures,
5183 doc: 5184 );
5185 Vfeatures = Fcons (intern_c_string ("emacs"), Qnil);
5186 Qsubfeatures = intern_c_string ("subfeatures");
5187 staticpro (&Qsubfeatures);
5188
5189 #ifdef HAVE_LANGINFO_CODESET
5190 Qcodeset = intern_c_string ("codeset");
5191 staticpro (&Qcodeset);
5192 Qdays = intern_c_string ("days");
5193 staticpro (&Qdays);
5194 Qmonths = intern_c_string ("months");
5195 staticpro (&Qmonths);
5196 Qpaper = intern_c_string ("paper");
5197 staticpro (&Qpaper);
5198 #endif
5199
5200 DEFVAR_BOOL ("use-dialog-box", &use_dialog_box,
5201 doc: 5202 5203 5204 5205 5206 );
5207 use_dialog_box = 1;
5208
5209 DEFVAR_BOOL ("use-file-dialog", &use_file_dialog,
5210 doc: 5211 5212 5213 5214 );
5215 use_file_dialog = 1;
5216
5217 defsubr (&Sidentity);
5218 defsubr (&Srandom);
5219 defsubr (&Slength);
5220 defsubr (&Ssafe_length);
5221 defsubr (&Sstring_bytes);
5222 defsubr (&Sstring_equal);
5223 defsubr (&Scompare_strings);
5224 defsubr (&Sstring_lessp);
5225 defsubr (&Sappend);
5226 defsubr (&Sconcat);
5227 defsubr (&Svconcat);
5228 defsubr (&Scopy_sequence);
5229 defsubr (&Sstring_make_multibyte);
5230 defsubr (&Sstring_make_unibyte);
5231 defsubr (&Sstring_as_multibyte);
5232 defsubr (&Sstring_as_unibyte);
5233 defsubr (&Sstring_to_multibyte);
5234 defsubr (&Sstring_to_unibyte);
5235 defsubr (&Scopy_alist);
5236 defsubr (&Ssubstring);
5237 defsubr (&Ssubstring_no_properties);
5238 defsubr (&Snthcdr);
5239 defsubr (&Snth);
5240 defsubr (&Selt);
5241 defsubr (&Smember);
5242 defsubr (&Smemq);
5243 defsubr (&Smemql);
5244 defsubr (&Sassq);
5245 defsubr (&Sassoc);
5246 defsubr (&Srassq);
5247 defsubr (&Srassoc);
5248 defsubr (&Sdelq);
5249 defsubr (&Sdelete);
5250 defsubr (&Snreverse);
5251 defsubr (&Sreverse);
5252 defsubr (&Ssort);
5253 defsubr (&Splist_get);
5254 defsubr (&Sget);
5255 defsubr (&Splist_put);
5256 defsubr (&Sput);
5257 defsubr (&Slax_plist_get);
5258 defsubr (&Slax_plist_put);
5259 defsubr (&Seql);
5260 defsubr (&Sequal);
5261 defsubr (&Sequal_including_properties);
5262 defsubr (&Sfillarray);
5263 defsubr (&Sclear_string);
5264 defsubr (&Snconc);
5265 defsubr (&Smapcar);
5266 defsubr (&Smapc);
5267 defsubr (&Smapconcat);
5268 defsubr (&Sy_or_n_p);
5269 defsubr (&Syes_or_no_p);
5270 defsubr (&Sload_average);
5271 defsubr (&Sfeaturep);
5272 defsubr (&Srequire);
5273 defsubr (&Sprovide);
5274 defsubr (&Splist_member);
5275 defsubr (&Swidget_put);
5276 defsubr (&Swidget_get);
5277 defsubr (&Swidget_apply);
5278 defsubr (&Sbase64_encode_region);
5279 defsubr (&Sbase64_decode_region);
5280 defsubr (&Sbase64_encode_string);
5281 defsubr (&Sbase64_decode_string);
5282 defsubr (&Smd5);
5283 defsubr (&Slocale_info);
5284 }
5285
5286
5287 void
5288 init_fns ()
5289 {
5290 }
5291
5292 5293