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