src/fns.c

   1 /* Random utility Lisp functions.
   2    Copyright (C) 1985, 1986, 1987, 1993, 1994 Free Software Foundation, Inc.
   3
   4 This file is part of GNU Emacs.
   5
   6 GNU Emacs is free software; you can redistribute it and/or modify
   7 it under the terms of the GNU General Public License as published by
   8 the Free Software Foundation; either version 1, or (at your option)
   9 any later version.
  10
  11 GNU Emacs is distributed in the hope that it will be useful,
  12 but WITHOUT ANY WARRANTY; without even the implied warranty of
  13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 GNU General Public License for more details.
  15
  16 You should have received a copy of the GNU General Public License
  17 along with GNU Emacs; see the file COPYING.  If not, write to
  18 the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
  19
  20
  21 #include <config.h>
  22
  23 /* Note on some machines this defines `vector' as a typedef,
  24    so make sure we don't use that name in this file.  */
  25 #undef vector
  26 #define vector *****
  27
  28 #include "lisp.h"
  29 #include "commands.h"
  30
  31 #include "buffer.h"
  32 #include "keyboard.h"
  33 #include "intervals.h"
  34
  35 extern Lisp_Object Flookup_key ();
  36
  37 Lisp_Object Qstring_lessp, Qprovide, Qrequire;
  38 Lisp_Object Qyes_or_no_p_history;
  39
  40 static Lisp_Object internal_equal ();
  41 \f
  42 DEFUN ("identity", Fidentity, Sidentity, 1, 1, 0,
  43   "Return the argument unchanged.")
  44   (arg)
  45      Lisp_Object arg;
  46 {
  47   return arg;
  48 }
  49
  50 DEFUN ("random", Frandom, Srandom, 0, 1, 0,
  51   "Return a pseudo-random number.\n\
  52 On most systems all integers representable in Lisp are equally likely.\n\
  53   This is 24 bits' worth.\n\
  54 With argument N, return random number in interval [0,N).\n\
  55 With argument t, set the random number seed from the current time and pid.")
  56   (limit)
  57      Lisp_Object limit;
  58 {
  59   int val;
  60   unsigned long denominator;
  61   extern long random ();
  62   extern srandom ();
  63   extern long time ();
  64
  65   if (EQ (limit, Qt))
  66     srandom (getpid () + time (0));
  67   if (INTEGERP (limit) && XINT (limit) > 0)
  68     {
  69       if (XFASTINT (limit) >= 0x40000000)
  70         /* This case may occur on 64-bit machines.  */
  71         val = random () % XFASTINT (limit);
  72       else
  73         {
  74           /* Try to take our random number from the higher bits of VAL,
  75              not the lower, since (says Gentzel) the low bits of `random'
  76              are less random than the higher ones.  We do this by using the
  77              quotient rather than the remainder.  At the high end of the RNG
  78              it's possible to get a quotient larger than limit; discarding
  79              these values eliminates the bias that would otherwise appear
  80              when using a large limit.  */
  81           denominator = (unsigned long)0x40000000 / XFASTINT (limit);
  82           do
  83             val = (random () & 0x3fffffff) / denominator;
  84           while (val >= XFASTINT (limit));
  85         }
  86     }
  87   else
  88     val = random ();
  89   return make_number (val);
  90 }
  91 \f
  92 /* Random data-structure functions */
  93
  94 DEFUN ("length", Flength, Slength, 1, 1, 0,
  95   "Return the length of vector, list or string SEQUENCE.\n\
  96 A byte-code function object is also allowed.")
  97   (obj)
  98      register Lisp_Object obj;
  99 {
 100   register Lisp_Object tail, val;
 101   register int i;
 102
 103  retry:
 104   if (VECTORP (obj) || STRINGP (obj) || COMPILEDP (obj))
 105     return Farray_length (obj);
 106   else if (CONSP (obj))
 107     {
 108       for (i = 0, tail = obj; !NILP(tail); i++)
 109         {
 110           QUIT;
 111           tail = Fcdr (tail);
 112         }
 113
 114       XSETFASTINT (val, i);
 115       return val;
 116     }
 117   else if (NILP(obj))
 118     {
 119       XSETFASTINT (val, 0);
 120       return val;
 121     }
 122   else
 123     {
 124       obj = wrong_type_argument (Qsequencep, obj);
 125       goto retry;
 126     }
 127 }
 128
 129 DEFUN ("string-equal", Fstring_equal, Sstring_equal, 2, 2, 0,
 130   "T if two strings have identical contents.\n\
 131 Case is significant.\n\
 132 Symbols are also allowed; their print names are used instead.")
 133   (s1, s2)
 134      register Lisp_Object s1, s2;
 135 {
 136   if (SYMBOLP (s1))
 137     XSETSTRING (s1, XSYMBOL (s1)->name);
 138   if (SYMBOLP (s2))
 139     XSETSTRING (s2, XSYMBOL (s2)->name);
 140   CHECK_STRING (s1, 0);
 141   CHECK_STRING (s2, 1);
 142
 143   if (XSTRING (s1)->size != XSTRING (s2)->size ||
 144       bcmp (XSTRING (s1)->data, XSTRING (s2)->data, XSTRING (s1)->size))
 145     return Qnil;
 146   return Qt;
 147 }
 148
 149 DEFUN ("string-lessp", Fstring_lessp, Sstring_lessp, 2, 2, 0,
 150   "T if first arg string is less than second in lexicographic order.\n\
 151 Case is significant.\n\
 152 Symbols are also allowed; their print names are used instead.")
 153   (s1, s2)
 154      register Lisp_Object s1, s2;
 155 {
 156   register int i;
 157   register unsigned char *p1, *p2;
 158   register int end;
 159
 160   if (SYMBOLP (s1))
 161     XSETSTRING (s1, XSYMBOL (s1)->name);
 162   if (SYMBOLP (s2))
 163     XSETSTRING (s2, XSYMBOL (s2)->name);
 164   CHECK_STRING (s1, 0);
 165   CHECK_STRING (s2, 1);
 166
 167   p1 = XSTRING (s1)->data;
 168   p2 = XSTRING (s2)->data;
 169   end = XSTRING (s1)->size;
 170   if (end > XSTRING (s2)->size)
 171     end = XSTRING (s2)->size;
 172
 173   for (i = 0; i < end; i++)
 174     {
 175       if (p1[i] != p2[i])
 176         return p1[i] < p2[i] ? Qt : Qnil;
 177     }
 178   return i < XSTRING (s2)->size ? Qt : Qnil;
 179 }
 180 \f
 181 static Lisp_Object concat ();
 182
 183 /* ARGSUSED */
 184 Lisp_Object
 185 concat2 (s1, s2)
 186      Lisp_Object s1, s2;
 187 {
 188 #ifdef NO_ARG_ARRAY
 189   Lisp_Object args[2];
 190   args[0] = s1;
 191   args[1] = s2;
 192   return concat (2, args, Lisp_String, 0);
 193 #else
 194   return concat (2, &s1, Lisp_String, 0);
 195 #endif /* NO_ARG_ARRAY */
 196 }
 197
 198 /* ARGSUSED */
 199 Lisp_Object
 200 concat3 (s1, s2, s3)
 201      Lisp_Object s1, s2, s3;
 202 {
 203 #ifdef NO_ARG_ARRAY
 204   Lisp_Object args[3];
 205   args[0] = s1;
 206   args[1] = s2;
 207   args[2] = s3;
 208   return concat (3, args, Lisp_String, 0);
 209 #else
 210   return concat (3, &s1, Lisp_String, 0);
 211 #endif /* NO_ARG_ARRAY */
 212 }
 213
 214 DEFUN ("append", Fappend, Sappend, 0, MANY, 0,
 215   "Concatenate all the arguments and make the result a list.\n\
 216 The result is a list whose elements are the elements of all the arguments.\n\
 217 Each argument may be a list, vector or string.\n\
 218 The last argument is not copied, just used as the tail of the new list.")
 219   (nargs, args)
 220      int nargs;
 221      Lisp_Object *args;
 222 {
 223   return concat (nargs, args, Lisp_Cons, 1);
 224 }
 225
 226 DEFUN ("concat", Fconcat, Sconcat, 0, MANY, 0,
 227   "Concatenate all the arguments and make the result a string.\n\
 228 The result is a string whose elements are the elements of all the arguments.\n\
 229 Each argument may be a string, a list of characters (integers),\n\
 230 or a vector of characters (integers).")
 231   (nargs, args)
 232      int nargs;
 233      Lisp_Object *args;
 234 {
 235   return concat (nargs, args, Lisp_String, 0);
 236 }
 237
 238 DEFUN ("vconcat", Fvconcat, Svconcat, 0, MANY, 0,
 239   "Concatenate all the arguments and make the result a vector.\n\
 240 The result is a vector whose elements are the elements of all the arguments.\n\
 241 Each argument may be a list, vector or string.")
 242   (nargs, args)
 243      int nargs;
 244      Lisp_Object *args;
 245 {
 246   return concat (nargs, args, Lisp_Vector, 0);
 247 }
 248
 249 DEFUN ("copy-sequence", Fcopy_sequence, Scopy_sequence, 1, 1, 0,
 250   "Return a copy of a list, vector or string.\n\
 251 The elements of a list or vector are not copied; they are shared\n\
 252 with the original.")
 253   (arg)
 254      Lisp_Object arg;
 255 {
 256   if (NILP (arg)) return arg;
 257   if (!CONSP (arg) && !VECTORP (arg) && !STRINGP (arg))
 258     arg = wrong_type_argument (Qsequencep, arg);
 259   return concat (1, &arg, CONSP (arg) ? Lisp_Cons : XTYPE (arg), 0);
 260 }
 261
 262 static Lisp_Object
 263 concat (nargs, args, target_type, last_special)
 264      int nargs;
 265      Lisp_Object *args;
 266      enum Lisp_Type target_type;
 267      int last_special;
 268 {
 269   Lisp_Object val;
 270   Lisp_Object len;
 271   register Lisp_Object tail;
 272   register Lisp_Object this;
 273   int toindex;
 274   register int leni;
 275   register int argnum;
 276   Lisp_Object last_tail;
 277   Lisp_Object prev;
 278
 279   /* In append, the last arg isn't treated like the others */
 280   if (last_special && nargs > 0)
 281     {
 282       nargs--;
 283       last_tail = args[nargs];
 284     }
 285   else
 286     last_tail = Qnil;
 287
 288   for (argnum = 0; argnum < nargs; argnum++)
 289     {
 290       this = args[argnum];
 291       if (!(CONSP (this) || NILP (this) || VECTORP (this) || STRINGP (this)
 292             || COMPILEDP (this)))
 293         {
 294           if (INTEGERP (this))
 295             args[argnum] = Fnumber_to_string (this);
 296           else
 297             args[argnum] = wrong_type_argument (Qsequencep, this);
 298         }
 299     }
 300
 301   for (argnum = 0, leni = 0; argnum < nargs; argnum++)
 302     {
 303       this = args[argnum];
 304       len = Flength (this);
 305       leni += XFASTINT (len);
 306     }
 307
 308   XSETFASTINT (len, leni);
 309
 310   if (target_type == Lisp_Cons)
 311     val = Fmake_list (len, Qnil);
 312   else if (target_type == Lisp_Vector)
 313     val = Fmake_vector (len, Qnil);
 314   else
 315     val = Fmake_string (len, len);
 316
 317   /* In append, if all but last arg are nil, return last arg */
 318   if (target_type == Lisp_Cons && EQ (val, Qnil))
 319     return last_tail;
 320
 321   if (CONSP (val))
 322     tail = val, toindex = -1;           /* -1 in toindex is flag we are making a list */
 323   else
 324     toindex = 0;
 325
 326   prev = Qnil;
 327
 328   for (argnum = 0; argnum < nargs; argnum++)
 329     {
 330       Lisp_Object thislen;
 331       int thisleni;
 332       register int thisindex = 0;
 333
 334       this = args[argnum];
 335       if (!CONSP (this))
 336         thislen = Flength (this), thisleni = XINT (thislen);
 337
 338       if (STRINGP (this) && STRINGP (val)
 339           && ! NULL_INTERVAL_P (XSTRING (this)->intervals))
 340         {
 341           copy_text_properties (make_number (0), thislen, this,
 342                                 make_number (toindex), val, Qnil);
 343         }
 344
 345       while (1)
 346         {
 347           register Lisp_Object elt;
 348
 349           /* Fetch next element of `this' arg into `elt', or break if
 350              `this' is exhausted. */
 351           if (NILP (this)) break;
 352           if (CONSP (this))
 353             elt = Fcar (this), this = Fcdr (this);
 354           else
 355             {
 356               if (thisindex >= thisleni) break;
 357               if (STRINGP (this))
 358                 XSETFASTINT (elt, XSTRING (this)->data[thisindex++]);
 359               else
 360                 elt = XVECTOR (this)->contents[thisindex++];
 361             }
 362
 363           /* Store into result */
 364           if (toindex < 0)
 365             {
 366               XCONS (tail)->car = elt;
 367               prev = tail;
 368               tail = XCONS (tail)->cdr;
 369             }
 370           else if (VECTORP (val))
 371             XVECTOR (val)->contents[toindex++] = elt;
 372           else
 373             {
 374               while (!INTEGERP (elt))
 375                 elt = wrong_type_argument (Qintegerp, elt);
 376               {
 377 #ifdef MASSC_REGISTER_BUG
 378                 /* Even removing all "register"s doesn't disable this bug!
 379                    Nothing simpler than this seems to work. */
 380                 unsigned char *p = & XSTRING (val)->data[toindex++];
 381                 *p = XINT (elt);
 382 #else
 383                 XSTRING (val)->data[toindex++] = XINT (elt);
 384 #endif
 385               }
 386             }
 387         }
 388     }
 389   if (!NILP (prev))
 390     XCONS (prev)->cdr = last_tail;
 391
 392   return val;
 393 }
 394 \f
 395 DEFUN ("copy-alist", Fcopy_alist, Scopy_alist, 1, 1, 0,
 396   "Return a copy of ALIST.\n\
 397 This is an alist which represents the same mapping from objects to objects,\n\
 398 but does not share the alist structure with ALIST.\n\
 399 The objects mapped (cars and cdrs of elements of the alist)\n\
 400 are shared, however.\n\
 401 Elements of ALIST that are not conses are also shared.")
 402   (alist)
 403      Lisp_Object alist;
 404 {
 405   register Lisp_Object tem;
 406
 407   CHECK_LIST (alist, 0);
 408   if (NILP (alist))
 409     return alist;
 410   alist = concat (1, &alist, Lisp_Cons, 0);
 411   for (tem = alist; CONSP (tem); tem = XCONS (tem)->cdr)
 412     {
 413       register Lisp_Object car;
 414       car = XCONS (tem)->car;
 415
 416       if (CONSP (car))
 417         XCONS (tem)->car = Fcons (XCONS (car)->car, XCONS (car)->cdr);
 418     }
 419   return alist;
 420 }
 421
 422 DEFUN ("substring", Fsubstring, Ssubstring, 2, 3, 0,
 423   "Return a substring of STRING, starting at index FROM and ending before TO.\n\
 424 TO may be nil or omitted; then the substring runs to the end of STRING.\n\
 425 If FROM or TO is negative, it counts from the end.")
 426   (string, from, to)
 427      Lisp_Object string;
 428      register Lisp_Object from, to;
 429 {
 430   Lisp_Object res;
 431
 432   CHECK_STRING (string, 0);
 433   CHECK_NUMBER (from, 1);
 434   if (NILP (to))
 435     to = Flength (string);
 436   else
 437     CHECK_NUMBER (to, 2);
 438
 439   if (XINT (from) < 0)
 440     XSETINT (from, XINT (from) + XSTRING (string)->size);
 441   if (XINT (to) < 0)
 442     XSETINT (to, XINT (to) + XSTRING (string)->size);
 443   if (!(0 <= XINT (from) && XINT (from) <= XINT (to)
 444         && XINT (to) <= XSTRING (string)->size))
 445     args_out_of_range_3 (string, from, to);
 446
 447   res = make_string (XSTRING (string)->data + XINT (from),
 448                      XINT (to) - XINT (from));
 449   copy_text_properties (from, to, string, make_number (0), res, Qnil);
 450   return res;
 451 }
 452 \f
 453 DEFUN ("nthcdr", Fnthcdr, Snthcdr, 2, 2, 0,
 454   "Take cdr N times on LIST, returns the result.")
 455   (n, list)
 456      Lisp_Object n;
 457      register Lisp_Object list;
 458 {
 459   register int i, num;
 460   CHECK_NUMBER (n, 0);
 461   num = XINT (n);
 462   for (i = 0; i < num && !NILP (list); i++)
 463     {
 464       QUIT;
 465       list = Fcdr (list);
 466     }
 467   return list;
 468 }
 469
 470 DEFUN ("nth", Fnth, Snth, 2, 2, 0,
 471   "Return the Nth element of LIST.\n\
 472 N counts from zero.  If LIST is not that long, nil is returned.")
 473   (n, list)
 474      Lisp_Object n, list;
 475 {
 476   return Fcar (Fnthcdr (n, list));
 477 }
 478
 479 DEFUN ("elt", Felt, Selt, 2, 2, 0,
 480   "Return element of SEQUENCE at index N.")
 481   (seq, n)
 482      register Lisp_Object seq, n;
 483 {
 484   CHECK_NUMBER (n, 0);
 485   while (1)
 486     {
 487       if (CONSP (seq) || NILP (seq))
 488         return Fcar (Fnthcdr (n, seq));
 489       else if (STRINGP (seq) || VECTORP (seq))
 490         return Faref (seq, n);
 491       else
 492         seq = wrong_type_argument (Qsequencep, seq);
 493     }
 494 }
 495
 496 DEFUN ("member", Fmember, Smember, 2, 2, 0,
 497   "Return non-nil if ELT is an element of LIST.  Comparison done with `equal'.\n\
 498 The value is actually the tail of LIST whose car is ELT.")
 499   (elt, list)
 500      register Lisp_Object elt;
 501      Lisp_Object list;
 502 {
 503   register Lisp_Object tail;
 504   for (tail = list; !NILP (tail); tail = Fcdr (tail))
 505     {
 506       register Lisp_Object tem;
 507       tem = Fcar (tail);
 508       if (! NILP (Fequal (elt, tem)))
 509         return tail;
 510       QUIT;
 511     }
 512   return Qnil;
 513 }
 514
 515 DEFUN ("memq", Fmemq, Smemq, 2, 2, 0,
 516   "Return non-nil if ELT is an element of LIST.  Comparison done with EQ.\n\
 517 The value is actually the tail of LIST whose car is ELT.")
 518   (elt, list)
 519      register Lisp_Object elt;
 520      Lisp_Object list;
 521 {
 522   register Lisp_Object tail;
 523   for (tail = list; !NILP (tail); tail = Fcdr (tail))
 524     {
 525       register Lisp_Object tem;
 526       tem = Fcar (tail);
 527       if (EQ (elt, tem)) return tail;
 528       QUIT;
 529     }
 530   return Qnil;
 531 }
 532
 533 DEFUN ("assq", Fassq, Sassq, 2, 2, 0,
 534   "Return non-nil if KEY is `eq' to the car of an element of LIST.\n\
 535 The value is actually the element of LIST whose car is KEY.\n\
 536 Elements of LIST that are not conses are ignored.")
 537   (key, list)
 538      register Lisp_Object key;
 539      Lisp_Object list;
 540 {
 541   register Lisp_Object tail;
 542   for (tail = list; !NILP (tail); tail = Fcdr (tail))
 543     {
 544       register Lisp_Object elt, tem;
 545       elt = Fcar (tail);
 546       if (!CONSP (elt)) continue;
 547       tem = Fcar (elt);
 548       if (EQ (key, tem)) return elt;
 549       QUIT;
 550     }
 551   return Qnil;
 552 }
 553
 554 /* Like Fassq but never report an error and do not allow quits.
 555    Use only on lists known never to be circular.  */
 556
 557 Lisp_Object
 558 assq_no_quit (key, list)
 559      register Lisp_Object key;
 560      Lisp_Object list;
 561 {
 562   register Lisp_Object tail;
 563   for (tail = list; CONSP (tail); tail = Fcdr (tail))
 564     {
 565       register Lisp_Object elt, tem;
 566       elt = Fcar (tail);
 567       if (!CONSP (elt)) continue;
 568       tem = Fcar (elt);
 569       if (EQ (key, tem)) return elt;
 570     }
 571   return Qnil;
 572 }
 573
 574 DEFUN ("assoc", Fassoc, Sassoc, 2, 2, 0,
 575   "Return non-nil if KEY is `equal' to the car of an element of LIST.\n\
 576 The value is actually the element of LIST whose car is KEY.")
 577   (key, list)
 578      register Lisp_Object key;
 579      Lisp_Object list;
 580 {
 581   register Lisp_Object tail;
 582   for (tail = list; !NILP (tail); tail = Fcdr (tail))
 583     {
 584       register Lisp_Object elt, tem;
 585       elt = Fcar (tail);
 586       if (!CONSP (elt)) continue;
 587       tem = Fequal (Fcar (elt), key);
 588       if (!NILP (tem)) return elt;
 589       QUIT;
 590     }
 591   return Qnil;
 592 }
 593
 594 DEFUN ("rassq", Frassq, Srassq, 2, 2, 0,
 595   "Return non-nil if ELT is `eq' to the cdr of an element of LIST.\n\
 596 The value is actually the element of LIST whose cdr is ELT.")
 597   (key, list)
 598      register Lisp_Object key;
 599      Lisp_Object list;
 600 {
 601   register Lisp_Object tail;
 602   for (tail = list; !NILP (tail); tail = Fcdr (tail))
 603     {
 604       register Lisp_Object elt, tem;
 605       elt = Fcar (tail);
 606       if (!CONSP (elt)) continue;
 607       tem = Fcdr (elt);
 608       if (EQ (key, tem)) return elt;
 609       QUIT;
 610     }
 611   return Qnil;
 612 }
 613 \f
 614 DEFUN ("delq", Fdelq, Sdelq, 2, 2, 0,
 615   "Delete by side effect any occurrences of ELT as a member of LIST.\n\
 616 The modified LIST is returned.  Comparison is done with `eq'.\n\
 617 If the first member of LIST is ELT, there is no way to remove it by side effect;\n\
 618 therefore, write `(setq foo (delq element foo))'\n\
 619 to be sure of changing the value of `foo'.")
 620   (elt, list)
 621      register Lisp_Object elt;
 622      Lisp_Object list;
 623 {
 624   register Lisp_Object tail, prev;
 625   register Lisp_Object tem;
 626
 627   tail = list;
 628   prev = Qnil;
 629   while (!NILP (tail))
 630     {
 631       tem = Fcar (tail);
 632       if (EQ (elt, tem))
 633         {
 634           if (NILP (prev))
 635             list = Fcdr (tail);
 636           else
 637             Fsetcdr (prev, Fcdr (tail));
 638         }
 639       else
 640         prev = tail;
 641       tail = Fcdr (tail);
 642       QUIT;
 643     }
 644   return list;
 645 }
 646
 647 DEFUN ("delete", Fdelete, Sdelete, 2, 2, 0,
 648   "Delete by side effect any occurrences of ELT as a member of LIST.\n\
 649 The modified LIST is returned.  Comparison is done with `equal'.\n\
 650 If the first member of LIST is ELT, deleting it is not a side effect;\n\
 651 it is simply using a different list.\n\
 652 Therefore, write `(setq foo (delete element foo))'\n\
 653 to be sure of changing the value of `foo'.")
 654   (elt, list)
 655      register Lisp_Object elt;
 656      Lisp_Object list;
 657 {
 658   register Lisp_Object tail, prev;
 659   register Lisp_Object tem;
 660
 661   tail = list;
 662   prev = Qnil;
 663   while (!NILP (tail))
 664     {
 665       tem = Fcar (tail);
 666       if (! NILP (Fequal (elt, tem)))
 667         {
 668           if (NILP (prev))
 669             list = Fcdr (tail);
 670           else
 671             Fsetcdr (prev, Fcdr (tail));
 672         }
 673       else
 674         prev = tail;
 675       tail = Fcdr (tail);
 676       QUIT;
 677     }
 678   return list;
 679 }
 680
 681 DEFUN ("nreverse", Fnreverse, Snreverse, 1, 1, 0,
 682   "Reverse LIST by modifying cdr pointers.\n\
 683 Returns the beginning of the reversed list.")
 684   (list)
 685      Lisp_Object list;
 686 {
 687   register Lisp_Object prev, tail, next;
 688
 689   if (NILP (list)) return list;
 690   prev = Qnil;
 691   tail = list;
 692   while (!NILP (tail))
 693     {
 694       QUIT;
 695       next = Fcdr (tail);
 696       Fsetcdr (tail, prev);
 697       prev = tail;
 698       tail = next;
 699     }
 700   return prev;
 701 }
 702
 703 DEFUN ("reverse", Freverse, Sreverse, 1, 1, 0,
 704   "Reverse LIST, copying.  Returns the beginning of the reversed list.\n\
 705 See also the function `nreverse', which is used more often.")
 706   (list)
 707      Lisp_Object list;
 708 {
 709   Lisp_Object length;
 710   register Lisp_Object *vec;
 711   register Lisp_Object tail;
 712   register int i;
 713
 714   length = Flength (list);
 715   vec = (Lisp_Object *) alloca (XINT (length) * sizeof (Lisp_Object));
 716   for (i = XINT (length) - 1, tail = list; i >= 0; i--, tail = Fcdr (tail))
 717     vec[i] = Fcar (tail);
 718
 719   return Flist (XINT (length), vec);
 720 }
 721 \f
 722 Lisp_Object merge ();
 723
 724 DEFUN ("sort", Fsort, Ssort, 2, 2, 0,
 725   "Sort LIST, stably, comparing elements using PREDICATE.\n\
 726 Returns the sorted list.  LIST is modified by side effects.\n\
 727 PREDICATE is called with two elements of LIST, and should return T\n\
 728 if the first element is \"less\" than the second.")
 729   (list, pred)
 730      Lisp_Object list, pred;
 731 {
 732   Lisp_Object front, back;
 733   register Lisp_Object len, tem;
 734   struct gcpro gcpro1, gcpro2;
 735   register int length;
 736
 737   front = list;
 738   len = Flength (list);
 739   length = XINT (len);
 740   if (length < 2)
 741     return list;
 742
 743   XSETINT (len, (length / 2) - 1);
 744   tem = Fnthcdr (len, list);
 745   back = Fcdr (tem);
 746   Fsetcdr (tem, Qnil);
 747
 748   GCPRO2 (front, back);
 749   front = Fsort (front, pred);
 750   back = Fsort (back, pred);
 751   UNGCPRO;
 752   return merge (front, back, pred);
 753 }
 754
 755 Lisp_Object
 756 merge (org_l1, org_l2, pred)
 757      Lisp_Object org_l1, org_l2;
 758      Lisp_Object pred;
 759 {
 760   Lisp_Object value;
 761   register Lisp_Object tail;
 762   Lisp_Object tem;
 763   register Lisp_Object l1, l2;
 764   struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
 765
 766   l1 = org_l1;
 767   l2 = org_l2;
 768   tail = Qnil;
 769   value = Qnil;
 770
 771   /* It is sufficient to protect org_l1 and org_l2.
 772      When l1 and l2 are updated, we copy the new values
 773      back into the org_ vars.  */
 774   GCPRO4 (org_l1, org_l2, pred, value);
 775
 776   while (1)
 777     {
 778       if (NILP (l1))
 779         {
 780           UNGCPRO;
 781           if (NILP (tail))
 782             return l2;
 783           Fsetcdr (tail, l2);
 784           return value;
 785         }
 786       if (NILP (l2))
 787         {
 788           UNGCPRO;
 789           if (NILP (tail))
 790             return l1;
 791           Fsetcdr (tail, l1);
 792           return value;
 793         }
 794       tem = call2 (pred, Fcar (l2), Fcar (l1));
 795       if (NILP (tem))
 796         {
 797           tem = l1;
 798           l1 = Fcdr (l1);
 799           org_l1 = l1;
 800         }
 801       else
 802         {
 803           tem = l2;
 804           l2 = Fcdr (l2);
 805           org_l2 = l2;
 806         }
 807       if (NILP (tail))
 808         value = tem;
 809       else
 810         Fsetcdr (tail, tem);
 811       tail = tem;
 812     }
 813 }
 814 \f
 815 DEFUN ("get", Fget, Sget, 2, 2, 0,
 816   "Return the value of SYMBOL's PROPNAME property.\n\
 817 This is the last VALUE stored with `(put SYMBOL PROPNAME VALUE)'.")
 818   (sym, prop)
 819      Lisp_Object sym;
 820      register Lisp_Object prop;
 821 {
 822   register Lisp_Object tail;
 823   for (tail = Fsymbol_plist (sym); !NILP (tail); tail = Fcdr (Fcdr (tail)))
 824     {
 825       register Lisp_Object tem;
 826       tem = Fcar (tail);
 827       if (EQ (prop, tem))
 828         return Fcar (Fcdr (tail));
 829     }
 830   return Qnil;
 831 }
 832
 833 DEFUN ("put", Fput, Sput, 3, 3, 0,
 834   "Store SYMBOL's PROPNAME property with value VALUE.\n\
 835 It can be retrieved with `(get SYMBOL PROPNAME)'.")
 836   (sym, prop, val)
 837      Lisp_Object sym;
 838      register Lisp_Object prop;
 839      Lisp_Object val;
 840 {
 841   register Lisp_Object tail, prev;
 842   Lisp_Object newcell;
 843   prev = Qnil;
 844   for (tail = Fsymbol_plist (sym); !NILP (tail); tail = Fcdr (Fcdr (tail)))
 845     {
 846       register Lisp_Object tem;
 847       tem = Fcar (tail);
 848       if (EQ (prop, tem))
 849         return Fsetcar (Fcdr (tail), val);
 850       prev = tail;
 851     }
 852   newcell = Fcons (prop, Fcons (val, Qnil));
 853   if (NILP (prev))
 854     Fsetplist (sym, newcell);
 855   else
 856     Fsetcdr (Fcdr (prev), newcell);
 857   return val;
 858 }
 859
 860 DEFUN ("equal", Fequal, Sequal, 2, 2, 0,
 861   "T if two Lisp objects have similar structure and contents.\n\
 862 They must have the same data type.\n\
 863 Conses are compared by comparing the cars and the cdrs.\n\
 864 Vectors and strings are compared element by element.\n\
 865 Numbers are compared by value, but integers cannot equal floats.\n\
 866  (Use `=' if you want integers and floats to be able to be equal.)\n\
 867 Symbols must match exactly.")
 868   (o1, o2)
 869      register Lisp_Object o1, o2;
 870 {
 871   return internal_equal (o1, o2, 0);
 872 }
 873
 874 static Lisp_Object
 875 internal_equal (o1, o2, depth)
 876      register Lisp_Object o1, o2;
 877      int depth;
 878 {
 879   if (depth > 200)
 880     error ("Stack overflow in equal");
 881 do_cdr:
 882   QUIT;
 883   if (EQ (o1, o2)) return Qt;
 884 #ifdef LISP_FLOAT_TYPE
 885   if (FLOATP (o1) && FLOATP (o2))
 886     return (extract_float (o1) == extract_float (o2)) ? Qt : Qnil;
 887 #endif
 888   if (XTYPE (o1) != XTYPE (o2)) return Qnil;
 889   if (MISCP (o1) && XMISC (o1)->type != XMISC (o2)->type) return Qnil;
 890   if (CONSP (o1) || OVERLAYP (o1))
 891     {
 892       Lisp_Object v1;
 893       v1 = internal_equal (Fcar (o1), Fcar (o2), depth + 1);
 894       if (NILP (v1))
 895         return v1;
 896       o1 = Fcdr (o1), o2 = Fcdr (o2);
 897       goto do_cdr;
 898     }
 899   if (MARKERP (o1))
 900     {
 901       return ((XMARKER (o1)->buffer == XMARKER (o2)->buffer
 902               && (XMARKER (o1)->buffer == 0
 903                   || XMARKER (o1)->bufpos == XMARKER (o2)->bufpos))
 904               ? Qt : Qnil);
 905     }
 906   if (VECTORP (o1) || COMPILEDP (o1))
 907     {
 908       register int index;
 909       if (XVECTOR (o1)->size != XVECTOR (o2)->size)
 910         return Qnil;
 911       for (index = 0; index < XVECTOR (o1)->size; index++)
 912         {
 913           Lisp_Object v, v1, v2;
 914           v1 = XVECTOR (o1)->contents [index];
 915           v2 = XVECTOR (o2)->contents [index];
 916           v = internal_equal (v1, v2, depth + 1);
 917           if (NILP (v)) return v;
 918         }
 919       return Qt;
 920     }
 921   if (STRINGP (o1))
 922     {
 923       if (XSTRING (o1)->size != XSTRING (o2)->size)
 924         return Qnil;
 925       if (bcmp (XSTRING (o1)->data, XSTRING (o2)->data, XSTRING (o1)->size))
 926         return Qnil;
 927       return Qt;
 928     }
 929   return Qnil;
 930 }
 931 \f
 932 DEFUN ("fillarray", Ffillarray, Sfillarray, 2, 2, 0,
 933   "Store each element of ARRAY with ITEM.  ARRAY is a vector or string.")
 934   (array, item)
 935      Lisp_Object array, item;
 936 {
 937   register int size, index, charval;
 938  retry:
 939   if (VECTORP (array))
 940     {
 941       register Lisp_Object *p = XVECTOR (array)->contents;
 942       size = XVECTOR (array)->size;
 943       for (index = 0; index < size; index++)
 944         p[index] = item;
 945     }
 946   else if (STRINGP (array))
 947     {
 948       register unsigned char *p = XSTRING (array)->data;
 949       CHECK_NUMBER (item, 1);
 950       charval = XINT (item);
 951       size = XSTRING (array)->size;
 952       for (index = 0; index < size; index++)
 953         p[index] = charval;
 954     }
 955   else
 956     {
 957       array = wrong_type_argument (Qarrayp, array);
 958       goto retry;
 959     }
 960   return array;
 961 }
 962
 963 /* ARGSUSED */
 964 Lisp_Object
 965 nconc2 (s1, s2)
 966      Lisp_Object s1, s2;
 967 {
 968 #ifdef NO_ARG_ARRAY
 969   Lisp_Object args[2];
 970   args[0] = s1;
 971   args[1] = s2;
 972   return Fnconc (2, args);
 973 #else
 974   return Fnconc (2, &s1);
 975 #endif /* NO_ARG_ARRAY */
 976 }
 977
 978 DEFUN ("nconc", Fnconc, Snconc, 0, MANY, 0,
 979   "Concatenate any number of lists by altering them.\n\
 980 Only the last argument is not altered, and need not be a list.")
 981   (nargs, args)
 982      int nargs;
 983      Lisp_Object *args;
 984 {
 985   register int argnum;
 986   register Lisp_Object tail, tem, val;
 987
 988   val = Qnil;
 989
 990   for (argnum = 0; argnum < nargs; argnum++)
 991     {
 992       tem = args[argnum];
 993       if (NILP (tem)) continue;
 994
 995       if (NILP (val))
 996         val = tem;
 997
 998       if (argnum + 1 == nargs) break;
 999
1000       if (!CONSP (tem))
1001         tem = wrong_type_argument (Qlistp, tem);
1002
1003       while (CONSP (tem))
1004         {
1005           tail = tem;
1006           tem = Fcdr (tail);
1007           QUIT;
1008         }
1009
1010       tem = args[argnum + 1];
1011       Fsetcdr (tail, tem);
1012       if (NILP (tem))
1013         args[argnum + 1] = tail;
1014     }
1015
1016   return val;
1017 }
1018 \f
1019 /* This is the guts of all mapping functions.
1020  Apply fn to each element of seq, one by one,
1021  storing the results into elements of vals, a C vector of Lisp_Objects.
1022  leni is the length of vals, which should also be the length of seq. */
1023
1024 static void
1025 mapcar1 (leni, vals, fn, seq)
1026      int leni;
1027      Lisp_Object *vals;
1028      Lisp_Object fn, seq;
1029 {
1030   register Lisp_Object tail;
1031   Lisp_Object dummy;
1032   register int i;
1033   struct gcpro gcpro1, gcpro2, gcpro3;
1034
1035   /* Don't let vals contain any garbage when GC happens.  */
1036   for (i = 0; i < leni; i++)
1037     vals[i] = Qnil;
1038
1039   GCPRO3 (dummy, fn, seq);
1040   gcpro1.var = vals;
1041   gcpro1.nvars = leni;
1042   /* We need not explicitly protect `tail' because it is used only on lists, and
1043     1) lists are not relocated and 2) the list is marked via `seq' so will not be freed */
1044
1045   if (VECTORP (seq))
1046     {
1047       for (i = 0; i < leni; i++)
1048         {
1049           dummy = XVECTOR (seq)->contents[i];
1050           vals[i] = call1 (fn, dummy);
1051         }
1052     }
1053   else if (STRINGP (seq))
1054     {
1055       for (i = 0; i < leni; i++)
1056         {
1057           XSETFASTINT (dummy, XSTRING (seq)->data[i]);
1058           vals[i] = call1 (fn, dummy);
1059         }
1060     }
1061   else   /* Must be a list, since Flength did not get an error */
1062     {
1063       tail = seq;
1064       for (i = 0; i < leni; i++)
1065         {
1066           vals[i] = call1 (fn, Fcar (tail));
1067           tail = Fcdr (tail);
1068         }
1069     }
1070
1071   UNGCPRO;
1072 }
1073
1074 DEFUN ("mapconcat", Fmapconcat, Smapconcat, 3, 3, 0,
1075   "Apply FN to each element of SEQ, and concat the results as strings.\n\
1076 In between each pair of results, stick in SEP.\n\
1077 Thus, \" \" as SEP results in spaces between the values returned by FN.")
1078   (fn, seq, sep)
1079      Lisp_Object fn, seq, sep;
1080 {
1081   Lisp_Object len;
1082   register int leni;
1083   int nargs;
1084   register Lisp_Object *args;
1085   register int i;
1086   struct gcpro gcpro1;
1087
1088   len = Flength (seq);
1089   leni = XINT (len);
1090   nargs = leni + leni - 1;
1091   if (nargs < 0) return build_string ("");
1092
1093   args = (Lisp_Object *) alloca (nargs * sizeof (Lisp_Object));
1094
1095   GCPRO1 (sep);
1096   mapcar1 (leni, args, fn, seq);
1097   UNGCPRO;
1098
1099   for (i = leni - 1; i >= 0; i--)
1100     args[i + i] = args[i];
1101
1102   for (i = 1; i < nargs; i += 2)
1103     args[i] = sep;
1104
1105   return Fconcat (nargs, args);
1106 }
1107
1108 DEFUN ("mapcar", Fmapcar, Smapcar, 2, 2, 0,
1109   "Apply FUNCTION to each element of SEQUENCE, and make a list of the results.\n\
1110 The result is a list just as long as SEQUENCE.\n\
1111 SEQUENCE may be a list, a vector or a string.")
1112   (fn, seq)
1113      Lisp_Object fn, seq;
1114 {
1115   register Lisp_Object len;
1116   register int leni;
1117   register Lisp_Object *args;
1118
1119   len = Flength (seq);
1120   leni = XFASTINT (len);
1121   args = (Lisp_Object *) alloca (leni * sizeof (Lisp_Object));
1122
1123   mapcar1 (leni, args, fn, seq);
1124
1125   return Flist (leni, args);
1126 }
1127 \f
1128 /* Anything that calls this function must protect from GC!  */
1129
1130 DEFUN ("y-or-n-p", Fy_or_n_p, Sy_or_n_p, 1, 1, 0,
1131   "Ask user a \"y or n\" question.  Return t if answer is \"y\".\n\
1132 Takes one argument, which is the string to display to ask the question.\n\
1133 It should end in a space; `y-or-n-p' adds `(y or n) ' to it.\n\
1134 No confirmation of the answer is requested; a single character is enough.\n\
1135 Also accepts Space to mean yes, or Delete to mean no.")
1136   (prompt)
1137      Lisp_Object prompt;
1138 {
1139   register Lisp_Object obj, key, def, answer_string, map;
1140   register int answer;
1141   Lisp_Object xprompt;
1142   Lisp_Object args[2];
1143   int ocech = cursor_in_echo_area;
1144   struct gcpro gcpro1, gcpro2;
1145
1146   map = Fsymbol_value (intern ("query-replace-map"));
1147
1148   CHECK_STRING (prompt, 0);
1149   xprompt = prompt;
1150   GCPRO2 (prompt, xprompt);
1151
1152   while (1)
1153     {
1154 #ifdef HAVE_X_MENU
1155       if ((NILP (last_nonmenu_event) || CONSP (last_nonmenu_event))
1156           && using_x_p ())
1157         {
1158           Lisp_Object pane, menu;
1159           redisplay_preserve_echo_area ();
1160           pane = Fcons (Fcons (build_string ("Yes"), Qt),
1161                         Fcons (Fcons (build_string ("No"), Qnil),
1162                                Qnil));
1163           menu = Fcons (prompt, pane);
1164           obj = Fx_popup_dialog (Qt, menu);
1165           answer = !NILP (obj);
1166           break;
1167         }
1168 #endif
1169       cursor_in_echo_area = 1;
1170       message ("%s(y or n) ", XSTRING (xprompt)->data);
1171
1172       obj = read_filtered_event (1, 0, 0);
1173       cursor_in_echo_area = 0;
1174       /* If we need to quit, quit with cursor_in_echo_area = 0.  */
1175       QUIT;
1176
1177       key = Fmake_vector (make_number (1), obj);
1178       def = Flookup_key (map, key);
1179       answer_string = Fsingle_key_description (obj);
1180
1181       if (EQ (def, intern ("skip")))
1182         {
1183           answer = 0;
1184           break;
1185         }
1186       else if (EQ (def, intern ("act")))
1187         {
1188           answer = 1;
1189           break;
1190         }
1191       else if (EQ (def, intern ("recenter")))
1192         {
1193           Frecenter (Qnil);
1194           xprompt = prompt;
1195           continue;
1196         }
1197       else if (EQ (def, intern ("quit")))
1198         Vquit_flag = Qt;
1199
1200       QUIT;
1201
1202       /* If we don't clear this, then the next call to read_char will
1203          return quit_char again, and we'll enter an infinite loop.  */
1204       Vquit_flag = Qnil;
1205
1206       Fding (Qnil);
1207       Fdiscard_input ();
1208       if (EQ (xprompt, prompt))
1209         {
1210           args[0] = build_string ("Please answer y or n.  ");
1211           args[1] = prompt;
1212           xprompt = Fconcat (2, args);
1213         }
1214     }
1215   UNGCPRO;
1216
1217   if (! noninteractive)
1218     {
1219       cursor_in_echo_area = -1;
1220       message ("%s(y or n) %c", XSTRING (xprompt)->data, answer ? 'y' : 'n');
1221       cursor_in_echo_area = ocech;
1222     }
1223
1224   return answer ? Qt : Qnil;
1225 }
1226 \f
1227 /* This is how C code calls `yes-or-no-p' and allows the user
1228    to redefined it.
1229
1230    Anything that calls this function must protect from GC!  */
1231
1232 Lisp_Object
1233 do_yes_or_no_p (prompt)
1234      Lisp_Object prompt;
1235 {
1236   return call1 (intern ("yes-or-no-p"), prompt);
1237 }
1238
1239 /* Anything that calls this function must protect from GC!  */
1240
1241 DEFUN ("yes-or-no-p", Fyes_or_no_p, Syes_or_no_p, 1, 1, 0,
1242   "Ask user a yes-or-no question.  Return t if answer is yes.\n\
1243 Takes one argument, which is the string to display to ask the question.\n\
1244 It should end in a space; `yes-or-no-p' adds `(yes or no) ' to it.\n\
1245 The user must confirm the answer with RET,\n\
1246 and can edit it until it as been confirmed.")
1247   (prompt)
1248      Lisp_Object prompt;
1249 {
1250   register Lisp_Object ans;
1251   Lisp_Object args[2];
1252   struct gcpro gcpro1;
1253   Lisp_Object menu;
1254
1255   CHECK_STRING (prompt, 0);
1256
1257 #ifdef HAVE_X_MENU
1258   if ((NILP (last_nonmenu_event) || CONSP (last_nonmenu_event))
1259       && using_x_p ())
1260     {
1261       Lisp_Object pane, menu, obj;
1262       redisplay_preserve_echo_area ();
1263       pane = Fcons (Fcons (build_string ("Yes"), Qt),
1264                     Fcons (Fcons (build_string ("No"), Qnil),
1265                            Qnil));
1266       GCPRO1 (pane);
1267       menu = Fcons (prompt, pane);
1268       obj = Fx_popup_dialog (Qt, menu);
1269       UNGCPRO;
1270       return obj;
1271     }
1272 #endif
1273
1274   args[0] = prompt;
1275   args[1] = build_string ("(yes or no) ");
1276   prompt = Fconcat (2, args);
1277
1278   GCPRO1 (prompt);
1279
1280   while (1)
1281     {
1282       ans = Fdowncase (Fread_from_minibuffer (prompt, Qnil, Qnil, Qnil,
1283                                               Qyes_or_no_p_history));
1284       if (XSTRING (ans)->size == 3 && !strcmp (XSTRING (ans)->data, "yes"))
1285         {
1286           UNGCPRO;
1287           return Qt;
1288         }
1289       if (XSTRING (ans)->size == 2 && !strcmp (XSTRING (ans)->data, "no"))
1290         {
1291           UNGCPRO;
1292           return Qnil;
1293         }
1294
1295       Fding (Qnil);
1296       Fdiscard_input ();
1297       message ("Please answer yes or no.");
1298       Fsleep_for (make_number (2), Qnil);
1299     }
1300 }
1301 \f
1302 DEFUN ("load-average", Fload_average, Sload_average, 0, 0, 0,
1303   "Return list of 1 minute, 5 minute and 15 minute load averages.\n\
1304 Each of the three load averages is multiplied by 100,\n\
1305 then converted to integer.\n\
1306 If the 5-minute or 15-minute load averages are not available, return a\n\
1307 shortened list, containing only those averages which are available.")
1308   ()
1309 {
1310   double load_ave[3];
1311   int loads = getloadavg (load_ave, 3);
1312   Lisp_Object ret;
1313
1314   if (loads < 0)
1315     error ("load-average not implemented for this operating system");
1316
1317   ret = Qnil;
1318   while (loads > 0)
1319     ret = Fcons (make_number ((int) (load_ave[--loads] * 100.0)), ret);
1320
1321   return ret;
1322 }
1323 \f
1324 Lisp_Object Vfeatures;
1325
1326 DEFUN ("featurep", Ffeaturep, Sfeaturep, 1, 1, 0,
1327   "Returns t if FEATURE is present in this Emacs.\n\
1328 Use this to conditionalize execution of lisp code based on the presence or\n\
1329 absence of emacs or environment extensions.\n\
1330 Use `provide' to declare that a feature is available.\n\
1331 This function looks at the value of the variable `features'.")
1332      (feature)
1333      Lisp_Object feature;
1334 {
1335   register Lisp_Object tem;
1336   CHECK_SYMBOL (feature, 0);
1337   tem = Fmemq (feature, Vfeatures);
1338   return (NILP (tem)) ? Qnil : Qt;
1339 }
1340
1341 DEFUN ("provide", Fprovide, Sprovide, 1, 1, 0,
1342   "Announce that FEATURE is a feature of the current Emacs.")
1343      (feature)
1344      Lisp_Object feature;
1345 {
1346   register Lisp_Object tem;
1347   CHECK_SYMBOL (feature, 0);
1348   if (!NILP (Vautoload_queue))
1349     Vautoload_queue = Fcons (Fcons (Vfeatures, Qnil), Vautoload_queue);
1350   tem = Fmemq (feature, Vfeatures);
1351   if (NILP (tem))
1352     Vfeatures = Fcons (feature, Vfeatures);
1353   LOADHIST_ATTACH (Fcons (Qprovide, feature));
1354   return feature;
1355 }
1356
1357 DEFUN ("require", Frequire, Srequire, 1, 2, 0,
1358   "If feature FEATURE is not loaded, load it from FILENAME.\n\
1359 If FEATURE is not a member of the list `features', then the feature\n\
1360 is not loaded; so load the file FILENAME.\n\
1361 If FILENAME is omitted, the printname of FEATURE is used as the file name.")
1362      (feature, file_name)
1363      Lisp_Object feature, file_name;
1364 {
1365   register Lisp_Object tem;
1366   CHECK_SYMBOL (feature, 0);
1367   tem = Fmemq (feature, Vfeatures);
1368   LOADHIST_ATTACH (Fcons (Qrequire, feature));
1369   if (NILP (tem))
1370     {
1371       int count = specpdl_ptr - specpdl;
1372
1373       /* Value saved here is to be restored into Vautoload_queue */
1374       record_unwind_protect (un_autoload, Vautoload_queue);
1375       Vautoload_queue = Qt;
1376
1377       Fload (NILP (file_name) ? Fsymbol_name (feature) : file_name,
1378              Qnil, Qt, Qnil);
1379
1380       tem = Fmemq (feature, Vfeatures);
1381       if (NILP (tem))
1382         error ("Required feature %s was not provided",
1383                XSYMBOL (feature)->name->data );
1384
1385       /* Once loading finishes, don't undo it.  */
1386       Vautoload_queue = Qt;
1387       feature = unbind_to (count, feature);
1388     }
1389   return feature;
1390 }
1391 \f
1392 syms_of_fns ()
1393 {
1394   Qstring_lessp = intern ("string-lessp");
1395   staticpro (&Qstring_lessp);
1396   Qprovide = intern ("provide");
1397   staticpro (&Qprovide);
1398   Qrequire = intern ("require");
1399   staticpro (&Qrequire);
1400   Qyes_or_no_p_history = intern ("yes-or-no-p-history");
1401   staticpro (&Qyes_or_no_p_history);
1402
1403   DEFVAR_LISP ("features", &Vfeatures,
1404     "A list of symbols which are the features of the executing emacs.\n\
1405 Used by `featurep' and `require', and altered by `provide'.");
1406   Vfeatures = Qnil;
1407
1408   defsubr (&Sidentity);
1409   defsubr (&Srandom);
1410   defsubr (&Slength);
1411   defsubr (&Sstring_equal);
1412   defsubr (&Sstring_lessp);
1413   defsubr (&Sappend);
1414   defsubr (&Sconcat);
1415   defsubr (&Svconcat);
1416   defsubr (&Scopy_sequence);
1417   defsubr (&Scopy_alist);
1418   defsubr (&Ssubstring);
1419   defsubr (&Snthcdr);
1420   defsubr (&Snth);
1421   defsubr (&Selt);
1422   defsubr (&Smember);
1423   defsubr (&Smemq);
1424   defsubr (&Sassq);
1425   defsubr (&Sassoc);
1426   defsubr (&Srassq);
1427   defsubr (&Sdelq);
1428   defsubr (&Sdelete);
1429   defsubr (&Snreverse);
1430   defsubr (&Sreverse);
1431   defsubr (&Ssort);
1432   defsubr (&Sget);
1433   defsubr (&Sput);
1434   defsubr (&Sequal);
1435   defsubr (&Sfillarray);
1436   defsubr (&Snconc);
1437   defsubr (&Smapcar);
1438   defsubr (&Smapconcat);
1439   defsubr (&Sy_or_n_p);
1440   defsubr (&Syes_or_no_p);
1441   defsubr (&Sload_average);
1442   defsubr (&Sfeaturep);
1443   defsubr (&Srequire);
1444   defsubr (&Sprovide);
1445 }